PageRenderTime 56ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/phys/module_diagnostics.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 968 lines | 674 code | 93 blank | 201 comment | 4 complexity | 45725a89f9860b1289b80ae91cf9df4a MD5 | raw file
Possible License(s): AGPL-1.0
  1. !WRF:MEDIATION_LAYER:PHYSICS
  2. !
  3. MODULE module_diagnostics
  4. CONTAINS
  5. SUBROUTINE diagnostic_output_calc( &
  6. ids,ide, jds,jde, kds,kde, &
  7. ims,ime, jms,jme, kms,kme, &
  8. ips,ipe, jps,jpe, kps,kpe, & ! patch dims
  9. i_start,i_end,j_start,j_end,kts,kte,num_tiles &
  10. ,dpsdt,dmudt &
  11. ,p8w,pk1m,mu_2,mu_2m &
  12. ,u,v &
  13. ,raincv,rainncv,rainc,rainnc &
  14. ,i_rainc,i_rainnc &
  15. ,hfx,sfcevp,lh &
  16. ,ACSWUPT,ACSWUPTC,ACSWDNT,ACSWDNTC & ! Optional
  17. ,ACSWUPB,ACSWUPBC,ACSWDNB,ACSWDNBC & ! Optional
  18. ,ACLWUPT,ACLWUPTC,ACLWDNT,ACLWDNTC & ! Optional
  19. ,ACLWUPB,ACLWUPBC,ACLWDNB,ACLWDNBC & ! Optional
  20. ,I_ACSWUPT,I_ACSWUPTC,I_ACSWDNT,I_ACSWDNTC & ! Optional
  21. ,I_ACSWUPB,I_ACSWUPBC,I_ACSWDNB,I_ACSWDNBC & ! Optional
  22. ,I_ACLWUPT,I_ACLWUPTC,I_ACLWDNT,I_ACLWDNTC & ! Optional
  23. ,I_ACLWUPB,I_ACLWUPBC,I_ACLWDNB,I_ACLWDNBC & ! Optional
  24. ,dt,xtime,sbw,t2 &
  25. ,diag_print &
  26. ,bucket_mm, bucket_J &
  27. ,prec_acc_c, prec_acc_nc, snow_acc_nc &
  28. ,snowncv, prec_acc_dt, curr_secs &
  29. )
  30. !----------------------------------------------------------------------
  31. USE module_dm, ONLY: wrf_dm_sum_real, wrf_dm_maxval
  32. IMPLICIT NONE
  33. !======================================================================
  34. ! Definitions
  35. !-----------
  36. !-- DIAG_PRINT print control: 0 - no diagnostics; 1 - dmudt only; 2 - all
  37. !-- DT time step (second)
  38. !-- XTIME forecast time
  39. !-- SBW specified boundary width - used later
  40. !
  41. !-- P8W 3D pressure array at full eta levels
  42. !-- MU dry column hydrostatic pressure
  43. !-- RAINC cumulus scheme precipitation since hour 0
  44. !-- RAINCV cumulus scheme precipitation in one time step (mm)
  45. !-- RAINNC explicit scheme precipitation since hour 0
  46. !-- RAINNCV explicit scheme precipitation in one time step (mm)
  47. !-- SNOWNCV explicit scheme snow in one time step (mm)
  48. !-- HFX surface sensible heat flux
  49. !-- LH surface latent heat flux
  50. !-- SFCEVP total surface evaporation
  51. !-- U u component of wind - to be used later to compute k.e.
  52. !-- V v component of wind - to be used later to compute k.e.
  53. !-- PREC_ACC_C accumulated convective precip over accumulation time prec_acc_dt
  54. !-- PREC_ACC_NC accumulated explicit precip over accumulation time prec_acc_dt
  55. !-- SNOW_ACC_NC accumulated explicit snow precip over accumulation time prec_acc_dt
  56. !-- PREC_ACC_DT precip accumulation time, default is 60 min
  57. !-- CURR_SECS model time in seconds
  58. !
  59. !-- ids start index for i in domain
  60. !-- ide end index for i in domain
  61. !-- jds start index for j in domain
  62. !-- jde end index for j in domain
  63. !-- kds start index for k in domain
  64. !-- kde end index for k in domain
  65. !-- ims start index for i in memory
  66. !-- ime end index for i in memory
  67. !-- jms start index for j in memory
  68. !-- jme end index for j in memory
  69. !-- ips start index for i in patch
  70. !-- ipe end index for i in patch
  71. !-- jps start index for j in patch
  72. !-- jpe end index for j in patch
  73. !-- kms start index for k in memory
  74. !-- kme end index for k in memory
  75. !-- i_start start indices for i in tile
  76. !-- i_end end indices for i in tile
  77. !-- j_start start indices for j in tile
  78. !-- j_end end indices for j in tile
  79. !-- kts start index for k in tile
  80. !-- kte end index for k in tile
  81. !-- num_tiles number of tiles
  82. !
  83. !======================================================================
  84. INTEGER, INTENT(IN ) :: &
  85. ids,ide, jds,jde, kds,kde, &
  86. ims,ime, jms,jme, kms,kme, &
  87. ips,ipe, jps,jpe, kps,kpe, &
  88. kts,kte, &
  89. num_tiles
  90. INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
  91. & i_start,i_end,j_start,j_end
  92. INTEGER, INTENT(IN ) :: diag_print
  93. REAL, INTENT(IN ) :: bucket_mm, bucket_J
  94. REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
  95. INTENT(IN ) :: u &
  96. , v &
  97. , p8w
  98. REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: &
  99. MU_2 &
  100. , RAINNCV &
  101. , RAINCV &
  102. , SNOWNCV &
  103. , HFX &
  104. , LH &
  105. , SFCEVP &
  106. , T2
  107. REAL, DIMENSION( ims:ime , jms:jme ), &
  108. INTENT(INOUT) :: DPSDT &
  109. , DMUDT &
  110. , RAINNC &
  111. , RAINC &
  112. , MU_2M &
  113. , PK1M
  114. REAL, INTENT(IN ) :: DT, XTIME
  115. INTEGER, INTENT(IN ) :: SBW
  116. INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: &
  117. I_RAINC, &
  118. I_RAINNC
  119. REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
  120. ACSWUPT,ACSWUPTC,ACSWDNT,ACSWDNTC, &
  121. ACSWUPB,ACSWUPBC,ACSWDNB,ACSWDNBC, &
  122. ACLWUPT,ACLWUPTC,ACLWDNT,ACLWDNTC, &
  123. ACLWUPB,ACLWUPBC,ACLWDNB,ACLWDNBC
  124. INTEGER, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
  125. I_ACSWUPT,I_ACSWUPTC,I_ACSWDNT,I_ACSWDNTC, &
  126. I_ACSWUPB,I_ACSWUPBC,I_ACSWDNB,I_ACSWDNBC, &
  127. I_ACLWUPT,I_ACLWUPTC,I_ACLWDNT,I_ACLWDNTC, &
  128. I_ACLWUPB,I_ACLWUPBC,I_ACLWDNB,I_ACLWDNBC
  129. REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
  130. PREC_ACC_C, PREC_ACC_NC, SNOW_ACC_NC
  131. REAL, OPTIONAL, INTENT(IN):: PREC_ACC_DT, CURR_SECS
  132. INTEGER :: i,j,k,its,ite,jts,jte,ij
  133. INTEGER :: idp,jdp,irc,jrc,irnc,jrnc,isnh,jsnh
  134. INTEGER :: prfreq
  135. REAL :: no_points
  136. REAL :: dpsdt_sum, dmudt_sum, dardt_sum, drcdt_sum, drndt_sum
  137. REAL :: hfx_sum, lh_sum, sfcevp_sum, rainc_sum, rainnc_sum, raint_sum
  138. REAL :: dmumax, raincmax, rainncmax, snowhmax
  139. LOGICAL, EXTERNAL :: wrf_dm_on_monitor
  140. CHARACTER*256 :: outstring
  141. CHARACTER*6 :: grid_str
  142. !-----------------------------------------------------------------
  143. ! Handle accumulations with buckets to prevent round-off truncation in long runs
  144. ! This is done every 360 minutes assuming time step fits exactly into 360 minutes
  145. IF(bucket_mm .gt. 0. .AND. MOD(NINT(XTIME),360) .EQ. 0)THEN
  146. ! SET START AND END POINTS FOR TILES
  147. ! !$OMP PARALLEL DO &
  148. ! !$OMP PRIVATE ( ij )
  149. DO ij = 1 , num_tiles
  150. IF (xtime .eq. 0.0)THEN
  151. DO j=j_start(ij),j_end(ij)
  152. DO i=i_start(ij),i_end(ij)
  153. i_rainnc(i,j) = 0
  154. i_rainc(i,j) = 0
  155. ENDDO
  156. ENDDO
  157. ENDIF
  158. DO j=j_start(ij),j_end(ij)
  159. DO i=i_start(ij),i_end(ij)
  160. IF(rainnc(i,j) .gt. bucket_mm)THEN
  161. rainnc(i,j) = rainnc(i,j) - bucket_mm
  162. i_rainnc(i,j) = i_rainnc(i,j) + 1
  163. ENDIF
  164. IF(rainc(i,j) .gt. bucket_mm)THEN
  165. rainc(i,j) = rainc(i,j) - bucket_mm
  166. i_rainc(i,j) = i_rainc(i,j) + 1
  167. ENDIF
  168. ENDDO
  169. ENDDO
  170. IF (xtime .eq. 0.0 .and. bucket_J .gt. 0.0 .and. PRESENT(ACSWUPT))THEN
  171. DO j=j_start(ij),j_end(ij)
  172. DO i=i_start(ij),i_end(ij)
  173. i_acswupt(i,j) = 0
  174. i_acswuptc(i,j) = 0
  175. i_acswdnt(i,j) = 0
  176. i_acswdntc(i,j) = 0
  177. i_acswupb(i,j) = 0
  178. i_acswupbc(i,j) = 0
  179. i_acswdnb(i,j) = 0
  180. i_acswdnbc(i,j) = 0
  181. ENDDO
  182. ENDDO
  183. ENDIF
  184. IF (xtime .eq. 0.0 .and. bucket_J .gt. 0.0 .and. PRESENT(ACLWUPT))THEN
  185. DO j=j_start(ij),j_end(ij)
  186. DO i=i_start(ij),i_end(ij)
  187. i_aclwupt(i,j) = 0
  188. i_aclwuptc(i,j) = 0
  189. i_aclwdnt(i,j) = 0
  190. i_aclwdntc(i,j) = 0
  191. i_aclwupb(i,j) = 0
  192. i_aclwupbc(i,j) = 0
  193. i_aclwdnb(i,j) = 0
  194. i_aclwdnbc(i,j) = 0
  195. ENDDO
  196. ENDDO
  197. ENDIF
  198. IF (PRESENT(ACSWUPT) .and. bucket_J .gt. 0.0)THEN
  199. DO j=j_start(ij),j_end(ij)
  200. DO i=i_start(ij),i_end(ij)
  201. IF(acswupt(i,j) .gt. bucket_J)THEN
  202. acswupt(i,j) = acswupt(i,j) - bucket_J
  203. i_acswupt(i,j) = i_acswupt(i,j) + 1
  204. ENDIF
  205. IF(acswuptc(i,j) .gt. bucket_J)THEN
  206. acswuptc(i,j) = acswuptc(i,j) - bucket_J
  207. i_acswuptc(i,j) = i_acswuptc(i,j) + 1
  208. ENDIF
  209. IF(acswdnt(i,j) .gt. bucket_J)THEN
  210. acswdnt(i,j) = acswdnt(i,j) - bucket_J
  211. i_acswdnt(i,j) = i_acswdnt(i,j) + 1
  212. ENDIF
  213. IF(acswdntc(i,j) .gt. bucket_J)THEN
  214. acswdntc(i,j) = acswdntc(i,j) - bucket_J
  215. i_acswdntc(i,j) = i_acswdntc(i,j) + 1
  216. ENDIF
  217. IF(acswupb(i,j) .gt. bucket_J)THEN
  218. acswupb(i,j) = acswupb(i,j) - bucket_J
  219. i_acswupb(i,j) = i_acswupb(i,j) + 1
  220. ENDIF
  221. IF(acswupbc(i,j) .gt. bucket_J)THEN
  222. acswupbc(i,j) = acswupbc(i,j) - bucket_J
  223. i_acswupbc(i,j) = i_acswupbc(i,j) + 1
  224. ENDIF
  225. IF(acswdnb(i,j) .gt. bucket_J)THEN
  226. acswdnb(i,j) = acswdnb(i,j) - bucket_J
  227. i_acswdnb(i,j) = i_acswdnb(i,j) + 1
  228. ENDIF
  229. IF(acswdnbc(i,j) .gt. bucket_J)THEN
  230. acswdnbc(i,j) = acswdnbc(i,j) - bucket_J
  231. i_acswdnbc(i,j) = i_acswdnbc(i,j) + 1
  232. ENDIF
  233. ENDDO
  234. ENDDO
  235. ENDIF
  236. IF (PRESENT(ACLWUPT) .and. bucket_J .gt. 0.0)THEN
  237. DO j=j_start(ij),j_end(ij)
  238. DO i=i_start(ij),i_end(ij)
  239. IF(aclwupt(i,j) .gt. bucket_J)THEN
  240. aclwupt(i,j) = aclwupt(i,j) - bucket_J
  241. i_aclwupt(i,j) = i_aclwupt(i,j) + 1
  242. ENDIF
  243. IF(aclwuptc(i,j) .gt. bucket_J)THEN
  244. aclwuptc(i,j) = aclwuptc(i,j) - bucket_J
  245. i_aclwuptc(i,j) = i_aclwuptc(i,j) + 1
  246. ENDIF
  247. IF(aclwdnt(i,j) .gt. bucket_J)THEN
  248. aclwdnt(i,j) = aclwdnt(i,j) - bucket_J
  249. i_aclwdnt(i,j) = i_aclwdnt(i,j) + 1
  250. ENDIF
  251. IF(aclwdntc(i,j) .gt. bucket_J)THEN
  252. aclwdntc(i,j) = aclwdntc(i,j) - bucket_J
  253. i_aclwdntc(i,j) = i_aclwdntc(i,j) + 1
  254. ENDIF
  255. IF(aclwupb(i,j) .gt. bucket_J)THEN
  256. aclwupb(i,j) = aclwupb(i,j) - bucket_J
  257. i_aclwupb(i,j) = i_aclwupb(i,j) + 1
  258. ENDIF
  259. IF(aclwupbc(i,j) .gt. bucket_J)THEN
  260. aclwupbc(i,j) = aclwupbc(i,j) - bucket_J
  261. i_aclwupbc(i,j) = i_aclwupbc(i,j) + 1
  262. ENDIF
  263. IF(aclwdnb(i,j) .gt. bucket_J)THEN
  264. aclwdnb(i,j) = aclwdnb(i,j) - bucket_J
  265. i_aclwdnb(i,j) = i_aclwdnb(i,j) + 1
  266. ENDIF
  267. IF(aclwdnbc(i,j) .gt. bucket_J)THEN
  268. aclwdnbc(i,j) = aclwdnbc(i,j) - bucket_J
  269. i_aclwdnbc(i,j) = i_aclwdnbc(i,j) + 1
  270. ENDIF
  271. ENDDO
  272. ENDDO
  273. ENDIF
  274. ENDDO
  275. ! !$OMP END PARALLEL DO
  276. ENDIF
  277. ! Compute precipitation accumulation in a given time window: prec_acc_dt
  278. IF (prec_acc_dt .gt. 0.) THEN
  279. ! !$OMP PARALLEL DO &
  280. ! !$OMP PRIVATE ( ij )
  281. DO ij = 1 , num_tiles
  282. DO j=j_start(ij),j_end(ij)
  283. DO i=i_start(ij),i_end(ij)
  284. IF (mod(curr_secs, 60.* prec_acc_dt) == 0.) THEN
  285. prec_acc_c(i,j) = 0.
  286. prec_acc_nc(i,j) = 0.
  287. snow_acc_nc(i,j) = 0.
  288. ENDIF
  289. prec_acc_c(i,j) = prec_acc_c(i,j) + RAINCV(i,j)
  290. prec_acc_nc(i,j) = prec_acc_nc(i,j) + RAINNCV(i,j)
  291. prec_acc_c(i,j) = MAX (prec_acc_c(i,j), 0.0)
  292. prec_acc_nc(i,j) = MAX (prec_acc_nc(i,j), 0.0)
  293. snow_acc_nc(i,j) = snow_acc_nc(i,j) + SNOWNCV(I,J)
  294. ! add convective precip to snow bucket if t2 < 273.15
  295. IF ( t2(i,j) .lt. 273.15 ) THEN
  296. snow_acc_nc(i,j) = snow_acc_nc(i,j) + RAINCV(i,j)
  297. snow_acc_nc(i,j) = MAX (snow_acc_nc(i,j), 0.0)
  298. ENDIF
  299. ENDDO
  300. ENDDO
  301. ENDDO
  302. ! !$OMP END PARALLEL DO
  303. ENDIF
  304. if (diag_print .eq. 0 ) return
  305. IF ( xtime .ne. 0. ) THEN
  306. if(diag_print.eq.1) then
  307. prfreq = dt
  308. ! prfreq = max(2,int(dt/60.)) ! in min
  309. else
  310. prfreq=10 ! in min
  311. endif
  312. IF (MOD(nint(dt),prfreq) == 0) THEN
  313. ! COMPUTE THE NUMBER OF MASS GRID POINTS
  314. no_points = float((ide-ids)*(jde-jds))
  315. ! SET START AND END POINTS FOR TILES
  316. ! !$OMP PARALLEL DO &
  317. ! !$OMP PRIVATE ( ij )
  318. dmumax = 0.
  319. DO ij = 1 , num_tiles
  320. ! print *, i_start(ij),i_end(ij),j_start(ij),j_end(ij)
  321. DO j=j_start(ij),j_end(ij)
  322. DO i=i_start(ij),i_end(ij)
  323. dpsdt(i,j)=(p8w(i,kms,j)-pk1m(i,j))/dt
  324. dmudt(i,j)=(mu_2(i,j)-mu_2m(i,j))/dt
  325. if(abs(dmudt(i,j)*dt).gt.dmumax)then
  326. dmumax=abs(dmudt(i,j)*dt)
  327. idp=i
  328. jdp=j
  329. endif
  330. ENDDO
  331. ENDDO
  332. ENDDO
  333. ! !$OMP END PARALLEL DO
  334. ! convert DMUMAX from (PA) to (bars) per time step
  335. dmumax = dmumax*1.e-5
  336. ! compute global MAX
  337. CALL wrf_dm_maxval ( dmumax, idp, jdp )
  338. ! print *, 'p8w(30,1,30),pk1m(30,30) : ', p8w(30,1,30),pk1m(30,30)
  339. ! print *, 'mu_2(30,30),mu_2m(30,30) : ', mu_2(30,30),mu_2m(30,30)
  340. dpsdt_sum = 0.
  341. dmudt_sum = 0.
  342. DO j = jps, min(jpe,jde-1)
  343. DO i = ips, min(ipe,ide-1)
  344. dpsdt_sum = dpsdt_sum + abs(dpsdt(i,j))
  345. dmudt_sum = dmudt_sum + abs(dmudt(i,j))
  346. ENDDO
  347. ENDDO
  348. ! compute global sum
  349. dpsdt_sum = wrf_dm_sum_real ( dpsdt_sum )
  350. dmudt_sum = wrf_dm_sum_real ( dmudt_sum )
  351. ! print *, 'dpsdt, dmudt : ', dpsdt_sum, dmudt_sum
  352. IF ( diag_print .eq. 2 ) THEN
  353. dardt_sum = 0.
  354. drcdt_sum = 0.
  355. drndt_sum = 0.
  356. rainc_sum = 0.
  357. raint_sum = 0.
  358. rainnc_sum = 0.
  359. sfcevp_sum = 0.
  360. hfx_sum = 0.
  361. lh_sum = 0.
  362. raincmax = 0.
  363. rainncmax = 0.
  364. DO j = jps, min(jpe,jde-1)
  365. DO i = ips, min(ipe,ide-1)
  366. drcdt_sum = drcdt_sum + abs(raincv(i,j))
  367. drndt_sum = drndt_sum + abs(rainncv(i,j))
  368. dardt_sum = dardt_sum + abs(raincv(i,j)) + abs(rainncv(i,j))
  369. rainc_sum = rainc_sum + abs(rainc(i,j))
  370. ! MAX for accumulated conv precip
  371. IF(rainc(i,j).gt.raincmax)then
  372. raincmax=rainc(i,j)
  373. irc=i
  374. jrc=j
  375. ENDIF
  376. rainnc_sum = rainnc_sum + abs(rainnc(i,j))
  377. ! MAX for accumulated resolved precip
  378. IF(rainnc(i,j).gt.rainncmax)then
  379. rainncmax=rainnc(i,j)
  380. irnc=i
  381. jrnc=j
  382. ENDIF
  383. raint_sum = raint_sum + abs(rainc(i,j)) + abs(rainnc(i,j))
  384. sfcevp_sum = sfcevp_sum + abs(sfcevp(i,j))
  385. hfx_sum = hfx_sum + abs(hfx(i,j))
  386. lh_sum = lh_sum + abs(lh(i,j))
  387. ENDDO
  388. ENDDO
  389. ! compute global MAX
  390. CALL wrf_dm_maxval ( raincmax, irc, jrc )
  391. CALL wrf_dm_maxval ( rainncmax, irnc, jrnc )
  392. ! compute global sum
  393. drcdt_sum = wrf_dm_sum_real ( drcdt_sum )
  394. drndt_sum = wrf_dm_sum_real ( drndt_sum )
  395. dardt_sum = wrf_dm_sum_real ( dardt_sum )
  396. rainc_sum = wrf_dm_sum_real ( rainc_sum )
  397. rainnc_sum = wrf_dm_sum_real ( rainnc_sum )
  398. raint_sum = wrf_dm_sum_real ( raint_sum )
  399. sfcevp_sum = wrf_dm_sum_real ( sfcevp_sum )
  400. hfx_sum = wrf_dm_sum_real ( hfx_sum )
  401. lh_sum = wrf_dm_sum_real ( lh_sum )
  402. ENDIF
  403. ! print out the average values
  404. CALL get_current_grid_name( grid_str )
  405. #ifdef DM_PARALLEL
  406. IF ( wrf_dm_on_monitor() ) THEN
  407. #endif
  408. WRITE(outstring,*) grid_str,'Domain average of dpsdt, dmudt (mb/3h): ', xtime, &
  409. dpsdt_sum/no_points*108., &
  410. dmudt_sum/no_points*108.
  411. CALL wrf_message ( TRIM(outstring) )
  412. WRITE(outstring,*) grid_str,'Max mu change time step: ', idp,jdp,dmumax
  413. CALL wrf_message ( TRIM(outstring) )
  414. IF ( diag_print .eq. 2) THEN
  415. WRITE(outstring,*) grid_str,'Domain average of dardt, drcdt, drndt (mm/sec): ', xtime, &
  416. dardt_sum/dt/no_points, &
  417. drcdt_sum/dt/no_points, &
  418. drndt_sum/dt/no_points
  419. CALL wrf_message ( TRIM(outstring) )
  420. WRITE(outstring,*) grid_str,'Domain average of rt_sum, rc_sum, rnc_sum (mm): ', xtime, &
  421. raint_sum/no_points, &
  422. rainc_sum/no_points, &
  423. rainnc_sum/no_points
  424. CALL wrf_message ( TRIM(outstring) )
  425. WRITE(outstring,*) grid_str,'Max Accum Resolved Precip, I,J (mm): ' ,&
  426. rainncmax,irnc,jrnc
  427. CALL wrf_message ( TRIM(outstring) )
  428. WRITE(outstring,*) grid_str,'Max Accum Convective Precip, I,J (mm): ' ,&
  429. raincmax,irc,jrc
  430. CALL wrf_message ( TRIM(outstring) )
  431. WRITE(outstring,*) grid_str,'Domain average of sfcevp, hfx, lh: ', xtime, &
  432. sfcevp_sum/no_points, &
  433. hfx_sum/no_points, &
  434. lh_sum/no_points
  435. CALL wrf_message ( TRIM(outstring) )
  436. ENDIF
  437. #ifdef DM_PARALLEL
  438. ENDIF
  439. #endif
  440. ENDIF ! print frequency
  441. ENDIF
  442. ! save values at this time step
  443. !$OMP PARALLEL DO &
  444. !$OMP PRIVATE ( ij,i,j )
  445. DO ij = 1 , num_tiles
  446. DO j=j_start(ij),j_end(ij)
  447. DO i=i_start(ij),i_end(ij)
  448. pk1m(i,j)=p8w(i,kms,j)
  449. mu_2m(i,j)=mu_2(i,j)
  450. ENDDO
  451. ENDDO
  452. IF ( xtime .lt. 0.0001 ) THEN
  453. DO j=j_start(ij),j_end(ij)
  454. DO i=i_start(ij),i_end(ij)
  455. dpsdt(i,j)=0.
  456. dmudt(i,j)=0.
  457. ENDDO
  458. ENDDO
  459. ENDIF
  460. ENDDO
  461. !$OMP END PARALLEL DO
  462. END SUBROUTINE diagnostic_output_calc
  463. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  464. SUBROUTINE clwrf_output_calc( &
  465. ids,ide, jds,jde, kds,kde, &
  466. ims,ime, jms,jme, kms,kme, &
  467. ips,ipe, jps,jpe, kps,kpe, & ! patch dims
  468. i_start,i_end,j_start,j_end,kts,kte,num_tiles &
  469. ,dpsdt,dmudt &
  470. ,p8w,pk1m,mu_2,mu_2m &
  471. ,u,v &
  472. ,is_restart & ! CLWRF
  473. ,clwrfH,t2,q2,u10,v10, skintemp & ! CLWRF
  474. ,t2clmin,t2clmax,tt2clmin,tt2clmax & ! CLWRF
  475. ,t2clmean,t2clstd & ! CLWRF
  476. ,q2clmin,q2clmax,tq2clmin,tq2clmax & ! CLWRF
  477. ,q2clmean,q2clstd & ! CLWRF
  478. ,u10clmax,v10clmax,spduv10clmax,tspduv10clmax & ! CLWRF
  479. ,u10clmean,v10clmean,spduv10clmean & ! CLWRF
  480. ,u10clstd,v10clstd,spduv10clstd & ! CLWRF
  481. ,raincclmax,rainncclmax,traincclmax,trainncclmax & ! CLWRF
  482. ,raincclmean,rainncclmean,raincclstd,rainncclstd & ! CLWRF
  483. ,skintempclmin,skintempclmax & ! CLWRF
  484. ,tskintempclmin,tskintempclmax & ! CLWRF
  485. ,skintempclmean,skintempclstd & ! CLWRF
  486. ,raincv,rainncv,rainc,rainnc &
  487. ,i_rainc,i_rainnc &
  488. ,hfx,sfcevp,lh &
  489. ,dt,xtime,sbw &
  490. ,diag_print &
  491. ,bucket_mm, bucket_J &
  492. )
  493. !----------------------------------------------------------------------
  494. USE module_dm, ONLY: wrf_dm_sum_real, wrf_dm_maxval
  495. USE module_configure
  496. IMPLICIT NONE
  497. !======================================================================
  498. ! Definitions
  499. !-----------
  500. !-- DT time step (second)
  501. !-- XTIME forecast time
  502. !-- SBW specified boundary width - used later
  503. !
  504. !-- P8W 3D pressure array at full eta levels
  505. !-- MU dry column hydrostatic pressure
  506. !-- RAINC cumulus scheme precipitation since hour 0
  507. !-- RAINCV cumulus scheme precipitation in one time step (mm)
  508. !-- RAINNC explicit scheme precipitation since hour 0
  509. !-- RAINNCV explicit scheme precipitation in one time step (mm)
  510. !-- HFX surface sensible heat flux
  511. !-- LH surface latent heat flux
  512. !-- SFCEVP total surface evaporation
  513. !-- U u component of wind - to be used later to compute k.e.
  514. !-- V v component of wind - to be used later to compute k.e.
  515. !
  516. !-- ids start index for i in domain
  517. !-- ide end index for i in domain
  518. !-- jds start index for j in domain
  519. !-- jde end index for j in domain
  520. !-- kds start index for k in domain
  521. !-- kde end index for k in domain
  522. !-- ims start index for i in memory
  523. !-- ime end index for i in memory
  524. !-- jms start index for j in memory
  525. !-- jme end index for j in memory
  526. !-- ips start index for i in patch
  527. !-- ipe end index for i in patch
  528. !-- jps start index for j in patch
  529. !-- jpe end index for j in patch
  530. !-- kms start index for k in memory
  531. !-- kme end index for k in memory
  532. !-- i_start start indices for i in tile
  533. !-- i_end end indices for i in tile
  534. !-- j_start start indices for j in tile
  535. !-- j_end end indices for j in tile
  536. !-- kts start index for k in tile
  537. !-- kte end index for k in tile
  538. !-- num_tiles number of tiles
  539. !
  540. ! CLWRF-UC May.09 definitions
  541. !-----------
  542. ! is_restart: whether if simulation is a restart
  543. ! clwrfH: Interval (hour) of accumulation for computations
  544. ! [var]cl[min/max]: [minimum/maximum] of variable [var] during interval
  545. ! t[var]cl[min/max]: Time (minutes) of [minimum/maximum] of variable
  546. ! [var] during interval
  547. ! [var]clmean: mean of variable [var] during interval
  548. ! [var]clstd: standard dev. of variable [var] during interval
  549. ! Variables are written on aux_hist_out7 (established
  550. ! in Registry)
  551. !
  552. !======================================================================
  553. INTEGER, INTENT(IN ) :: &
  554. ids,ide, jds,jde, kds,kde, &
  555. ims,ime, jms,jme, kms,kme, &
  556. ips,ipe, jps,jpe, kps,kpe, &
  557. kts,kte, &
  558. num_tiles
  559. INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, &
  560. i_end,j_start,j_end
  561. INTEGER, INTENT(IN ) :: diag_print
  562. REAL, INTENT(IN ) :: bucket_mm, &
  563. bucket_J
  564. REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
  565. INTENT(IN ) :: u,v,p8w
  566. REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: MU_2, &
  567. RAINNCV, RAINCV, HFX, &
  568. SFCEVP, LH, SKINTEMP
  569. REAL, DIMENSION( ims:ime , jms:jme ), &
  570. INTENT(INOUT) :: DPSDT, &
  571. DMUDT, RAINNC, RAINC, &
  572. MU_2M, PK1M
  573. REAL, INTENT(IN ) :: DT, XTIME
  574. INTEGER, INTENT(IN ) :: SBW
  575. INTEGER, DIMENSION( ims:ime , jms:jme ), &
  576. INTENT(INOUT) :: I_RAINC, &
  577. I_RAINNC
  578. ! LOCAL VAR
  579. INTEGER :: i,j,k,its,ite,jts,jte,ij
  580. INTEGER :: idp,jdp,irc,jrc,irnc,jrnc,isnh,jsnh
  581. INTEGER :: prfreq
  582. REAL :: dpsdt_sum, dmudt_sum, dardt_sum, &
  583. drcdt_sum, drndt_sum
  584. REAL :: hfx_sum, lh_sum, sfcevp_sum, &
  585. rainc_sum, rainnc_sum, raint_sum
  586. REAL :: dmumax, raincmax, rainncmax, &
  587. snowhmax
  588. REAL :: xtimep
  589. LOGICAL, EXTERNAL :: wrf_dm_on_monitor
  590. CHARACTER*256 :: outstring
  591. CHARACTER*6 :: grid_str
  592. !!-------------------
  593. !! CLWRF-UC Nov.09
  594. CHARACTER (LEN=80) :: timestr
  595. REAL, DIMENSION( ims:ime , jms:jme ), &
  596. INTENT(IN) :: t2, q2, u10, v10
  597. REAL, DIMENSION( ims:ime , jms:jme ), &
  598. INTENT(OUT) :: t2clmin, t2clmax, tt2clmin, &
  599. tt2clmax, t2clmean, t2clstd, &
  600. q2clmin, q2clmax, tq2clmin, tq2clmax, q2clmean, q2clstd,&
  601. u10clmax, v10clmax, spduv10clmax, tspduv10clmax, &
  602. u10clmean, v10clmean, spduv10clmean, &
  603. u10clstd, v10clstd, spduv10clstd, skintempclmin, &
  604. skintempclmax, tskintempclmin, tskintempclmax, &
  605. skintempclmean, skintempclstd
  606. REAL, DIMENSION( ims:ime , jms:jme ), &
  607. INTENT(OUT) :: raincclmax, rainncclmax, &
  608. traincclmax, trainncclmax, raincclmean, rainncclmean, &
  609. raincclstd, rainncclstd
  610. REAL, PARAMETER :: minimum0= 1000000., &
  611. maximum0= -1000000.
  612. REAL :: value
  613. INTEGER, INTENT(IN) :: clwrfH
  614. CHARACTER (LEN=1024) :: message
  615. REAL, SAVE :: nsteps
  616. LOGICAL :: is_restart
  617. !-----------------------------------------------------------------
  618. ! Compute minutes from reference times clwrfH
  619. ! Initialize [var] values
  620. ! SET START AND END POINTS FOR TILES
  621. ! !$OMP PARALLEL DO &
  622. ! !$OMP PRIVATE ( ij )
  623. ! IF ( MOD(NINT(XTIME), clwrfH) == 0 ) THEN
  624. IF (( MOD(NINT(XTIME*60./dt),NINT(clwrfH*60./dt)) == 0) .AND. (.NOT.is_restart)) THEN
  625. DO ij = 1 , num_tiles
  626. IF ( wrf_dm_on_monitor() ) THEN
  627. WRITE(message, *)'CLWRFdiag - T2; tile: ',ij,' T2clmin:', &
  628. t2clmin(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  629. j_start(ij)+(j_end(ij)-j_start(ij))/2),' T2clmax:', &
  630. t2clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  631. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TT2clmin:', &
  632. tt2clmin(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  633. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TT2clmax:', &
  634. tt2clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  635. j_start(ij)+(j_end(ij)-j_start(ij))/2),' T2clmean:', &
  636. t2clmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  637. j_start(ij)+(j_end(ij)-j_start(ij))/2),' T2clstd:', &
  638. t2clstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  639. j_start(ij)+(j_end(ij)-j_start(ij))/2)
  640. CALL wrf_debug(75, message)
  641. WRITE(message, *)'CLWRFdiag - Q2; tile: ',ij,' Q2clmin:', &
  642. q2clmin(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  643. j_start(ij)+(j_end(ij)-j_start(ij))/2),' Q2clmax:', &
  644. q2clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  645. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TQ2clmin:', &
  646. tq2clmin(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  647. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TQ2clmax:', &
  648. tq2clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  649. j_start(ij)+(j_end(ij)-j_start(ij))/2),' Q2clmean:', &
  650. q2clmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  651. j_start(ij)+(j_end(ij)-j_start(ij))/2),' Q2clstd:', &
  652. q2clstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  653. j_start(ij)+(j_end(ij)-j_start(ij))/2)
  654. CALL wrf_debug(75, message)
  655. WRITE(message, *)'CLWRFdiag - WINDSPEED; tile: ',ij,' U10clmax:', &
  656. u10clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  657. j_start(ij)+(j_end(ij)-j_start(ij))/2),' V10clmax:', &
  658. v10clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  659. j_start(ij)+(j_end(ij)-j_start(ij))/2),' SPDUV10clmax:', &
  660. spduv10clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  661. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TSPDUV10clmax:', &
  662. tspduv10clmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  663. j_start(ij)+(j_end(ij)-j_start(ij))/2),' U10clmean:', &
  664. u10clmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  665. j_start(ij)+(j_end(ij)-j_start(ij))/2),' V10clmean:', &
  666. v10clmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  667. j_start(ij)+(j_end(ij)-j_start(ij))/2),' SPDUV10clmean:', &
  668. spduv10clmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  669. j_start(ij)+(j_end(ij)-j_start(ij))/2),' U10clstd:', &
  670. u10clstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  671. j_start(ij)+(j_end(ij)-j_start(ij))/2),' V10clstd:', &
  672. v10clstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  673. j_start(ij)+(j_end(ij)-j_start(ij))/2),' SPDUV10clstd:', &
  674. spduv10clstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  675. j_start(ij)+(j_end(ij)-j_start(ij))/2)
  676. CALL wrf_debug(75, message)
  677. WRITE(message, *)'CLWRFdiag - RAIN; tile: ',ij,' RAINCclmax:', &
  678. raincclmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  679. j_start(ij)+(j_end(ij)-j_start(ij))/2),' RAINNCclmax:', &
  680. rainncclmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  681. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TRAINCclmax:', &
  682. traincclmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  683. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TRAINNCclmax:', &
  684. trainncclmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  685. j_start(ij)+(j_end(ij)-j_start(ij))/2),' RAINCclmean:', &
  686. raincclmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  687. j_start(ij)+(j_end(ij)-j_start(ij))/2),' RAINNCclmean:', &
  688. rainncclmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  689. j_start(ij)+(j_end(ij)-j_start(ij))/2),' RAINCclstd:', &
  690. raincclstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  691. j_start(ij)+(j_end(ij)-j_start(ij))/2),' RAINNCclstd:', &
  692. rainncclstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  693. j_start(ij)+(j_end(ij)-j_start(ij))/2)
  694. CALL wrf_debug(75, message)
  695. WRITE(message,*)'CLWRFdiag - SKINTEMP; tile: ',ij,' SKINTEMPclmin:',&
  696. skintempclmin(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  697. j_start(ij)+(j_end(ij)-j_start(ij))/2),' SKINTEMPclmax:', &
  698. skintempclmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  699. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TSKINTEMPclmin:', &
  700. tskintempclmin(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  701. j_start(ij)+(j_end(ij)-j_start(ij))/2),' TSKINTEMPclmax:', &
  702. tskintempclmax(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  703. j_start(ij)+(j_end(ij)-j_start(ij))/2),' SKINTEMPclmean:', &
  704. skintempclmean(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  705. j_start(ij)+(j_end(ij)-j_start(ij))/2),' SKINTEMPclstd:', &
  706. skintempclstd(i_start(ij)+(i_end(ij)-i_start(ij))/2, &
  707. j_start(ij)+(j_end(ij)-j_start(ij))/2)
  708. CALL wrf_debug(75, message)
  709. ENDIF
  710. DO j = j_start(ij), j_end(ij)
  711. DO i = i_start(ij), i_end(ij)
  712. t2clmin(i,j)=t2(i,j)
  713. t2clmax(i,j)=t2(i,j)
  714. t2clmean(i,j)=t2(i,j)
  715. t2clstd(i,j)=t2(i,j)*t2(i,j)
  716. q2clmin(i,j)=q2(i,j)
  717. q2clmax(i,j)=q2(i,j)
  718. q2clmean(i,j)=q2(i,j)
  719. q2clstd(i,j)=q2(i,j)*q2(i,j)
  720. spduv10clmax(i,j)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
  721. u10clmean(i,j)=u10(i,j)
  722. v10clmean(i,j)=v10(i,j)
  723. spduv10clmean(i,j)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
  724. u10clstd(i,j)=u10(i,j)*u10(i,j)
  725. v10clstd(i,j)=v10(i,j)*v10(i,j)
  726. spduv10clstd(i,j)=u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j)
  727. raincclmax(i,j)=raincv(i,j)/dt
  728. rainncclmax(i,j)=rainncv(i,j)/dt
  729. raincclmean(i,j)=raincv(i,j)/dt
  730. rainncclmean(i,j)=rainncv(i,j)/dt
  731. raincclstd(i,j)=(raincv(i,j)/dt)*(raincv(i,j)/dt)
  732. rainncclstd(i,j)=(rainncv(i,j)/dt)*(rainncv(i,j)/dt)
  733. skintempclmin(i,j)=skintemp(i,j)
  734. skintempclmax(i,j)=skintemp(i,j)
  735. skintempclmean(i,j)=skintemp(i,j)
  736. skintempclstd(i,j)=skintemp(i,j)*skintemp(i,j)
  737. ! nsteps=0.
  738. ENDDO
  739. ENDDO
  740. ENDDO
  741. nsteps=clwrfH*60./dt
  742. ELSE
  743. xtimep = xtime + dt/60. ! value at end of timestep for time info
  744. ! nsteps=nsteps+1.
  745. nsteps=clwrfH*60./dt
  746. ! DO j = j_start(ij), j_end(ij)
  747. ! DO i = i_start(ij), i_end(ij)
  748. ! DO j = jps, jpe
  749. ! DO i = ips, ipe
  750. ! Temperature
  751. CALL varstatistics(t2,xtimep,ime-ims+1,jme-jms+1,t2clmin,t2clmax, &
  752. tt2clmin,tt2clmax,t2clmean,t2clstd)
  753. ! Water vapor mixing ratio
  754. CALL varstatistics(q2,xtimep,ime-ims+1,jme-jms+1,q2clmin,q2clmax, &
  755. tq2clmin,tq2clmax,q2clmean,q2clstd)
  756. ! Wind speed
  757. CALL varstatisticsWIND(u10,v10,xtimep,ime-ims+1,jme-jms+1,u10clmax, &
  758. v10clmax,spduv10clmax,tspduv10clmax,u10clmean,v10clmean, &
  759. spduv10clmean,u10clstd,v10clstd,spduv10clstd)
  760. ! Precipitation flux
  761. CALL varstatisticsMAX(raincv/dt,xtimep,ime-ims+1,jme-jms+1, &
  762. raincclmax,traincclmax,raincclmean,raincclstd)
  763. CALL varstatisticsMAX(rainncv/dt,xtimep,ime-ims+1,jme-jms+1, &
  764. rainncclmax,trainncclmax,rainncclmean,rainncclstd)
  765. ! Skin Temperature
  766. CALL varstatistics(skintemp,xtimep,ime-ims+1,jme-jms+1,skintempclmin,&
  767. skintempclmax, tskintempclmin,tskintempclmax,skintempclmean, &
  768. skintempclstd)
  769. ! IF (MOD(NINT(XTIME),clwrfH) == 0) THEN
  770. ! IF (MOD(NINT(XTIME+dt/60.),clwrfH) == 0) THEN
  771. IF ((MOD(NINT((XTIME+dt/60.)*60./dt),NINT(clwrfH*60./dt)) == 0)) THEN
  772. IF ( wrf_dm_on_monitor() ) PRINT *,'nsteps=',nsteps,' xtime:', &
  773. xtime,' clwrfH:',clwrfH
  774. t2clmean=t2clmean/nsteps
  775. t2clstd=SQRT(t2clstd/nsteps-t2clmean**2.)
  776. q2clmean=q2clmean/nsteps
  777. q2clstd=SQRT(q2clstd/nsteps-q2clmean**2.)
  778. u10clmean=u10clmean/nsteps
  779. v10clmean=v10clmean/nsteps
  780. spduv10clmean=spduv10clmean/nsteps
  781. u10clstd=SQRT(u10clstd/nsteps-u10clmean**2.)
  782. v10clstd=SQRT(v10clstd/nsteps-v10clmean**2.)
  783. spduv10clstd=SQRT(spduv10clstd/nsteps- &
  784. spduv10clmean**2)
  785. raincclmean=raincclmean/nsteps
  786. rainncclmean=rainncclmean/nsteps
  787. raincclstd=SQRT(raincclstd/nsteps-raincclmean**2.)
  788. rainncclstd=SQRT(rainncclstd/nsteps-rainncclmean**2.)
  789. skintempclmean=skintempclmean/nsteps
  790. skintempclstd=SQRT(skintempclstd/nsteps-skintempclmean**2.)
  791. END IF
  792. ! ENDDO
  793. ! ENDDO
  794. ENDIF
  795. ! !$OMP END PARALLEL DO
  796. END SUBROUTINE clwrf_output_calc
  797. ! UC.CLWRF Nov.09
  798. SUBROUTINE varstatisticsWIND(varu, varv, tt, dx, dy, varumax, varvmax, &
  799. varuvmax, tvaruvmax, varumean, varvmean, varuvmean, varustd, varvstd, &
  800. varuvstd)
  801. ! Subroutine to compute variable statistics for a wind somponents
  802. IMPLICIT NONE
  803. INTEGER :: i, j
  804. INTEGER, INTENT(IN) :: dx, dy
  805. REAL, DIMENSION(dx,dy), INTENT(IN) :: varu, varv
  806. REAL, INTENT(IN) :: tt
  807. REAL, DIMENSION(dx,dy), INTENT(INOUT) :: varumax, &
  808. varvmax, varuvmax, tvaruvmax, varumean, varvmean, varuvmean, varustd, &
  809. varvstd, varuvstd
  810. REAL :: varuv
  811. DO i=1,dx
  812. DO j=1,dy
  813. varuv=sqrt(varu(i,j)*varu(i,j)+varv(i,j)*varv(i,j))
  814. IF (varuv > varuvmax(i,j)) THEN
  815. varumax(i,j)=varu(i,j)
  816. varvmax(i,j)=varv(i,j)
  817. varuvmax(i,j)=varuv
  818. tvaruvmax(i,j)=tt
  819. END IF
  820. varuvmean(i,j)=varuvmean(i,j)+varuv
  821. varuvstd(i,j)=varuvstd(i,j)+varuv**2
  822. END DO
  823. END DO
  824. varumean=varumean+varu
  825. varvmean=varvmean+varv
  826. varustd=varustd+varu**2
  827. varvstd=varvstd+varv**2
  828. END SUBROUTINE varstatisticsWIND
  829. SUBROUTINE varstatisticsMAX(var, tt, dx, dy, varmax, tvarmax, varmean, &
  830. varstd)
  831. ! Subroutine to compute variable statistics for a max only variable values
  832. IMPLICIT NONE
  833. INTEGER :: i,j
  834. INTEGER, INTENT(IN) :: dx, dy
  835. REAL, DIMENSION(dx,dy), INTENT(IN) :: var
  836. REAL, INTENT(IN) :: tt
  837. REAL, DIMENSION(dx,dy), INTENT(INOUT) :: varmax, &
  838. tvarmax, varmean, varstd
  839. DO i=1,dx
  840. DO j=1,dy
  841. IF (var(i,j) > varmax(i,j)) THEN
  842. varmax(i,j)=var(i,j)
  843. tvarmax(i,j)=tt
  844. END IF
  845. END DO
  846. END DO
  847. varmean=varmean+var
  848. varstd=varstd+var**2
  849. END SUBROUTINE varstatisticsMAX
  850. SUBROUTINE varstatistics(var, tt, dx, dy, varmin, varmax, tvarmin, tvarmax, &
  851. varmean, varstd)
  852. ! Subroutine to compute variable statistics
  853. IMPLICIT NONE
  854. INTEGER :: i,j
  855. INTEGER, INTENT(IN) :: dx, dy
  856. REAL, DIMENSION(dx,dy), INTENT(IN) :: var
  857. REAL, INTENT(IN) :: tt
  858. REAL, DIMENSION(dx,dy), INTENT(INOUT) :: varmin, &
  859. varmax, tvarmin, tvarmax, varmean, varstd
  860. DO i=1,dx
  861. DO j=1,dy
  862. IF (var(i,j) < varmin(i,j)) THEN
  863. varmin(i,j)=var(i,j)
  864. tvarmin(i,j)=tt
  865. END IF
  866. IF (var(i,j) > varmax(i,j)) THEN
  867. varmax(i,j)=var(i,j)
  868. tvarmax(i,j)=tt
  869. END IF
  870. END DO
  871. END DO
  872. varmean=varmean+var
  873. varstd=varstd+var**2
  874. END SUBROUTINE varstatistics
  875. END MODULE module_diagnostics