1 | !! Diagnostics: U & V on earth coordinates |
---|
2 | ! from ARWpost postprocessing routine from the WRF package. |
---|
3 | |
---|
4 | SUBROUTINE calc_uvmet(UUU,VVV,SCRa, SCRb, i3dflag) |
---|
5 | |
---|
6 | IMPLICIT NONE |
---|
7 | |
---|
8 | !Arguments |
---|
9 | real, allocatable, dimension(:,:,:) :: SCRa, SCRb |
---|
10 | character (len=128) :: cname, cdesc, cunits |
---|
11 | |
---|
12 | !Local |
---|
13 | integer :: i, j, k |
---|
14 | integer :: i3dflag |
---|
15 | real :: cone |
---|
16 | real, dimension(west_east_dim,south_north_dim) :: diff, alpha |
---|
17 | |
---|
18 | cname = "uvmet" |
---|
19 | cdesc = "Rotated wind component" |
---|
20 | cunits = "m s-1" |
---|
21 | |
---|
22 | use com_mod |
---|
23 | |
---|
24 | IF ( map_proj .ge. 3 ) THEN ! No need to rotate |
---|
25 | IF ( i3dflag == 1 ) THEN |
---|
26 | SCRa = UUU |
---|
27 | SCRb = VVV |
---|
28 | ENDIF |
---|
29 | IF ( i3dflag == 0 ) THEN |
---|
30 | SCRa(:,:,1) = U10(:,:) |
---|
31 | SCRb(:,:,1) = V10(:,:) |
---|
32 | END IF |
---|
33 | RETURN |
---|
34 | END IF |
---|
35 | |
---|
36 | |
---|
37 | cone = 1. ! PS |
---|
38 | IF ( map_proj .eq. 1) THEN ! Lambert Conformal mapping |
---|
39 | IF (ABS(truelat1-truelat2) .GT. 0.1) THEN |
---|
40 | cone=(ALOG(COS(truelat1*RAD_PER_DEG))- & |
---|
41 | ALOG(COS(truelat2*RAD_PER_DEG))) / & |
---|
42 | (ALOG(TAN((90.-ABS(truelat1))*RAD_PER_DEG*0.5 ))- & |
---|
43 | ALOG(TAN((90.-ABS(truelat2))*RAD_PER_DEG*0.5 )) ) |
---|
44 | ELSE |
---|
45 | cone = SIN(ABS(truelat1)*RAD_PER_DEG ) |
---|
46 | ENDIF |
---|
47 | END IF |
---|
48 | |
---|
49 | |
---|
50 | diff = XLONG - stand_lon |
---|
51 | DO i = 1, west_east_dim |
---|
52 | DO j = 1, south_north_dim |
---|
53 | IF ( diff(i,j) .gt. 180. ) THEN |
---|
54 | diff(i,j) = diff(i,j) - 360. |
---|
55 | END IF |
---|
56 | IF ( diff(i,j) .lt. -180. ) THEN |
---|
57 | diff(i,j) = diff(i,j) + 360. |
---|
58 | END IF |
---|
59 | END DO |
---|
60 | END DO |
---|
61 | |
---|
62 | |
---|
63 | DO i = 1, west_east_dim |
---|
64 | DO j = 1, south_north_dim |
---|
65 | IF ( XLAT(i,j) .lt. 0. ) THEN |
---|
66 | alpha(i,j) = - diff(i,j) * cone * RAD_PER_DEG |
---|
67 | ELSE |
---|
68 | alpha(i,j) = diff(i,j) * cone * RAD_PER_DEG |
---|
69 | END IF |
---|
70 | END DO |
---|
71 | END DO |
---|
72 | |
---|
73 | |
---|
74 | |
---|
75 | IF ( i3dflag == 1 ) THEN |
---|
76 | DO k = 1,bottom_top_dim |
---|
77 | SCRa(:,:,k) = VVV(:,:,k)*sin(alpha) + UUU(:,:,k)*cos(alpha) |
---|
78 | SCRb(:,:,k) = VVV(:,:,k)*cos(alpha) - UUU(:,:,k)*sin(alpha) |
---|
79 | END DO |
---|
80 | ELSE |
---|
81 | SCRa(:,:,1) = V10(:,:)*sin(alpha) + U10(:,:)*cos(alpha) |
---|
82 | SCRb(:,:,1) = V10(:,:)*cos(alpha) - U10(:,:)*sin(alpha) |
---|
83 | END IF |
---|
84 | |
---|
85 | END SUBROUTINE calc_uvmet |
---|
86 | |
---|