wrfv2_fire/dyn_em/module_solvedebug_em.F

   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