source: trunk/WRF.COMMON/WRFV3/dyn_em/module_solvedebug_em.F

Last change on this file was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 8.0 KB
Line 
1!WRF:MEDIATION_LAYER:UTIL
2!
3
4MODULE module_solvedebug_em
5CONTAINS
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
325END MODULE module_solvedebug_em
Note: See TracBrowser for help on using the repository browser.