PageRenderTime 42ms CodeModel.GetById 16ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/dyn_em/module_solvedebug_em.F

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