module_solvedebug_em.F

References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:UTIL
2 !
3 
4 MODULE module_solvedebug_em
5 CONTAINS
6       SUBROUTINE var_min_max( u,v,w,t,r,                  &
7                               ids,ide, jds,jde, kds,kde,  & ! domain dims
8                               ims,ime, jms,jme, kms,kme,  & ! memory dims
9                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
10                               its,ite, jts,jte, kts,kte )
11 
12       IMPLICIT NONE
13 
14       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
15       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
16       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
17       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
18 
19       REAL,  DIMENSION( kms: , ims: , jms: ), &
20                    INTENT(IN) :: u,v,w,t,r
21 
22       INTEGER  :: i, j, k, istag, jstag, imax, imin, jmax, jmin, &
23                   kmax, kmin
24 
25       REAL :: vmax, vmin, vavg
26 
27       vmin = u(1,1,1)
28       vmax = u(1,1,1)
29       vavg = 0.
30       imax = 1
31       imin = 1
32       jmax = 1
33       jmin = 1
34       kmax = 1
35       kmin = 1
36 
37       do j=jps,jpe-1
38       do i=ips,ipe
39       do k=kps,kpe-1
40         if(u(k,i,j) .gt. vmax) then
41           vmax = u(k,i,j)
42           imax = i
43           jmax = j
44           kmax = k
45          endif
46 
47         if(u(k,i,j) .lt. vmin) then
48           vmin = u(k,i,j)
49           imin = i
50           jmin = j
51           kmin = k
52          endif
53         vavg = vavg + abs(u(k,i,j))
54       enddo
55       enddo
56       enddo
57       vavg = vavg/float((ipe-ips)*(jpe-jps-1)*(kpe-kps-1))
58       write(6,*) ' ru min,max,avg ',vmin,vmax,vavg
59       write(6,*) kmax, imax, jmax, kmin, imin, jmin
60 
61 
62       vmin = v(1,1,1)
63       vmax = v(1,1,1)
64       vavg = 0.
65       imax = 1
66       imin = 1
67       jmax = 1
68       jmin = 1
69       kmax = 1
70       kmin = 1
71 
72       do j=jps,jpe
73       do i=ips,ipe-1
74       do k=kps,kpe-1
75         if(v(k,i,j) .gt. vmax) then
76           vmax = v(k,i,j)
77           imax = i
78           jmax = j
79           kmax = k
80         endif
81         if(v(k,i,j) .lt. vmin) then
82           vmin = v(k,i,j)
83           imin = i
84           jmin = j
85           kmin = k
86         endif
87         vavg = vavg + abs(v(k,i,j))
88       enddo
89       enddo
90       enddo
91       vavg = vavg/float((ipe-ips-1)*(jpe-jps)*(kpe-kps-1))
92       write(6,*) ' rv min,max,avg ',vmin,vmax,vavg
93       write(6,*) kmax, imax, jmax, kmin, imin, jmin
94 
95 
96 
97       vmin = w(1,1,1)
98       vmax = w(1,1,1)
99       vavg = 0.
100       imax = 1
101       imin = 1
102       jmax = 1
103       jmin = 1
104       kmax = 1
105       kmin = 1
106 
107       do j=jps,jpe-1
108       do i=ips,ipe-1
109       do k=kps,kpe
110         if(w(k,i,j) .gt. vmax) then
111           vmax = w(k,i,j)
112           imax = i
113           jmax = j
114           kmax = k
115         endif
116         if(w(k,i,j) .lt. vmin) then
117           vmin = w(k,i,j)
118           imin = i
119           jmin = j
120           kmin = k
121         endif
122         vavg = vavg + abs(w(k,i,j))
123       enddo
124       enddo
125       enddo
126       vavg = vavg/float((ipe-ips-1)*(jpe-jps-1)*(kpe-kps))
127       write(6,*) ' rom min,max,avg ',vmin,vmax,vavg
128       write(6,*) kmax, imax, jmax, kmin, imin, jmin
129 
130 
131 
132       vmin = t(1,1,1)
133       vmax = t(1,1,1)
134       vavg = 0.
135       imax = 1
136       imin = 1
137       jmax = 1
138       jmin = 1
139       kmax = 1
140       kmin = 1
141 
142       do j=jps,jpe-1
143       do i=ips,ipe-1
144       do k=kps,kpe-1
145         if(t(k,i,j) .gt. vmax) then
146           vmax = t(k,i,j)
147           imax = i
148           jmax = j
149           kmax = k
150         endif
151         if(t(k,i,j) .lt. vmin) then
152           vmin = t(k,i,j)
153           imin = i
154           jmin = j
155           kmin = k
156         endif
157         vavg = vavg + abs(t(k,i,j))
158       enddo
159       enddo
160       enddo
161       vavg = vavg/float((ipe-ips-1)*(jpe-jps-1)*(kpe-kps-1))
162       write(6,*) ' rtp min,max,avg ',vmin,vmax,vavg
163       write(6,*) kmax, imax, jmax, kmin, imin, jmin
164 
165 
166 
167       vmin = r(1,1,1)
168       vmax = r(1,1,1)
169       vavg = 0.
170       imax = 1
171       imin = 1
172       jmax = 1
173       jmin = 1
174       kmax = 1
175       kmin = 1
176 
177       do j=jps,jpe-1
178       do i=ips,ipe-1
179       do k=kps,kpe-1
180         if(r(k,i,j) .gt. vmax) then
181           vmax = r(k,i,j)
182           imax = i
183           jmax = j
184           kmax = k
185         endif
186         if(r(k,i,j) .lt. vmin) then
187           vmin = r(k,i,j)
188           imin = i
189           jmin = j
190           kmin = k
191         endif
192         vavg = vavg + abs(r(k,i,j))
193       enddo
194       enddo
195       enddo
196       vavg = vavg/float((ipe-ips-1)*(jpe-jps-1)*(kpe-kps-1))
197       write(6,*) ' rhop min,max,avg ',vmin,vmax,vavg
198       write(6,*) kmax, imax, jmax, kmin, imin, jmin
199 
200       return
201       end subroutine var_min_max
202 
203       SUBROUTINE var1_min_max( u, &
204                               ids,ide, jds,jde, kds,kde,  & ! domain dims
205                               ims,ime, jms,jme, kms,kme,  & ! memory dims
206                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
207                               its,ite, jts,jte, kts,kte )
208 
209       IMPLICIT NONE
210 
211       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
212       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
213       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
214       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
215 
216       REAL,  DIMENSION(kms: , ims: , jms: ), &
217                    INTENT(IN) :: u
218 
219       INTEGER  :: i, j, k, istag, jstag, imax, imin, jmax, jmin, &
220                   kmax, kmin
221 
222       REAL :: vmax, vmin, vavg
223 
224       write(6,*) ' min, max, and avg stats '
225 
226       vmin = u(1,1,1)
227       vmax = u(1,1,1)
228       vavg = 0.
229       imax = 1
230       imin = 1
231       jmax = 1
232       jmin = 1
233       kmax = 1
234       kmin = 1
235 
236       do j=jps,jpe-1
237       do i=ips,ipe
238       do k=kps,kpe-1
239         if(u(k,i,j) .gt. vmax) then
240           vmax = u(k,i,j)
241           imax = i
242           jmax = j
243           kmax = k
244          endif
245 
246         if(u(k,i,j) .lt. vmin) then
247           vmin = u(k,i,j)
248           imin = i
249           jmin = j
250           kmin = k
251          endif
252         vavg = vavg + abs(u(k,i,j))
253       enddo
254       enddo
255       enddo
256       vavg = vavg/float((ipe-ips)*(jpe-jps-1)*(kpe-kps-1))
257       write(6,*) ' ru max,min,avg ',vmax,vmin,vavg
258       write(6,*) kmax, imax, jmax, kmin, imin, jmin
259 
260       return
261       end subroutine var1_min_max
262 
263 
264 
265 
266       SUBROUTINE var_print ( u, &
267                               ims,ime, jms,jme, kms,kme,  & ! memory dims
268                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
269                               level                )  
270 
271       IMPLICIT NONE
272 
273       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
274       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
275       INTEGER,      INTENT(IN   )    :: level
276 
277       REAL,  DIMENSION(kms:kme, ims:ime, jms:jme), &
278                    INTENT(IN) :: u
279 
280       INTEGER  :: i, j, k, istag, jstag, it, imax, imin, jmax, jmin, &
281                   kmax, kmin, ii,jj
282 
283       REAL :: vmax, vmin, vavg
284 
285       write(6,*) ' level for print ',level
286       write(6,*) (u(level, ii, 1),ii=1,ipe)
287       write(6,*) (u(level, 1, jj),jj=1,jpe)
288 
289       return
290       end subroutine var_print
291 
292       SUBROUTINE symm_check ( f, &
293                               ids,ide, jds,jde, kds,kde,  & ! domain dims
294                               ims,ime, jms,jme, kms,kme,  & ! memory dims
295                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
296                               level                )  
297 
298       IMPLICIT NONE
299 
300       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
301       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
302       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
303       INTEGER,      INTENT(IN   )    :: level
304 
305       REAL,  DIMENSION(kms:kme, ims:ime, jms:jme), &
306                    INTENT(IN) :: f
307 
308       INTEGER  :: i, j, k, istag, jstag, it, imax, imin, jmax, jmin, &
309                   kmax, kmin, ii,jj
310 
311       REAL :: vmax, vmin, vavg
312 
313       write(6,*) ide,' = ide'
314 
315       do k=kps,kpe
316        do i=ips,ipe
317         do j=jps,jpe
318           if(f(k,i,j).ne.f(k,ide-i,j))print *,' x asymmetry at kij ',k,i,j
319           if(f(k,i,j).ne.f(k,i,jde-j))print *,' y asymmetry at kij ',k,i,j
320         enddo
321        enddo
322       enddo
323       return
324       end subroutine symm_check
325 END MODULE module_solvedebug_em