UPP v11.0.0
Loading...
Searching...
No Matches
UPP_MATH.f
Go to the documentation of this file.
1
5
17 module upp_math
18
19 use masks, only: dx, dy
20 use ctlblk_mod, only: im, jsta_2l, jend_2u, jsta_m, jend_m, spval,&
21 ista_2l, iend_2u, ista_m, iend_m
22 use gridspec_mod, only: gridtype
23!
24 implicit none
25
26 private
27
28 public :: ddvdx, ddudy, uuavg
29 public :: dvdxdudy
30 public :: h2u, h2v, u2h, v2h
31
32 REAL, ALLOCATABLE :: DDVDX(:,:)
33 REAL, ALLOCATABLE :: DDUDY(:,:)
34 REAL, ALLOCATABLE :: UUAVG(:,:)
35!
36!-------------------------------------------------------------------------------------
37!
38 contains
39!
40!-------------------------------------------------------------------------------------
41 subroutine dvdxdudy(uwnd,vwnd)
42!
43 implicit none
44
45 REAL, dimension(ista_2l:iend_2u,jsta_2l:jend_2u), intent(in) :: UWND, VWND
46!
47!-- local variables
48!--
49 integer i, j
50 real r2dx, r2dy
51 INTEGER, allocatable :: IHE(:),IHW(:)
52!
53 IF(gridtype == 'A')THEN
54!$omp parallel do private(i,j,r2dx,r2dy)
55 DO j=jsta_m,jend_m
56 DO i=ista_m,iend_m
57 IF(vwnd(i+1,j)<spval.AND.vwnd(i-1,j)<spval.AND. &
58 & uwnd(i,j+1)<spval.AND.uwnd(i,j-1)<spval) THEN
59 r2dx = 1./(2.*dx(i,j))
60 r2dy = 1./(2.*dy(i,j))
61 ddvdx(i,j) = (vwnd(i+1,j)-vwnd(i-1,j))*r2dx
62 ddudy(i,j) = (uwnd(i,j+1)-uwnd(i,j-1))*r2dy
63 uuavg(i,j) = uwnd(i,j)
64 END IF
65 END DO
66 END DO
67 ELSE IF (gridtype == 'E')THEN
68 allocate(ihw(jsta_2l:jend_2u), ihe(jsta_2l:jend_2u))
69!$omp parallel do private(j)
70 DO j=jsta_2l,jend_2u
71 ihw(j) = -mod(j,2)
72 ihe(j) = ihw(j)+1
73 ENDDO
74!$omp parallel do private(i,j,r2dx,r2dy)
75 DO j=jsta_m,jend_m
76 DO i=ista_m,iend_m
77 IF(vwnd(i+ihe(j),j) < spval.AND.vwnd(i+ihw(j),j) < spval .AND. &
78 & uwnd(i,j+1) < spval .AND.uwnd(i,j-1) < spval) THEN
79 r2dx = 1./(2.*dx(i,j))
80 r2dy = 1./(2.*dy(i,j))
81 ddvdx(i,j) = (vwnd(i+ihe(j),j)-vwnd(i+ihw(j),j))*r2dx
82 ddudy(i,j) = (uwnd(i,j+1)-uwnd(i,j-1))*r2dy
83 uuavg(i,j) = 0.25*(uwnd(i+ihe(j),j)+uwnd(i+ihw(j),j) &
84 & + uwnd(i,j+1)+uwnd(i,j-1))
85 END IF
86 END DO
87 END DO
88 deallocate(ihw, ihe)
89 ELSE IF (gridtype == 'B')THEN
90!$omp parallel do private(i,j,r2dx,r2dy)
91 DO j=jsta_m,jend_m
92 DO i=ista_m,iend_m
93 r2dx = 1./dx(i,j)
94 r2dy = 1./dy(i,j)
95 if(vwnd(i, j)==spval .or. vwnd(i, j-1)==spval .or. &
96 vwnd(i-1,j)==spval .or. vwnd(i-1,j-1)==spval .or. &
97 uwnd(i, j)==spval .or. uwnd(i-1,j )==spval .or. &
98 uwnd(i,j-1)==spval .or. uwnd(i-1,j-1)==spval) cycle
99 ddvdx(i,j) = (0.5*(vwnd(i,j)+vwnd(i,j-1))-0.5*(vwnd(i-1,j) &
100 & + vwnd(i-1,j-1)))*r2dx
101 ddudy(i,j) = (0.5*(uwnd(i,j)+uwnd(i-1,j))-0.5*(uwnd(i,j-1) &
102 & + uwnd(i-1,j-1)))*r2dy
103 uuavg(i,j) = 0.25*(uwnd(i-1,j-1)+uwnd(i-1,j) &
104 & + uwnd(i, j-1)+uwnd(i, j))
105 END DO
106 END DO
107 END IF
108
109 end subroutine dvdxdudy
110!
111!-------------------------------------------------------------------------------------
112!
113 subroutine h2u(ingrid,outgrid)
114! This subroutine interpolates from H points onto U points
115! Author: CHUANG, EMC, Dec. 2010
116
117 use ctlblk_mod, only: spval, jsta, jend, jsta_m, jend_m, me, num_procs, jm,&
118 im, jsta_2l, jend_2u, ista, iend, ista_m, iend_m, ista_2l, iend_2u
119 use gridspec_mod, only: gridtype
120
121 implicit none
122
123 include "mpif.h"
124 integer:: i,j,ie,iw
125 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(in)::ingrid
126 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(out)::outgrid
127 outgrid=spval
128 if(gridtype == 'A')THEN
129 do j=jsta,jend
130 do i=ista,iend
131 outgrid(i,j)=ingrid(i,j)
132 end do
133 end do
134 else IF(gridtype == 'E')THEN
135 call exch(ingrid(ista_2l,jsta_2l))
136 DO j=jsta_m,jend_m
137 DO i=ista_m,iend_m
138 ie=i+mod(j,2)
139 iw=ie-1
140 outgrid(i,j)=(ingrid(iw,j)+ingrid(ie,j)+ingrid(i,j+1)+ingrid(i,j-1))/4.0
141 end do
142 end do
143 ELSE IF(gridtype == 'B')THEN
144 call exch(ingrid(ista_2l,jsta_2l))
145 DO j=jsta,jend_m
146 DO i=ista,iend_m
147 outgrid(i,j)=(ingrid(i,j)+ingrid(i,j+1)+ingrid(i+1,j)+ingrid(i+1,j+1))/4.0
148 end do
149 end do
150! Fill in boundary points because hysplit fails when 10 m wind has bitmaps
151 do j=jsta,jend_m
152 outgrid(iend,j)=outgrid(iend-1,j)
153 end do
154 IF(me == (num_procs-1) .and. jend_2u >= jm) then
155 DO i=ista,iend
156 outgrid(i,jend) = outgrid(i,jend-1)
157 END DO
158 END IF
159 ELSE IF(gridtype == 'C')THEN
160 DO j=jsta,jend
161 DO i=ista,iend_m
162 outgrid(i,j)=(ingrid(i,j)+ingrid(i+1,j))/2.0
163 end do
164 end do
165 end if
166
167 end subroutine h2u
168!
169!-------------------------------------------------------------------------------------
170!
171 subroutine h2v(ingrid,outgrid)
172! This subroutine interpolates from H points onto V points
173! Author: CHUANG, EMC, Dec. 2010
174 use ctlblk_mod, only: spval, jsta, jend, jsta_m, jend_m, im, jsta_2l, jend_2u,&
175 ista, iend, ista_m, iend_m, ista_2l, iend_2u
176 use gridspec_mod, only: gridtype
177 implicit none
178 include "mpif.h"
179 integer:: i,j,ie,iw
180 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(in)::ingrid
181 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(out)::outgrid
182 outgrid=spval
183 if(gridtype == 'A')THEN
184 do j=jsta,jend
185 do i=ista,iend
186 outgrid(i,j)=ingrid(i,j)
187 end do
188 end do
189 else IF(gridtype == 'E')THEN
190 call exch(ingrid(ista_2l,jsta_2l))
191 DO j=jsta_m,jend_m
192 DO i=ista_m,iend_m
193 ie=i+mod(j,2)
194 iw=ie-1
195 outgrid(i,j)=(ingrid(iw,j)+ingrid(ie,j)+ingrid(i,j+1)+ingrid(i,j-1))/4.0
196 end do
197 end do
198 ELSE IF(gridtype == 'B')THEN
199 call exch(ingrid(ista_2l,jsta_2l))
200 DO j=jsta,jend_m
201 DO i=ista,iend_m
202 outgrid(i,j)=(ingrid(i,j)+ingrid(i,j+1)+ingrid(i+1,j)+ingrid(i+1,j+1))/4.0
203 end do
204 end do
205 ELSE IF(gridtype == 'C')THEN
206 call exch(ingrid(ista_2l,jsta_2l))
207 DO j=jsta,jend_m
208 DO i=ista,iend
209 outgrid(i,j)=(ingrid(i,j)+ingrid(i,j+1))/2.0
210 end do
211 end do
212 end if
213
214 end subroutine h2v
215!
216!-------------------------------------------------------------------------------------
217!
218 subroutine u2h(ingrid,outgrid)
219! This subroutine interpolates from U points onto H points
220! Author: CHUANG, EMC, Dec. 2010
221 use ctlblk_mod, only: spval, jsta, jend, jsta_m, jend_m, im, jsta_2l, jend_2u,&
222 ista, iend, ista_m, iend_m, ista_2l, iend_2u
223 use gridspec_mod, only: gridtype
224 implicit none
225 include "mpif.h"
226 integer:: i,j,ie,iw
227 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(in)::ingrid
228 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(out)::outgrid
229 outgrid=spval
230 if(gridtype == 'A')THEN
231 do j=jsta,jend
232 do i=ista,iend
233 outgrid(i,j)=ingrid(i,j)
234 end do
235 end do
236 else IF(gridtype == 'E')THEN
237 call exch(ingrid(ista_2l,jsta_2l))
238 DO j=jsta_m,jend_m
239 DO i=ista_m,iend_m
240 ie=i+mod(j+1,2)
241 iw=ie-1
242 outgrid(i,j)=(ingrid(iw,j)+ingrid(ie,j)+ingrid(i,j+1)+ingrid(i,j-1))/4.0
243 end do
244 end do
245 ELSE IF(gridtype == 'B')THEN
246 call exch(ingrid(ista_2l,jsta_2l))
247 DO j=jsta_m,jend_m
248 DO i=ista_m,iend_m
249 outgrid(i,j)=(ingrid(i-1,j-1)+ingrid(i,j-1)+ingrid(i-1,j)+ingrid(i,j))/4.0
250 end do
251 end do
252 ELSE IF(gridtype == 'C')THEN
253 DO j=jsta,jend
254 DO i=ista_m,iend
255 outgrid(i,j)=(ingrid(i-1,j)+ingrid(i,j))/2.0
256 end do
257 end do
258 end if
259
260 end subroutine u2h
261!
262!-------------------------------------------------------------------------------------
263!
264 subroutine v2h(ingrid,outgrid)
265! This subroutine interpolates from V points onto H points
266! Author: CHUANG, EMC, Dec. 2010
267 use ctlblk_mod, only: spval, jsta, jend, jsta_m, jend_m, im, jsta_2l, jend_2u,&
268 ista, iend, ista_m, iend_m, ista_2l, iend_2u
269 use gridspec_mod, only: gridtype
270 implicit none
271 include "mpif.h"
272 integer:: i,j,ie,iw
273 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(in)::ingrid
274 real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(out)::outgrid
275 outgrid=spval
276 if(gridtype == 'A')THEN
277 do j=jsta,jend
278 do i=ista,iend
279 outgrid(i,j)=ingrid(i,j)
280 end do
281 end do
282 else IF(gridtype == 'E')THEN
283 call exch(ingrid(ista_2l,jsta_2l))
284 DO j=jsta_m,jend_m
285 DO i=ista_m,iend_m
286 ie=i+mod(j,2)
287 iw=ie-1
288 outgrid(i,j)=(ingrid(iw,j)+ingrid(ie,j)+ingrid(i,j+1)+ingrid(i,j-1))/4.0
289 end do
290 end do
291 ELSE IF(gridtype == 'B')THEN
292 call exch(ingrid(ista_2l,jsta_2l))
293 DO j=jsta_m,jend_m
294 DO i=ista_m,iend_m
295 outgrid(i,j)=(ingrid(i-1,j-1)+ingrid(i,j-1)+ingrid(i-1,j)+ingrid(i,j))/4.0
296 end do
297 end do
298 ELSE IF(gridtype == 'C')THEN
299 call exch(ingrid(ista_2l,jsta_2l))
300 DO j=jsta_m,jend
301 DO i=ista,iend
302 outgrid(i,j)=(ingrid(i,j-1)+ingrid(i,j))/2.0
303 end do
304 end do
305 end if
306
307 end subroutine v2h
308!
309!-------------------------------------------------------------------------------------
310!
311 end module upp_math
upp_math
dvdxdudy() computes dudy, dvdx, uwnd
Definition UPP_MATH.f:17