UPP (develop)
Loading...
Searching...
No Matches
CALMCVG.f
Go to the documentation of this file.
1
35!-----------------------------------------------------------------------
42!-----------------------------------------------------------------------
43 SUBROUTINE calmcvg(Q1D,U1D,V1D,QCNVG)
44
45!
46!
47!
48 use masks, only: dx, dy, hbm2
49 use params_mod, only: d00, d25
50 use ctlblk_mod, only: jsta_2l, jend_2u, spval, jsta_m, jend_m, &
51 jsta_m2, jend_m2, im, jm, &
52 ista_2l, iend_2u, ista_m, iend_m, ista_m2, iend_m2
53 use gridspec_mod, only: gridtype
54!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
55 implicit none
56!
57! DECLARE VARIABLES.
58!
59 REAL,dimension(ista_2l:iend_2u,jsta_2l:jend_2u),intent(in) :: Q1D, U1D, V1D
60 REAL,dimension(ista_2l:iend_2u,jsta_2l:jend_2u),intent(inout) :: QCNVG
61
62 REAL R2DY, R2DX
63 REAL, dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: UWND, VWND, QV
64 INTEGER IHE(JM),IHW(JM),IVE(JM),IVW(JM)
65 integer I,J,ISTA2,IEND2
66 real QVDY,QUDX
67!
68!***************************************************************************
69! START CALMCVG HERE.
70!
71!
72! INITIALIZE MOISTURE CONVERGENCE ARRAY. LOAD TEMPORARY WIND ARRAYS.
73!
74 CALL exch(q1d)
75 CALL exch(u1d)
76 CALL exch(v1d)
77
78!$omp parallel do private(i,j)
79 DO j=jsta_2l,jend_2u
80! DO I=1,IM
81 DO i=ista_2l,iend_2u
82 IF(u1d(i,j)<spval)THEN
83 qcnvg(i,j) = 0.
84 ELSE
85 qcnvg(i,j) = spval
86 ENDIF
87 uwnd(i,j) = u1d(i,j)
88 vwnd(i,j) = v1d(i,j)
89 IF (uwnd(i,j) == spval) uwnd(i,j) = d00
90 IF (vwnd(i,j) == spval) vwnd(i,j) = d00
91 ENDDO
92 ENDDO
93!
94 IF(gridtype == 'A')THEN
95!$omp parallel do private(i,j,qudx,qvdy,r2dx,r2dy)
96 DO j=jsta_m,jend_m
97! DO I=2,IM-1
98 DO i=ista_m,iend_m
99 IF(q1d(i,j+1)<spval.AND.q1d(i,j-1)<spval.AND. &
100 q1d(i+1,j)<spval.AND.q1d(i-1,j)<spval.AND. &
101 q1d(i,j)<spval) THEN
102 r2dx = 1./(2.*dx(i,j)) !MEB DX?
103 r2dy = 1./(2.*dy(i,j)) !MEB DY?
104 qudx = (q1d(i+1,j)*uwnd(i+1,j)-q1d(i-1,j)*uwnd(i-1,j))*r2dx
105 qvdy = (q1d(i,j+1)*vwnd(i,j+1)-q1d(i,j-1)*vwnd(i,j-1))*r2dy
106 qcnvg(i,j) = -(qudx + qvdy)
107 ELSE
108 qcnvg(i,j) = spval
109 ENDIF
110 ENDDO
111 ENDDO
112 ELSE IF(gridtype == 'E')THEN
113
114 DO j=jsta_m,jend_m
115 ihe(j) = mod(j+1,2)
116 ihw(j) = ihe(j)-1
117 ive(j) = mod(j,2)
118 ivw(j) = ive(j)-1
119 END DO
120
121!$omp parallel do private(i,j)
122 DO j=jsta_m,jend_m
123! ISTA = 1+MOD(J+1,2)
124! IEND = IM-MOD(J,2)
125! DO I=ISTA,IEND
126 DO i=ista_m,iend_m
127 IF(q1d(i,j-1)<spval.AND.q1d(i+ivw(j),j)<spval.AND.&
128 q1d(i+ive(j),j)<spval.AND.q1d(i,j+1)<spval) THEN
129 qv(i,j) = d25*(q1d(i,j-1)+q1d(i+ivw(j),j) &
130 +q1d(i+ive(j),j)+q1d(i,j+1))
131 ELSE
132 qv(i,j) = spval
133 ENDIF
134 END DO
135 END DO
136
137 CALL exch(qv)
138! CALL EXCH(VWND)
139
140!
141!$omp parallel do private(i,j,qudx,qvdy,r2dx,r2dy)
142 DO j=jsta_m2,jend_m2
143! IEND = IM-1-MOD(J,2)
144! DO I=2,IEND
145 DO i=ista_m,iend_m-mod(j,2)
146 IF(qv(i+ihe(j),j)<spval.AND.uwnd(i+ihe(j),j)<spval.AND.&
147 qv(i+ihw(j),j)<spval.AND.uwnd(i+ihw(j),j)<spval.AND.&
148 qv(i,j)<spval.AND.qv(i,j-1)<spval.AND.qv(i,j+1)<spval) THEN
149 r2dx = 1./(2.*dx(i,j))
150 r2dy = 1./(2.*dy(i,j))
151 qudx = (qv(i+ihe(j),j)*uwnd(i+ihe(j),j) &
152 -qv(i+ihw(j),j)*uwnd(i+ihw(j),j))*r2dx
153 qvdy = (qv(i,j+1)*vwnd(i,j+1)-qv(i,j-1)*vwnd(i,j-1))*r2dy
154
155 qcnvg(i,j) = -(qudx + qvdy) * hbm2(i,j)
156 ELSE
157 qcnvg(i,j) = spval
158 ENDIF
159 ENDDO
160 ENDDO
161 ELSE IF(gridtype=='B')THEN
162
163! CALL EXCH(UWND)
164!
165!$omp parallel do private(i,j,qudx,qvdy,r2dx,r2dy)
166 DO j=jsta_m,jend_m
167! DO I=2,IM-1
168 DO i=ista_m,iend_m
169 IF(uwnd(i,j)<spval.AND.uwnd(i,j-1)<spval.AND.&
170 uwnd(i-1,j)<spval.AND.uwnd(i-1,j-1)<spval.AND.&
171 q1d(i,j)<spval.AND.q1d(i+1,j)<spval.AND.q1d(i-1,j)<spval.AND.&
172 vwnd(i,j)<spval.AND.vwnd(i-1,j)<spval.AND.&
173 vwnd(i,j-1)<spval.AND.vwnd(i-1,j-1)<spval.AND.&
174 q1d(i,j+1)<spval.AND.q1d(i,j-1)<spval) THEN
175 r2dx = 1./dx(i,j)
176 r2dy = 1./dy(i,j)
177 qudx=(0.5*(uwnd(i,j)+uwnd(i,j-1))*0.5*(q1d(i,j)+q1d(i+1,j)) &
178 -0.5*(uwnd(i-1,j)+uwnd(i-1,j-1))*0.5*(q1d(i,j)+q1d(i-1,j)))*r2dx
179 qvdy=(0.5*(vwnd(i,j)+vwnd(i-1,j))*0.5*(q1d(i,j)+q1d(i,j+1)) &
180 -0.5*(vwnd(i,j-1)+vwnd(i-1,j-1))*0.5*(q1d(i,j)+q1d(i,j-1)))*r2dy
181
182 qcnvg(i,j) = -(qudx + qvdy)
183 ELSE
184 qcnvg(i,j) = spval
185 ENDIF
186! print*,'mcvg=',i,j,r2dx,r2dy,QCNVG(I,J)
187 ENDDO
188 ENDDO
189 ENDIF
190!meb not sure about the indexing for the c-grid
191!
192! END OF ROUTINE.
193!
194 RETURN
195 END
196
subroutine calmcvg(q1d, u1d, v1d, qcnvg)
Subroutine that computes moisture convergence.
Definition CALMCVG.f:44
subroutine exch(a)
exch() Subroutine that exchanges one halo row.
Definition EXCH.f:27