84 use vrbls4d,
only: smoke, fv3dust, coarsepm, ebb
85 use vrbls3d,
only: zint, pint, t, pmid, q, f_rimef
86 use vrbls2d,
only: ths, qs, qvg, qv2m, tsnow, tg, smstav, smstot, &
87 cmc, sno, snoavg, psfcavg, t10avg, snonc, ivgtyp, &
88 si, potevp, dzice, qwbs, vegfrc, isltyp, pshltr, &
89 tshltr, qshltr, mrshltr, maxtshltr, mintshltr, &
90 maxrhshltr, minrhshltr, u10, psfcavg, v10, u10max, &
91 v10max, th10, t10m, q10, wspd10max, &
92 wspd10umax, wspd10vmax, prec, sr, &
93 cprate, avgcprate, avgprec, acprec, cuprec, ancprc, &
94 lspa, acsnow, acsnom, snowfall,ssroff, bgroff, &
95 runoff, pcp_bucket, rainnc_bucket, snow_bucket, &
96 snownc, tmax, graup_bucket, graupelnc, qrmax, sfclhx,&
97 rainc_bucket, sfcshx, subshx, snopcx, sfcuvx, &
98 sfcvx, smcwlt, suntime, pd, sfcux, sfcuxi, sfcvxi, sfcevp, z0, &
99 ustar, mdltaux, mdltauy, gtaux, gtauy, twbs, &
100 sfcexc, grnflx, islope, czmean, czen, rswin,akhsavg ,&
101 akmsavg, u10h, v10h,snfden,sndepac,qvl1, &
102 spduv10mean,swradmean,swnormmean,prate_max,fprate_max &
103 ,fieldcapa,edir,ecan,etrans,esnow,u10mean,v10mean, &
104 avgedir,avgecan,avgetrans,avgesnow,acgraup,acfrain, &
105 acond,maxqshltr,minqshltr,avgpotevp,avgprec_cont, &
106 avgcprate_cont,sst,pcp_bucket1,rainnc_bucket1, &
107 snow_bucket1, rainc_bucket1, graup_bucket1, &
108 frzrn_bucket, snow_acm, snow_bkt, &
109 shdmin, shdmax, lai, ch10,cd10,landfrac,paha,pahi, &
110 tecan,tetran,tedir,twa,ifi_apcp,xlaixy, &
111 smoke_ave,dust_ave,coarsepm_ave
112 use soil,
only: stc, sllevel, sldpth, smc, sh2o
113 use masks,
only: lmh, sm, sice, htm, gdlat, gdlon
114 use physcons_post,
only: con_eps, con_epsm1
115 use params_mod,
only: p1000, capa, h1m12, pq0, a2,a3, a4, h1, d00, d01,&
116 eps, oneps, d001, h99999, h100, small, h10e5, &
117 elocp, g, xlai, tfrz, rd
118 use ctlblk_mod,
only: jsta, jend, lm, spval, grib, cfld, fld_info, &
119 datapd, nsoil, isf_surface_physics, tprec, ifmin,&
120 modelname, tmaxmin, pthresh, dtq2, dt, nphs, &
121 ifhr, prec_acc_dt, sdat, ihrst, jsta_2l, jend_2u,&
122 lp1, imp_physics, me, asrfc, tsrfc, pt, pdtop, &
123 mpi_comm_comp, im, jm, prec_acc_dt1, &
124 ista, iend, ista_2l, iend_2u
125 use rqstfld_mod,
only: iget, lvls, id, iavblfld, lvlsxml
126 use grib2_module,
only: read_grib2_head, read_grib2_sngle
127 use upp_physics,
only: fpvsnew, calrh
140 real,
PARAMETER :: PTRACE = 0.000254e0
143 integer,
parameter :: nalg=5, nosoiltype=9
144 real,
PARAMETER :: C2K = 273.15, sec2hr = 1./3600.
148 integer,
dimension(ista:iend,jsta:jend) :: nroots, iwx1
149 real,
allocatable,
dimension(:,:) :: zsfc, psfc, tsfc, qsfc, &
150 rhsfc, thsfc, dwpsfc, p1d, &
152 smcdry, smcmax,doms, domr, &
153 domip, domzr, rsmin, smcref,&
154 rcq, rct, rcsoil, gc, rcs
156 real,
dimension(ista:iend,jsta:jend) :: evp
157 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: egrid1, egrid2
158 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: grid2
159 real,
dimension(im,jm) :: grid1
160 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: iceg
162 real,
allocatable,
dimension(:,:,:) :: sleet, rain, freezr, snow
166 REAL totprcp, snowratio,t2,rainl
169 integer I,J,IWX,ITMAXMIN,IFINCR,ISVALUE,II,JJ, &
170 itprec,itsrfc,l,ls,iveg,llmh, &
171 ivg,irtn,iseed, icat, cnt_snowratio(10),icnt_snow_rain_mixed
173 real RDTPHS,TLOW,TSFCK,QSAT,DTOP,DBOT,SNEQV,RRNUM,SFCPRS,SFCQ, &
174 rc,sfctmp,sncovr,factrs,solar, s,tk,tl,w,t2c,dlt,ape, &
175 qv,e,dwpt,dum1,dum2,dum3,dum1s,dum3s,dum21,dum216,es
177 character(len=256) :: ffgfile
178 character(len=256) :: arifile
180 logical file_exists, need_ifi
182 logical,
parameter :: debugprint = .false.
194 IF ( (iget(024)>0).OR.(iget(025)>0).OR. &
195 (iget(026)>0).OR.(iget(027)>0).OR. &
196 (iget(028)>0).OR.(iget(029)>0).OR. &
198 (iget(034)>0).OR.(iget(076)>0) )
THEN
200 allocate(zsfc(ista:iend,jsta:jend), psfc(ista:iend,jsta:jend), tsfc(ista:iend,jsta:jend)&
201 ,rhsfc(ista:iend,jsta:jend), thsfc(ista:iend,jsta:jend), qsfc(ista:iend,jsta:jend))
211 IF(zint(i,j,lm+1) < spval) &
212 zsfc(i,j) = zint(i,j,lm+1)
213 psfc(i,j) = pint(i,j,nint(lmh(i,j))+1)
216 thsfc(i,j) = ths(i,j)
218 IF(thsfc(i,j) /= spval .and. psfc(i,j) /= spval) &
219 tsfc(i,j) = thsfc(i,j)*(psfc(i,j)/p1000)**capa
228 IF(tsfc(i,j) < spval)
then
229 IF(qs(i,j)<spval) qsfc(i,j) = max(h1m12,qs(i,j))
232 IF(modelname ==
'RAPR')
THEN
233 qsat = max(0.0001,pq0/psfc(i,j)*exp(a2*(tsfck-a3)/(tsfck-a4)))
234 elseif (modelname ==
'GFS')
then
236 qsat = con_eps*es/(psfc(i,j)+con_epsm1*es)
238 qsat = pq0/psfc(i,j)*exp(a2*(tsfck-a3)/(tsfck-a4))
240 rhsfc(i,j) = max(d01, min(h1,qsfc(i,j)/qsat))
242 qsfc(i,j) = rhsfc(i,j)*qsat
243 rhsfc(i,j) = rhsfc(i,j) * 100.0
244 evp(i,j) = d001*psfc(i,j)*qsfc(i,j)/(eps+oneps*qsfc(i,j))
266 IF (iget(024)>0)
THEN
267 if(grib ==
'grib2')
then
269 fld_info(cfld)%ifld = iavblfld(iget(024))
275 datapd(i,j,cfld) = psfc(ii,jj)
282 IF (iget(025)>0)
THEN
284 if(grib ==
'grib2')
then
286 fld_info(cfld)%ifld = iavblfld(iget(025))
292 datapd(i,j,cfld) = zsfc(ii,jj)
297 if (
allocated(zsfc))
deallocate(zsfc)
298 if (
allocated(psfc))
deallocate(psfc)
301 IF (iget(026)>0)
THEN
302 if(grib ==
'grib2')
then
304 fld_info(cfld)%ifld = iavblfld(iget(026))
310 datapd(i,j,cfld) = tsfc(ii,jj)
315 if (
allocated(tsfc))
deallocate(tsfc)
318 IF (iget(027)>0)
THEN
319 if(grib==
'grib2')
then
321 fld_info(cfld)%ifld=iavblfld(iget(027))
327 datapd(i,j,cfld) = thsfc(ii,jj)
332 if (
allocated(thsfc))
deallocate(thsfc)
335 IF (iget(028)>0)
THEN
337 if(grib==
'grib2')
then
339 fld_info(cfld)%ifld=iavblfld(iget(028))
345 datapd(i,j,cfld) = qsfc(ii,jj)
350 if (
allocated(qsfc))
deallocate(qsfc)
353 IF (iget(029)>0)
THEN
354 allocate(dwpsfc(ista:iend,jsta:jend))
356 if(grib==
'grib2')
then
358 fld_info(cfld)%ifld=iavblfld(iget(029))
364 datapd(i,j,cfld) = dwpsfc(ii,jj)
368 if (
allocated(dwpsfc))
deallocate(dwpsfc)
372 IF (iget(076)>0)
THEN
373 if(grib==
'grib2')
then
375 fld_info(cfld)%ifld=iavblfld(iget(076))
381 if(rhsfc(ii,jj) /= spval)
then
382 datapd(i,j,cfld) = max(h1,min(h100,rhsfc(ii,jj)))
384 datapd(i,j,cfld) = spval
390 if (
allocated(rhsfc))
deallocate(rhsfc)
397 IF (iget(762)>0)
THEN
398 if(grib==
'grib2')
then
400 fld_info(cfld)%ifld=iavblfld(iget(762))
406 datapd(i,j,cfld) = qvg(ii,jj)
414 IF (iget(760)>0)
THEN
415 if(grib==
'grib2')
then
417 fld_info(cfld)%ifld=iavblfld(iget(760))
423 datapd(i,j,cfld) = qv2m(ii,jj)
430 IF (iget(761)>0)
THEN
431 if(grib==
'grib2')
then
433 fld_info(cfld)%ifld=iavblfld(iget(761))
439 datapd(i,j,cfld) = tsnow(ii,jj)
446 IF (iget(724)>0)
THEN
447 if(grib==
'grib2')
then
449 fld_info(cfld)%ifld=iavblfld(iget(724))
455 datapd(i,j,cfld) = snfden(ii,jj)
462 IF (iget(725)>0)
THEN
467 ifincr = mod(ifhr,itprec)
468 IF(ifmin >= 1)ifincr = mod(ifhr*60+ifmin,itprec*60)
475 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
481 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
483 IF (id(18)<0) id(18) = 0
484 if(grib==
'grib2')
then
486 fld_info(cfld)%ifld=iavblfld(iget(725))
487 fld_info(cfld)%ntrange=1
489 fld_info(cfld)%tinvstat=ifhr*60+ifmin
491 fld_info(cfld)%tinvstat=ifhr
498 if(sndepac(ii,jj)<spval)
then
499 if(modelname==
'FV3R')
then
500 datapd(i,j,cfld) = sndepac(ii,jj)/(1e3)
502 datapd(i,j,cfld) = sndepac(ii,jj)
505 datapd(i,j,cfld) = spval
521 IF (iget(116)>0)
THEN
522 IF (lvls(l,iget(116))>0)
THEN
523 IF(isf_surface_physics==3)
THEN
524 if(grib==
'grib2')
then
526 fld_info(cfld)%ifld=iavblfld(iget(116))
527 fld_info(cfld)%lvl=lvlsxml(l,iget(116))
533 datapd(i,j,cfld) = stc(ii,jj,l)
542 dtop = dtop + sldpth(ls)
544 dbot = dtop + sldpth(l)
545 if(grib==
'grib2')
then
547 fld_info(cfld)%ifld=iavblfld(iget(116))
548 fld_info(cfld)%lvl=lvlsxml(l,iget(116))
554 datapd(i,j,cfld) = stc(ii,jj,l)
564 IF (iget(117)>0)
THEN
565 IF (lvls(l,iget(117))>0)
THEN
566 IF(isf_surface_physics==3)
THEN
567 if(grib==
'grib2')
then
569 fld_info(cfld)%ifld=iavblfld(iget(117))
570 fld_info(cfld)%lvl=lvlsxml(l,iget(117))
576 datapd(i,j,cfld) = smc(ii,jj,l)
583 dtop = dtop + sldpth(ls)
585 dbot = dtop + sldpth(l)
586 if(grib==
'grib2')
then
588 fld_info(cfld)%ifld=iavblfld(iget(117))
589 fld_info(cfld)%lvl=lvlsxml(l,iget(117))
595 datapd(i,j,cfld) = smc(ii,jj,l)
603 IF (iget(225)>0)
THEN
604 IF (lvls(l,iget(225))>0)
THEN
605 IF(isf_surface_physics==3)
THEN
606 if(grib==
'grib2')
then
608 fld_info(cfld)%ifld=iavblfld(iget(225))
609 fld_info(cfld)%lvl=lvlsxml(l,iget(225))
615 datapd(i,j,cfld) = sh2o(ii,jj,l)
622 dtop = dtop + sldpth(ls)
624 dbot = dtop + sldpth(l)
625 if(grib==
'grib2')
then
627 fld_info(cfld)%ifld=iavblfld(iget(225))
628 fld_info(cfld)%lvl=lvlsxml(l,iget(225))
634 datapd(i,j,cfld) = sh2o(ii,jj,l)
645 IF (iget(115)>0.or.iget(571)>0)
THEN
647 if(grib==
'grib2')
then
649 fld_info(cfld)%ifld=iavblfld(iget(115))
655 datapd(i,j,cfld) = tg(ii,jj)
660 if(iget(571)>0.and.grib==
'grib2')
then
662 fld_info(cfld)%ifld=iavblfld(iget(571))
668 datapd(i,j,cfld) = tg(ii,jj)
675 IF (iget(171)>0)
THEN
679 IF(smstav(i,j) /= spval)
THEN
680 IF ( modelname ==
'FV3R')
THEN
681 grid1(i,j) = smstav(i,j)
683 grid1(i,j) = smstav(i,j)*100.
690 if(grib==
'grib2')
then
692 fld_info(cfld)%ifld=iavblfld(iget(171))
698 datapd(i,j,cfld) = grid1(ii,jj)
705 IF (iget(036)>0)
THEN
709 IF(smstot(i,j)/=spval)
THEN
710 IF(sm(i,j) > small .AND. sice(i,j) < small)
THEN
713 grid1(i,j) = smstot(i,j)
720 if(grib==
'grib2')
then
722 fld_info(cfld)%ifld=iavblfld(iget(036))
728 datapd(i,j,cfld) = grid1(ii,jj)
735 IF (iget(713)>0)
THEN
740 grid1(i,j) = smstot(i,j)
746 if(grib==
'grib2')
then
748 fld_info(cfld)%ifld=iavblfld(iget(713))
754 datapd(i,j,cfld) = grid1(ii,jj)
761 IF ( iget(118)>0 )
THEN
762 IF(modelname ==
'RAPR')
THEN
766 IF(cmc(i,j) /= spval)
then
767 grid1(i,j) = cmc(i,j)
777 IF(cmc(i,j) /= spval)
then
778 grid1(i,j) = cmc(i,j)*1000.
785 if(grib==
'grib2')
then
787 fld_info(cfld)%ifld=iavblfld(iget(118))
793 datapd(i,j,cfld) = grid1(ii,jj)
800 IF ( iget(119)>0 )
THEN
802 if(grib==
'grib2')
then
804 fld_info(cfld)%ifld=iavblfld(iget(119))
810 datapd(i,j,cfld) = sno(ii,jj)
817 IF ( iget(500)>0 )
THEN
823 grid1(i,j) = snoavg(i,j)
824 if (snoavg(i,j) /= spval) grid1(i,j) = 100.*snoavg(i,j)
827 CALL bound(grid1,d00,h100)
831 ifincr = mod(ifhr,itsrfc)
832 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
837 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
843 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
845 IF (id(18)<0) id(18) = 0
846 if(grib==
'grib2')
then
848 fld_info(cfld)%ifld=iavblfld(iget(500))
850 fld_info(cfld)%ntrange=1
852 fld_info(cfld)%ntrange=0
854 fld_info(cfld)%tinvstat=ifhr-id(18)
862 datapd(i,j,cfld) = grid1(ii,jj)
869 IF ( iget(501)>0 )
THEN
880 if(grib==
'grib2')
then
882 fld_info(cfld)%ifld=iavblfld(iget(501))
884 fld_info(cfld)%ntrange=1
886 fld_info(cfld)%ntrange=0
888 fld_info(cfld)%tinvstat=ifhr-id(18)
894 datapd(i,j,cfld) = psfcavg(ii,jj)
901 IF ( iget(502)>0 )
THEN
912 id(10) = mod(isvalue/256,256)
913 id(11) = mod(isvalue,256)
915 if(grib==
'grib2')
then
917 fld_info(cfld)%ifld=iavblfld(iget(502))
919 fld_info(cfld)%ntrange=1
921 fld_info(cfld)%ntrange=0
923 fld_info(cfld)%tinvstat=ifhr-id(18)
929 datapd(i,j,cfld) = t10avg(ii,jj)
936 IF ( iget(244)>0 )
THEN
940 grid1(i,j) = snonc(i,j)
946 if (itprec /= 0)
then
947 ifincr = mod(ifhr,itprec)
948 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
955 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
961 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
963 IF (id(18)<0) id(18) = 0
965 if(grib==
'grib2')
then
967 fld_info(cfld)%ifld=iavblfld(iget(244))
968 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
973 IF ( iget(120)>0 )
THEN
978 IF ( sno(i,j) /= spval )
THEN
982 CALL snfrac (sneqv,iveg,sncovr)
983 grid1(i,j) = sncovr*100.
987 CALL bound(grid1,d00,h100)
988 if(grib==
'grib2')
then
990 fld_info(cfld)%ifld=iavblfld(iget(120))
996 datapd(i,j,cfld) = grid1(ii,jj)
1002 IF ( iget(224)>0 )
THEN
1010 IF(si(i,j) /= spval) grid1(i,j) = si(i,j)*0.001
1014 if(grib==
'grib2')
then
1016 fld_info(cfld)%ifld=iavblfld(iget(224))
1022 datapd(i,j,cfld) = grid1(ii,jj)
1028 IF ( iget(242)>0 )
THEN
1029 if(grib==
'grib2')
then
1031 fld_info(cfld)%ifld=iavblfld(iget(242))
1037 datapd(i,j,cfld) = potevp(ii,jj)
1043 IF ( iget(349)>0 )
THEN
1044 if(grib==
'grib2')
then
1046 fld_info(cfld)%ifld=iavblfld(iget(349))
1052 datapd(i,j,cfld) = dzice(ii,jj)
1060 IF (modelname ==
'NCAR'.OR. modelname ==
'NMM' &
1061 .OR. modelname ==
'FV3R' .OR. modelname ==
'RAPR')
THEN
1070 IF ( iget(228)>0 .OR. iget(229)>0 &
1071 .OR.iget(230)>0 .OR. iget(231)>0 &
1072 .OR.iget(232)>0 .OR. iget(233)>0)
THEN
1074 allocate(smcdry(ista:iend,jsta:jend), &
1075 smcmax(ista:iend,jsta:jend))
1082 IF( (modelname/=
'RAPR') .AND. (abs(sm(i,j)-0.) < 1.0e-5) .AND. &
1083 & (abs(sice(i,j)-0.) < 1.0e-5) )
THEN
1084 CALL etcalc(qwbs(i,j),potevp(i,j),sno(i,j),vegfrc(i,j) &
1085 & , isltyp(i,j),sh2o(i,j,1:1),cmc(i,j) &
1086 & , ecan(i,j),edir(i,j),etrans(i,j),esnow(i,j) &
1087 & , smcdry(i,j),smcmax(i,j) )
1099 IF ( iget(228)>0 )
THEN
1100 if(grib==
'grib2')
then
1102 fld_info(cfld)%ifld=iavblfld(iget(228))
1108 datapd(i,j,cfld) = ecan(ii,jj)
1114 IF ( iget(229)>0 )
THEN
1115 if(grib==
'grib2')
then
1117 fld_info(cfld)%ifld=iavblfld(iget(229))
1123 datapd(i,j,cfld) = edir(ii,jj)
1129 IF ( iget(230)>0 )
THEN
1130 if(grib==
'grib2')
then
1132 fld_info(cfld)%ifld=iavblfld(iget(230))
1133 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = etrans(ista:iend,jsta:jend)
1137 IF ( iget(231)>0 )
THEN
1138 if(grib==
'grib2')
then
1140 fld_info(cfld)%ifld=iavblfld(iget(231))
1141 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = esnow(ista:iend,jsta:jend)
1145 IF ( iget(232)>0 )
THEN
1146 if(grib==
'grib2')
then
1148 fld_info(cfld)%ifld=iavblfld(iget(232))
1154 datapd(i,j,cfld) = smcdry(ii,jj)
1160 IF ( iget(233)>0 )
THEN
1161 if(grib==
'grib2')
then
1163 fld_info(cfld)%ifld=iavblfld(iget(233))
1169 datapd(i,j,cfld) = smcmax(ii,jj)
1180 if (
allocated(smcdry))
deallocate(smcdry)
1181 if (
allocated(smcmax))
deallocate(smcmax)
1185 IF ( iget(512)>0 )
THEN
1186 if(grib==
'grib2')
then
1188 fld_info(cfld)%ifld=iavblfld(iget(512))
1194 datapd(i,j,cfld) = acond(ii,jj)
1200 IF ( iget(513)>0 )
THEN
1202 itsrfc = nint(tsrfc)
1203 IF(itsrfc /= 0)
then
1204 ifincr = mod(ifhr,itsrfc)
1205 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
1210 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1213 id(18) = ifhr-itsrfc
1215 id(18) = ifhr-ifincr
1216 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1218 IF (id(18)<0) id(18) = 0
1219 if(grib==
'grib2')
then
1221 fld_info(cfld)%ifld=iavblfld(iget(513))
1223 fld_info(cfld)%ntrange=1
1225 fld_info(cfld)%ntrange=0
1227 fld_info(cfld)%tinvstat=ifhr-id(18)
1233 datapd(i,j,cfld) = avgecan(ii,jj)
1239 IF ( iget(514)>0 )
THEN
1241 itsrfc = nint(tsrfc)
1242 IF(itsrfc /= 0)
then
1243 ifincr = mod(ifhr,itsrfc)
1244 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
1249 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1252 id(18) = ifhr-itsrfc
1254 id(18) = ifhr-ifincr
1255 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1257 IF (id(18)<0) id(18) = 0
1258 if(grib==
'grib2')
then
1260 fld_info(cfld)%ifld=iavblfld(iget(514))
1262 fld_info(cfld)%ntrange=1
1264 fld_info(cfld)%ntrange=0
1266 fld_info(cfld)%tinvstat=ifhr-id(18)
1272 datapd(i,j,cfld) = avgedir(ii,jj)
1278 IF ( iget(515)>0 )
THEN
1280 itsrfc = nint(tsrfc)
1281 IF(itsrfc /= 0)
then
1282 ifincr = mod(ifhr,itsrfc)
1283 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
1288 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1291 id(18) = ifhr-itsrfc
1293 id(18) = ifhr-ifincr
1294 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1296 IF (id(18)<0) id(18) = 0
1297 if(grib==
'grib2')
then
1299 fld_info(cfld)%ifld=iavblfld(iget(515))
1301 fld_info(cfld)%ntrange=1
1303 fld_info(cfld)%ntrange=0
1305 fld_info(cfld)%tinvstat=ifhr-id(18)
1306 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = avgetrans(ista:iend,jsta:jend)
1310 IF ( iget(516)>0 )
THEN
1312 itsrfc = nint(tsrfc)
1313 IF(itsrfc /= 0)
then
1314 ifincr = mod(ifhr,itsrfc)
1315 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
1320 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1323 id(18) = ifhr-itsrfc
1325 id(18) = ifhr-ifincr
1326 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1328 IF (id(18)<0) id(18) = 0
1329 if(grib==
'grib2')
then
1331 fld_info(cfld)%ifld=iavblfld(iget(516))
1333 fld_info(cfld)%ntrange=1
1335 fld_info(cfld)%ntrange=0
1337 fld_info(cfld)%tinvstat=ifhr-id(18)
1338 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = avgesnow(ista:iend,jsta:jend)
1342 IF ( iget(996)>0 )
THEN
1343 if(grib==
'grib2')
then
1345 fld_info(cfld)%ifld=iavblfld(iget(996))
1351 datapd(i,j,cfld) = landfrac(ii,jj)
1357 IF ( iget(997)>0 )
THEN
1358 if(grib==
'grib2')
then
1360 fld_info(cfld)%ifld=iavblfld(iget(997))
1366 datapd(i,j,cfld) = pahi(ii,jj)
1372 IF ( iget(998)>0 )
THEN
1373 if(grib==
'grib2')
then
1375 fld_info(cfld)%ifld=iavblfld(iget(998))
1381 datapd(i,j,cfld) = twa(ii,jj)
1387 IF ( iget(999)>0 )
THEN
1391 grid1(i,j) = tecan(i,j)
1395 itprec = nint(tprec)
1396 if (itprec /= 0)
then
1397 ifincr = mod(ifhr,itprec)
1398 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
1404 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1407 id(18) = ifhr-itprec
1409 id(18) = ifhr-ifincr
1410 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1412 IF (id(18)<0) id(18) = 0
1413 if(grib==
'grib2')
then
1415 fld_info(cfld)%ifld=iavblfld(iget(999))
1416 fld_info(cfld)%ntrange=1
1417 fld_info(cfld)%tinvstat=ifhr-id(18)
1423 datapd(i,j,cfld) = grid1(ii,jj)
1429 IF ( iget(1000)>0 )
THEN
1433 grid1(i,j) = tetran(i,j)
1437 itprec = nint(tprec)
1438 if (itprec /= 0)
then
1439 ifincr = mod(ifhr,itprec)
1440 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
1446 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1449 id(18) = ifhr-itprec
1451 id(18) = ifhr-ifincr
1452 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1454 IF (id(18)<0) id(18) = 0
1455 if(grib==
'grib2')
then
1457 fld_info(cfld)%ifld=iavblfld(iget(1000))
1458 fld_info(cfld)%ntrange=1
1459 fld_info(cfld)%tinvstat=ifhr-id(18)
1465 datapd(i,j,cfld) = grid1(ii,jj)
1471 IF ( iget(1001)>0 )
THEN
1475 grid1(i,j) = tedir(i,j)
1479 itprec = nint(tprec)
1480 if (itprec /= 0)
then
1481 ifincr = mod(ifhr,itprec)
1482 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
1488 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1491 id(18) = ifhr-itprec
1493 id(18) = ifhr-ifincr
1494 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1496 IF (id(18)<0) id(18) = 0
1497 if(grib==
'grib2')
then
1499 fld_info(cfld)%ifld=iavblfld(iget(1001))
1500 fld_info(cfld)%ntrange=1
1501 fld_info(cfld)%tinvstat=ifhr-id(18)
1507 datapd(i,j,cfld) = grid1(ii,jj)
1514 IF (iget(1002)>0)
THEN
1522 IF(paha(i,j)/=spval)
THEN
1523 grid1(i,j)=-1.*paha(i,j)*rrnum
1525 grid1(i,j)=paha(i,j)
1530 itsrfc = nint(tsrfc)
1531 IF(itsrfc /= 0)
then
1532 ifincr = mod(ifhr,itsrfc)
1533 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
1538 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1541 id(18) = ifhr-itsrfc
1543 id(18) = ifhr-ifincr
1544 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1546 IF (id(18)<0) id(18) = 0
1547 if(grib==
'grib2')
then
1549 fld_info(cfld)%ifld=iavblfld(iget(1002))
1551 fld_info(cfld)%ntrange=1
1553 fld_info(cfld)%ntrange=0
1555 fld_info(cfld)%tinvstat=ifhr-id(18)
1556 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1566 IF ( (iget(106)>0).OR.(iget(112)>0).OR. &
1567 (iget(113)>0).OR.(iget(114)>0).OR. &
1568 (iget(138)>0).OR.(iget(414)>0).OR. &
1569 (iget(546)>0).OR.(iget(547)>0).OR. &
1570 (iget(548)>0).OR.(iget(558)>0).OR. &
1571 (iget(739)>0).OR.(iget(744)>0))
THEN
1573 if (.not.
allocated(psfc))
allocate(psfc(ista:iend,jsta:jend))
1576 IF(modelname ==
'NCAR' .OR. modelname==
'RSM'.OR. modelname==
'RAPR')
THEN
1579 tlow = t(i,j,nint(lmh(i,j)))
1580 psfc(i,j) = pint(i,j,nint(lmh(i,j))+1)
1581 pshltr(i,j) = psfc(i,j)*exp(-0.068283/tlow)
1592 IF (iget(106)>0)
THEN
1598 if(tshltr(i,j)/=spval)grid1(i,j)=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
1606 if(grib==
'grib2')
then
1608 fld_info(cfld)%ifld=iavblfld(iget(106))
1609 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
1614 IF (iget(546)>0)
THEN
1621 if(grib==
'grib2')
then
1623 fld_info(cfld)%ifld=iavblfld(iget(546))
1624 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = tshltr(ista:iend,jsta:jend)
1629 IF (iget(112)>0)
THEN
1632 grid1(i,j) = qshltr(i,j)
1635 CALL bound (grid1,h1m12,h99999)
1636 if(grib==
'grib2')
then
1638 fld_info(cfld)%ifld=iavblfld(iget(112))
1639 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
1644 IF (iget(414)>0)
THEN
1647 grid1(i,j) = mrshltr(i,j)
1650 if(grib==
'grib2')
then
1652 fld_info(cfld)%ifld=iavblfld(iget(414))
1653 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1658 allocate(p1d(ista:iend,jsta:jend), t1d(ista:iend,jsta:jend))
1659 IF ((iget(113)>0) .OR.(iget(547)>0).OR.(iget(548)>0))
THEN
1666 qv = max(1.e-5,(qshltr(i,j)/(1.-qshltr(i,j))))
1667 e = pshltr(i,j)/100.*qv/(0.62197+qv)
1668 dwpt = (243.5*log(e)-440.8)/(19.48-log(e))+273.15
1676 IF(qshltr(i,j)<spval.and.pshltr(i,j)<spval)
THEN
1677 evp(i,j) = pshltr(i,j)*qshltr(i,j)/(eps+oneps*qshltr(i,j))
1678 evp(i,j) = evp(i,j)*d001
1684 CALL dewpoint(evp,egrid1(ista:iend,jsta:jend))
1687 IF (iget(113)>0)
THEN
1689 if(modelname==
'RAPR')
THEN
1693 t2=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
1694 if(qshltr(i,j)/=spval)grid1(i,j)=min(egrid1(i,j),t2)
1700 if(qshltr(i,j)/=spval) grid1(i,j) = egrid1(i,j)
1704 if(grib==
'grib2')
then
1706 fld_info(cfld)%ifld=iavblfld(iget(113))
1707 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1714 IF (iget(558)>0)
THEN
1717 evp(i,j)=p1d(i,j)*qvl1(i,j)/(eps+oneps*qvl1(i,j))
1718 evp(i,j)=evp(i,j)*d001
1721 CALL dewpoint(evp,egrid1(ista:iend,jsta:jend))
1727 if(qvl1(i,j)/=spval)grid1(i,j) = min(egrid1(i,j),t1d(i,j))
1730 if(grib==
'grib2')
then
1732 fld_info(cfld)%ifld=iavblfld(iget(558))
1733 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1739 IF ((iget(547)>0).OR.(iget(548)>0))
THEN
1744 if(tshltr(i,j)/=spval.and.pshltr(i,j)/=spval.and.qshltr(i,j)/=spval)
then
1746 grid1(i,j)=max(0.,tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa-egrid1(i,j))
1749 ape=(h10e5/pshltr(i,j))**capa
1750 grid2(i,j)=tshltr(i,j)*exp(elocp*qshltr(i,j)*ape/tshltr(i,j))
1759 IF (iget(547)>0)
THEN
1760 if(grib==
'grib2')
then
1762 fld_info(cfld)%ifld=iavblfld(iget(547))
1763 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1767 IF (iget(548)>0)
THEN
1768 if(grib==
'grib2')
then
1770 fld_info(cfld)%ifld=iavblfld(iget(548))
1771 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid2(ista:iend,jsta:jend)
1780 IF (iget(114) > 0 .OR. iget(808) > 0)
THEN
1781 allocate(q1d(ista:iend,jsta:jend))
1785 IF(modelname==
'RAPR')
THEN
1786 llmh = nint(lmh(i,j))
1788 p1d(i,j) = pmid(i,j,llmh)
1789 t1d(i,j) = t(i,j,llmh)
1791 p1d(i,j) = pshltr(i,j)
1792 t1d(i,j) = tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
1794 q1d(i,j) = qshltr(i,j)
1798 CALL calrh(p1d,t1d,q1d,egrid1(ista:iend,jsta:jend))
1800 if (
allocated(q1d))
deallocate(q1d)
1804 if(qshltr(i,j) /= spval)
then
1805 grid1(i,j) = egrid1(i,j)*100.
1811 CALL bound(grid1,h1,h100)
1812 IF (iget(114) > 0)
THEN
1813 if(grib ==
'grib2')
then
1815 fld_info(cfld)%ifld = iavblfld(iget(114))
1821 datapd(i,j,cfld) = grid1(ii,jj)
1832 if(t1d(i,j)/=spval.and.u10h(i,j)/=spval.and.v10h(i,j)<spval)
then
1833 dum1 = (t1d(i,j)-tfrz)*1.8+32.
1834 dum2 = sqrt(u10h(i,j)**2.0+v10h(i,j)**2.0)/0.44704
1835 dum3 = egrid1(i,j) * 100.0
1838 IF(dum1 <= 50.)
THEN
1840 grid2(i,j) = 35.74 + 0.6215*dum1 &
1841 - 35.75*dum216 + 0.4275*dum1*dum216
1842 grid2(i,j) =(grid2(i,j)-32.)/1.8+tfrz
1843 ELSE IF(dum1 > 80.)
THEN
1846 grid2(i,j) = -42.379 + 2.04901523*dum1 &
1847 + 10.14333127*dum3 &
1848 - 0.22475541*dum1*dum3 &
1849 - 0.00683783*dum1s &
1850 - 0.05481717*dum3s &
1851 + 0.00122874*dum1s*dum3 &
1852 + 0.00085282*dum1*dum3s &
1853 - 0.00000199*dum1s*dum3s
1854 grid2(i,j) = (grid2(i,j)-32.)/1.8 + tfrz
1856 grid2(i,j) = t1d(i,j)
1864 if(grib ==
'grib2')
then
1866 fld_info(cfld)%ifld = iavblfld(iget(808))
1872 datapd(i,j,cfld) = grid2(ii,jj)
1881 if (
allocated(p1d))
deallocate (p1d)
1882 if (
allocated(t1d))
deallocate (t1d)
1885 IF (iget(138)>0)
THEN
1891 if(grib==
'grib2')
then
1893 fld_info(cfld)%ifld=iavblfld(iget(138))
1899 datapd(i,j,cfld) = pshltr(ii,jj)
1908 IF (iget(345)>0)
THEN
1915 tmaxmin = max(tmaxmin,1.)
1917 itmaxmin = int(tmaxmin)
1918 IF(itmaxmin /= 0)
then
1919 ifincr = mod(ifhr,itmaxmin)
1920 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itmaxmin*60)
1925 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1928 id(18) = ifhr-itmaxmin
1930 id(18) = ifhr-ifincr
1931 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1933 IF (id(18)<0) id(18) = 0
1934 if(grib==
'grib2')
then
1936 fld_info(cfld)%ifld=iavblfld(iget(345))
1937 if(itmaxmin==0)
then
1938 fld_info(cfld)%ntrange=0
1940 fld_info(cfld)%ntrange=1
1942 fld_info(cfld)%tinvstat=ifhr-id(18)
1943 if(ifhr==0) fld_info(cfld)%tinvstat=0
1949 datapd(i,j,cfld) = maxtshltr(ii,jj)
1956 IF (iget(346)>0)
THEN
1964 itmaxmin = int(tmaxmin)
1965 IF(itmaxmin /= 0)
then
1966 ifincr = mod(ifhr,itmaxmin)
1967 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itmaxmin*60)
1972 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
1975 id(18) = ifhr-itmaxmin
1977 id(18) = ifhr-ifincr
1978 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
1980 IF (id(18)<0) id(18) = 0
1981 if(grib==
'grib2')
then
1983 fld_info(cfld)%ifld=iavblfld(iget(346))
1984 if(itmaxmin==0)
then
1985 fld_info(cfld)%ntrange=0
1987 fld_info(cfld)%ntrange=1
1989 fld_info(cfld)%tinvstat=ifhr-id(18)
1990 if(ifhr==0) fld_info(cfld)%tinvstat=0
1996 datapd(i,j,cfld) = mintshltr(ii,jj)
2003 IF (iget(347)>0)
THEN
2007 if(maxrhshltr(i,j)/=spval) grid1(i,j)=maxrhshltr(i,j)*100.
2012 itmaxmin = int(tmaxmin)
2013 IF(itmaxmin /= 0)
then
2014 ifincr = mod(ifhr,itmaxmin)
2015 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itmaxmin*60)
2020 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2023 id(18) = ifhr-itmaxmin
2025 id(18) = ifhr-ifincr
2026 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2028 IF (id(18)<0) id(18) = 0
2029 if(grib==
'grib2')
then
2031 fld_info(cfld)%ifld=iavblfld(iget(347))
2032 if(itmaxmin==0)
then
2033 fld_info(cfld)%ntrange=0
2037 fld_info(cfld)%ntrange=1
2040 fld_info(cfld)%tinvstat=ifhr-id(18)
2041 if(ifhr==0) fld_info(cfld)%tinvstat=0
2049 datapd(i,j,cfld) = grid1(ii,jj)
2056 IF (iget(348)>0)
THEN
2060 if(minrhshltr(i,j)/=spval) grid1(i,j)=minrhshltr(i,j)*100.
2065 itmaxmin = int(tmaxmin)
2066 IF(itmaxmin /= 0)
then
2067 ifincr = mod(ifhr,itmaxmin)
2068 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itmaxmin*60)
2073 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2076 id(18) = ifhr-itmaxmin
2078 id(18) = ifhr-ifincr
2079 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2081 IF (id(18)<0) id(18) = 0
2082 if(grib==
'grib2')
then
2084 fld_info(cfld)%ifld=iavblfld(iget(348))
2085 if(itmaxmin==0)
then
2086 fld_info(cfld)%ntrange=0
2090 fld_info(cfld)%ntrange=1
2093 fld_info(cfld)%tinvstat=ifhr-id(18)
2094 if(ifhr==0) fld_info(cfld)%tinvstat=0
2100 datapd(i,j,cfld) = grid1(ii,jj)
2108 IF (iget(510)>0)
THEN
2110 itmaxmin = int(tmaxmin)
2111 IF(itmaxmin /= 0)
then
2112 ifincr = mod(ifhr,itmaxmin)
2113 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itmaxmin*60)
2118 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2121 id(18) = ifhr-itmaxmin
2123 id(18) = ifhr-ifincr
2124 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2126 IF (id(18)<0) id(18) = 0
2127 if(grib==
'grib2')
then
2129 fld_info(cfld)%ifld=iavblfld(iget(510))
2130 if(itmaxmin==0)
then
2131 fld_info(cfld)%ntrange=0
2133 fld_info(cfld)%ntrange=1
2135 fld_info(cfld)%tinvstat=ifhr-id(18)
2141 datapd(i,j,cfld) = maxqshltr(ii,jj)
2148 IF (iget(511)>0)
THEN
2150 itmaxmin = int(tmaxmin)
2151 IF(itmaxmin /= 0)
then
2152 ifincr = mod(ifhr,itmaxmin)
2153 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itmaxmin*60)
2158 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2161 id(18) = ifhr-itmaxmin
2163 id(18) = ifhr-ifincr
2164 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2166 IF (id(18)<0) id(18) = 0
2167 if(grib==
'grib2')
then
2169 fld_info(cfld)%ifld=iavblfld(iget(511))
2170 if(itmaxmin==0)
then
2171 fld_info(cfld)%ntrange=0
2173 fld_info(cfld)%ntrange=1
2175 fld_info(cfld)%tinvstat=ifhr-id(18)
2181 datapd(i,j,cfld) = minqshltr(ii,jj)
2189 IF (iget(739)>0)
THEN
2193 if(t(i,j,lm)/=spval.and.pmid(i,j,lm)/=spval.and.smoke(i,j,lm,1)/=spval)&
2194 grid1(i,j) = (1./rd)*(pmid(i,j,lm)/t(i,j,lm))*smoke(i,j,lm,1)/(1e9)
2197 if(grib==
'grib2')
then
2199 fld_info(cfld)%ifld=iavblfld(iget(739))
2200 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
2206 IF (iget(744)>0)
THEN
2210 if(t(i,j,lm)/=spval.and.pmid(i,j,lm)/=spval.and.fv3dust(i,j,lm,1)/=spval)&
2211 grid1(i,j) = (1./rd)*(pmid(i,j,lm)/t(i,j,lm))*fv3dust(i,j,lm,1)/(1e9)
2214 if(grib==
'grib2')
then
2216 fld_info(cfld)%ifld=iavblfld(iget(744))
2217 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
2223 IF (iget(759)>0)
THEN
2227 if(t(i,j,lm)/=spval.and.pmid(i,j,lm)/=spval.and.smoke_ave(i,j)/=spval)&
2228 grid1(i,j) = (1./rd)*(pmid(i,j,lm)/t(i,j,lm))*(smoke_ave(i,j)+dust_ave(i,j))/(1e9)
2232 itsrfc = nint(tsrfc)
2233 IF(itsrfc /= 0)
then
2234 ifincr = mod(ifhr,itsrfc)
2235 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
2240 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2243 id(18) = ifhr-itsrfc
2245 id(18) = ifhr-ifincr
2246 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2248 IF (id(18)<0) id(18) = 0
2249 if(grib==
'grib2')
then
2251 fld_info(cfld)%ifld=iavblfld(iget(759))
2253 fld_info(cfld)%ntrange=1
2255 fld_info(cfld)%ntrange=0
2257 fld_info(cfld)%tinvstat=ifhr-id(18)
2258 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
2264 IF (iget(771)>0)
THEN
2268 if(t(i,j,lm)/=spval.and.pmid(i,j,lm)/=spval.and.dust_ave(i,j)/=spval)&
2269 grid1(i,j) = (1./rd)*(pmid(i,j,lm)/t(i,j,lm))*(smoke_ave(i,j)+dust_ave(i,j)+coarsepm_ave(i,j))/(1e9)
2273 itsrfc = nint(tsrfc)
2274 IF(itsrfc /= 0)
then
2275 ifincr = mod(ifhr,itsrfc)
2276 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
2281 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2284 id(18) = ifhr-itsrfc
2286 id(18) = ifhr-ifincr
2287 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2289 IF (id(18)<0) id(18) = 0
2290 if(grib==
'grib2')
then
2292 fld_info(cfld)%ifld=iavblfld(iget(771))
2294 fld_info(cfld)%ntrange=1
2296 fld_info(cfld)%ntrange=0
2298 fld_info(cfld)%tinvstat=ifhr-id(18)
2299 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
2305 IF (iget(1014)>0)
THEN
2309 if(t(i,j,lm)/=spval.and.pmid(i,j,lm)/=spval.and.coarsepm(i,j,lm,1)/=spval)&
2310 grid1(i,j) = (1./rd)*(pmid(i,j,lm)/t(i,j,lm))*coarsepm(i,j,lm,1)/(1e9)
2313 if(grib==
'grib2')
then
2315 fld_info(cfld)%ifld=iavblfld(iget(1014))
2316 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
2322 IF (iget(1017)>0)
THEN
2326 grid1(i,j) = ebb(i,j,lm,1)/(1e9)
2329 if(grib==
'grib2')
then
2331 fld_info(cfld)%ifld=iavblfld(iget(1017))
2332 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
2339 IF ( (iget(064)>0).OR.(iget(065)>0).OR. &
2340 (iget(506)>0).OR.(iget(507)>0) )
THEN
2343 IF ((iget(064)>0).OR.(iget(065)>0))
THEN
2347 grid1(i,j) = u10(i,j)
2348 grid2(i,j) = v10(i,j)
2351 if(grib==
'grib2')
then
2353 fld_info(cfld)%ifld=iavblfld(iget(064))
2359 datapd(i,j,cfld) = grid1(ii,jj)
2363 fld_info(cfld)%ifld=iavblfld(iget(065))
2369 datapd(i,j,cfld) = grid2(ii,jj)
2375 IF (iget(730)>0)
THEN
2379 grid1(i,j)=spduv10mean(i,j)
2382 if(grib==
'grib2')
then
2385 fld_info(cfld)%ifld=iavblfld(iget(730))
2386 if(fld_info(cfld)%ntrange==0)
then
2387 if (ifhr==0 .and. ifmin==0)
then
2388 fld_info(cfld)%tinvstat=0
2390 fld_info(cfld)%tinvstat=ifincr
2392 fld_info(cfld)%ntrange=1
2394 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
2399 IF (iget(731)>0)
THEN
2403 grid1(i,j)=u10mean(i,j)
2406 if(grib==
'grib2')
then
2408 fld_info(cfld)%ifld=iavblfld(iget(731))
2409 if(fld_info(cfld)%ntrange==0)
then
2410 if (ifhr==0 .and. ifmin==0)
then
2411 fld_info(cfld)%tinvstat=0
2413 fld_info(cfld)%tinvstat=ifincr
2415 fld_info(cfld)%ntrange=1
2417 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
2421 IF (iget(732)>0)
THEN
2425 grid1(i,j)=v10mean(i,j)
2428 if(grib==
'grib2')
then
2430 fld_info(cfld)%ifld=iavblfld(iget(732))
2431 if(fld_info(cfld)%ntrange==0)
then
2432 if (ifhr==0 .and. ifmin==0)
then
2433 fld_info(cfld)%tinvstat=0
2435 fld_info(cfld)%tinvstat=ifincr
2437 fld_info(cfld)%ntrange=1
2439 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
2443 IF (iget(733)>0 )
THEN
2447 grid1(i,j) = swradmean(i,j)
2450 if(grib==
'grib2')
then
2452 fld_info(cfld)%ifld=iavblfld(iget(733))
2453 if(fld_info(cfld)%ntrange==0)
then
2454 if (ifhr==0 .and. ifmin==0)
then
2455 fld_info(cfld)%tinvstat=0
2457 fld_info(cfld)%tinvstat=ifincr
2459 fld_info(cfld)%ntrange=1
2461 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
2465 IF (iget(734)>0 )
THEN
2469 grid1(i,j) = swnormmean(i,j)
2472 if(grib==
'grib2')
then
2474 fld_info(cfld)%ifld=iavblfld(iget(734))
2475 if(fld_info(cfld)%ntrange==0)
then
2476 if (ifhr==0 .and. ifmin==0)
then
2477 fld_info(cfld)%tinvstat=0
2479 fld_info(cfld)%tinvstat=ifincr
2481 fld_info(cfld)%ntrange=1
2483 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
2487 IF ((iget(506)>0).OR.(iget(507)>0))
THEN
2499 grid1(i,j) = u10max(i,j)
2500 grid2(i,j) = v10max(i,j)
2503 itsrfc = nint(tsrfc)
2504 if(grib==
'grib2')
then
2506 fld_info(cfld)%ifld=iavblfld(iget(506))
2508 fld_info(cfld)%ntrange=1
2510 fld_info(cfld)%ntrange=0
2512 fld_info(cfld)%tinvstat=ifhr-id(18)
2518 datapd(i,j,cfld) = grid1(ii,jj)
2522 fld_info(cfld)%ifld=iavblfld(iget(507))
2524 fld_info(cfld)%ntrange=1
2526 fld_info(cfld)%ntrange=0
2528 fld_info(cfld)%tinvstat=ifhr-id(18)
2534 datapd(i,j,cfld) = grid2(ii,jj)
2544 IF (iget(158)>0)
THEN
2548 grid1(i,j)=th10(i,j)
2551 if(grib==
'grib2')
then
2553 fld_info(cfld)%ifld=iavblfld(iget(158))
2559 datapd(i,j,cfld) = grid1(ii,jj)
2567 IF (iget(505)>0)
THEN
2571 grid1(i,j)=t10m(i,j)
2574 if(grib==
'grib2')
then
2576 fld_info(cfld)%ifld=iavblfld(iget(505))
2582 datapd(i,j,cfld) = grid1(ii,jj)
2590 IF (iget(159)>0)
THEN
2594 grid1(i,j) = q10(i,j)
2597 if(grib==
'grib2')
then
2599 fld_info(cfld)%ifld=iavblfld(iget(159))
2605 datapd(i,j,cfld) = grid1(ii,jj)
2615 IF (iget(422)>0)
THEN
2616 IF (modelname ==
'GFS')
THEN
2618 itsrfc = nint(tsrfc)
2619 if (itsrfc /= 0)
then
2620 ifincr = mod(ifhr,itsrfc)
2621 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
2627 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2630 id(18) = ifhr-itsrfc
2632 id(18) = ifhr-ifincr
2633 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2635 IF (id(18)<0) id(18) = 0
2640 grid1(i,j) = wspd10max(i,j)
2643 if(grib==
'grib2')
then
2645 fld_info(cfld)%ifld=iavblfld(iget(422))
2646 fld_info(cfld)%ntrange=1
2647 IF (modelname ==
'FV3R' .OR. modelname ==
'RAPR')
THEN
2649 fld_info(cfld)%tinvstat=0
2651 fld_info(cfld)%tinvstat=1
2653 ELSE IF (modelname ==
'GFS')
THEN
2654 fld_info(cfld)%tinvstat=ifhr-id(18)
2661 datapd(i,j,cfld) = grid1(ii,jj)
2669 IF (iget(783)>0)
THEN
2670 IF (modelname ==
'GFS')
THEN
2672 itsrfc = nint(tsrfc)
2673 if (itsrfc /= 0)
then
2674 ifincr = mod(ifhr,itsrfc)
2675 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
2681 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2684 id(18) = ifhr-itsrfc
2686 id(18) = ifhr-ifincr
2687 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2689 IF (id(18)<0) id(18) = 0
2694 grid1(i,j) = wspd10umax(i,j)
2697 if(grib==
'grib2')
then
2699 fld_info(cfld)%ifld=iavblfld(iget(783))
2700 fld_info(cfld)%ntrange=1
2701 IF (modelname ==
'RAPR')
THEN
2703 fld_info(cfld)%tinvstat=0
2705 fld_info(cfld)%tinvstat=1
2707 ELSE IF (modelname ==
'GFS')
THEN
2708 fld_info(cfld)%tinvstat=ifhr-id(18)
2715 datapd(i,j,cfld) = grid1(ii,jj)
2723 IF (iget(784)>0)
THEN
2724 IF (modelname ==
'GFS')
THEN
2726 itsrfc = nint(tsrfc)
2727 if (itsrfc /= 0)
then
2728 ifincr = mod(ifhr,itsrfc)
2729 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
2735 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2738 id(18) = ifhr-itsrfc
2740 id(18) = ifhr-ifincr
2741 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
2743 IF (id(18)<0) id(18) = 0
2748 grid1(i,j) = wspd10vmax(i,j)
2751 if(grib==
'grib2')
then
2753 fld_info(cfld)%ifld=iavblfld(iget(784))
2754 fld_info(cfld)%ntrange=1
2755 IF (modelname ==
'RAPR')
THEN
2757 fld_info(cfld)%tinvstat=0
2759 fld_info(cfld)%tinvstat=1
2761 ELSE IF (modelname ==
'GFS')
THEN
2762 fld_info(cfld)%tinvstat=ifhr-id(18)
2769 datapd(i,j,cfld) = grid1(i,jj)
2780 IF (iget(588)>0)
THEN
2782 CALL calvessel(iceg(ista:iend,jsta:jend))
2786 grid1(i,j) = iceg(i,j)
2790 if(grib==
'grib2')
then
2792 fld_info(cfld)%ifld=iavblfld(iget(588))
2794 fld_info(cfld)%tinvstat=0
2796 fld_info(cfld)%tinvstat=1
2798 fld_info(cfld)%ntrange=1
2805 datapd(i,j,cfld) = grid1(ii,jj)
2828 IF (iget(172)>0)
THEN
2832 IF (prec(i,j) <= pthresh .OR. sr(i,j)==spval)
THEN
2835 grid1(i,j) = sr(i,j)*100.
2839 if(grib==
'grib2')
then
2841 fld_info(cfld)%ifld=iavblfld(iget(172))
2847 datapd(i,j,cfld) = grid1(ii,jj)
2855 IF (iget(249)>0)
THEN
2862 if(cprate(i,j)/=spval) grid1(i,j) = cprate(i,j)*rdtphs
2866 if(grib==
'grib2')
then
2868 fld_info(cfld)%ifld=iavblfld(iget(249))
2874 datapd(i,j,cfld) = grid1(ii,jj)
2881 IF (iget(167)>0)
THEN
2889 if(prec(i,j)/=spval)
then
2890 IF(modelname /=
'RSM')
THEN
2891 grid1(i,j) = prec(i,j)*rdtphs*1000.
2893 grid1(i,j) = prec(i,j)
2898 if(grib==
'grib2')
then
2900 fld_info(cfld)%ifld=iavblfld(iget(167))
2906 datapd(i,j,cfld) = grid1(ii,jj)
2913 IF (iget(508)>0)
THEN
2923 if(prate_max(i,j)/=spval) grid1(i,j)=prate_max(i,j)*sec2hr
2926 itsrfc = nint(tsrfc)
2927 if(grib==
'grib2')
then
2929 fld_info(cfld)%ifld=iavblfld(iget(508))
2930 fld_info(cfld)%lvl=lvlsxml(1,iget(508))
2932 fld_info(cfld)%ntrange=1
2934 fld_info(cfld)%ntrange=0
2936 fld_info(cfld)%tinvstat=ifhr-id(18)
2942 datapd(i,j,cfld) = grid1(ii,jj)
2949 IF (iget(509)>0)
THEN
2954 if(fprate_max(i,j)/=spval) grid1(i,j)=fprate_max(i,j)*sec2hr
2957 if(grib==
'grib2')
then
2959 fld_info(cfld)%ifld=iavblfld(iget(509))
2960 fld_info(cfld)%lvl=lvlsxml(1,iget(509))
2961 fld_info(cfld)%tinvstat=1
2963 fld_info(cfld)%ntrange=1
2965 fld_info(cfld)%ntrange=0
2972 datapd(i,j,cfld) = grid1(ii,jj)
2979 IF (iget(272)>0)
THEN
2982 itprec = nint(tprec)
2984 if (itprec /= 0)
then
2985 ifincr = mod(ifhr,itprec)
2986 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
2993 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2996 id(18) = ifhr-itprec
2998 id(18) = ifhr-ifincr
2999 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3001 IF (id(18)<0) id(18) = 0
3006 if(avgcprate(i,j)/=spval) grid1(i,j) = avgcprate(i,j)*rdtphs
3013 if(grib==
'grib2')
then
3015 fld_info(cfld)%ifld=iavblfld(iget(272))
3018 fld_info(cfld)%ntrange=0
3020 fld_info(cfld)%ntrange=1
3022 fld_info(cfld)%tinvstat=ifhr-id(18)
3029 datapd(i,j,cfld) = grid1(ii,jj)
3036 IF (iget(271)>0)
THEN
3040 itprec = nint(tprec)
3042 if (itprec /= 0)
then
3043 ifincr = mod(ifhr,itprec)
3044 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3051 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3054 id(18) = ifhr-itprec
3056 id(18) = ifhr-ifincr
3057 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3059 IF (id(18)<0) id(18) = 0
3064 if(avgprec(i,j)/=spval) grid1(i,j) = avgprec(i,j)*rdtphs
3068 if(grib==
'grib2')
then
3070 fld_info(cfld)%ifld=iavblfld(iget(271))
3073 fld_info(cfld)%ntrange=0
3075 fld_info(cfld)%ntrange=1
3077 fld_info(cfld)%tinvstat=ifhr-id(18)
3084 datapd(i,j,cfld) = grid1(ii,jj)
3091 IF (iget(087)>0)
THEN
3093 itprec = nint(tprec)
3095 if (itprec /= 0)
then
3096 ifincr = mod(ifhr,itprec)
3097 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3104 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3107 id(18) = ifhr-itprec
3109 id(18) = ifhr-ifincr
3110 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3112 IF(modelname ==
'GFS' .OR. modelname ==
'FV3R')
THEN
3116 IF(avgprec(i,j) < spval)
THEN
3117 grid1(i,j) = avgprec(i,j)*float(id(19)-id(18))*3600.*1000./dtq2
3137 IF(acprec(i,j) < spval)
THEN
3138 grid1(i,j) = acprec(i,j)*1000.
3150 IF (id(18)<0) id(18) = 0
3152 if(grib==
'grib2')
then
3154 fld_info(cfld)%ifld=iavblfld(iget(087))
3155 fld_info(cfld)%ntrange=1
3156 fld_info(cfld)%tinvstat=ifhr-id(18)
3163 datapd(i,j,cfld) = grid1(ii,jj)
3185 IF (iget(417)>0)
THEN
3187 itprec = nint(tprec)
3189 if (itprec /= 0)
then
3190 ifincr = mod(ifhr,itprec)
3191 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3198 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3201 id(18) = ifhr-itprec
3203 id(18) = ifhr-ifincr
3204 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3206 IF(modelname ==
'GFS' .OR. modelname ==
'FV3R')
THEN
3211 IF(avgprec_cont(i,j) < spval)
THEN
3212 grid2(i,j) = avgprec_cont(i,j)*((3600.*float(ifhr))+(60.*float(ifmin)))*1000./dtq2
3219 IF (id(18)<0) id(18) = 0
3220 if(grib==
'grib2')
then
3222 if(modelname ==
'GFS' .OR. modelname ==
'FV3R')
then
3224 fld_info(cfld)%ifld=iavblfld(iget(417))
3225 fld_info(cfld)%ntrange=1
3227 fld_info(cfld)%tinvstat=ifhr*60+ifmin
3229 fld_info(cfld)%tinvstat=ifhr
3237 datapd(i,j,cfld) = grid2(ii,jj)
3245 IF (iget(033)>0)
THEN
3247 itprec = nint(tprec)
3249 if (itprec /= 0)
then
3250 ifincr = mod(ifhr,itprec)
3251 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3258 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3261 id(18) = ifhr-itprec
3263 id(18) = ifhr-ifincr
3264 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3266 IF (id(18)<0) id(18) = 0
3267 IF(modelname ==
'GFS' .OR. modelname ==
'FV3R')
THEN
3271 IF(avgcprate(i,j) < spval)
THEN
3272 grid1(i,j) = avgcprate(i,j)* &
3273 float(id(19)-id(18))*3600.*1000./dtq2
3293 IF(cuprec(i,j) < spval)
THEN
3294 grid1(i,j) = cuprec(i,j)*1000.
3302 if(grib==
'grib2')
then
3304 fld_info(cfld)%ifld=iavblfld(iget(033))
3305 fld_info(cfld)%ntrange=1
3306 fld_info(cfld)%tinvstat=ifhr-id(18)
3312 datapd(i,j,cfld) = grid1(ii,jj)
3332 IF (iget(418)>0)
THEN
3334 itprec = nint(tprec)
3336 if (itprec /= 0)
then
3337 ifincr = mod(ifhr,itprec)
3338 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3345 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3348 id(18) = ifhr-itprec
3350 id(18) = ifhr-ifincr
3351 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3353 IF (id(18)<0) id(18) = 0
3354 IF(modelname ==
'GFS' .OR. modelname ==
'FV3R')
THEN
3359 IF(avgcprate_cont(i,j) < spval)
THEN
3360 grid2(i,j) = avgcprate_cont(i,j)*float(ifhr)*3600.*1000./dtq2
3368 if(grib==
'grib2')
then
3370 if(modelname ==
'GFS' .OR. modelname ==
'FV3R')
then
3372 fld_info(cfld)%ifld=iavblfld(iget(418))
3373 fld_info(cfld)%ntrange=1
3374 fld_info(cfld)%tinvstat=ifhr
3380 datapd(i,j,cfld) = grid2(ii,jj)
3388 IF (iget(034)>0)
THEN
3391 itprec = nint(tprec)
3393 if (itprec /= 0)
then
3394 ifincr = mod(ifhr,itprec)
3395 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3402 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3405 id(18) = ifhr-itprec
3407 id(18) = ifhr-ifincr
3408 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3410 IF (id(18)<0) id(18) = 0
3411 IF(modelname ==
'GFS' .OR. modelname ==
'FV3R')
THEN
3415 IF(avgcprate(i,j) < spval .AND. avgprec(i,j) < spval)
then
3416 grid1(i,j) = ( avgprec(i,j) - avgcprate(i,j) ) * &
3417 float(id(19)-id(18))*3600.*1000./dtq2
3438 grid1(i,j) = ancprc(i,j)*1000.
3443 if(grib==
'grib2')
then
3445 fld_info(cfld)%ifld=iavblfld(iget(034))
3446 fld_info(cfld)%ntrange=1
3447 fld_info(cfld)%tinvstat=ifhr-id(18)
3453 datapd(i,j,cfld) = grid1(ii,jj)
3474 IF (iget(419)>0)
THEN
3476 itprec = nint(tprec)
3478 if (itprec /= 0)
then
3479 ifincr = mod(ifhr,itprec)
3480 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3487 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3490 id(18) = ifhr-itprec
3492 id(18) = ifhr-ifincr
3493 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3495 IF (id(18)<0) id(18) = 0
3496 IF(modelname ==
'GFS' .OR. modelname ==
'FV3R')
THEN
3501 IF(avgcprate_cont(i,j) < spval .AND. avgprec_cont(i,j) < spval)
THEN
3502 grid2(i,j) = (avgprec_cont(i,j) - avgcprate_cont(i,j)) &
3503 *float(ifhr)*3600.*1000./dtq2
3511 if(grib==
'grib2')
then
3513 if(modelname ==
'GFS' .OR. modelname ==
'FV3R')
then
3515 fld_info(cfld)%ifld=iavblfld(iget(419))
3516 fld_info(cfld)%ntrange=1
3517 fld_info(cfld)%tinvstat=ifhr
3523 datapd(i,j,cfld) = grid2(ii,jj)
3531 IF (iget(256)>0)
THEN
3536 IF(lspa(i,j)<=-1.0e-6)
THEN
3537 if(acprec(i,j)/=spval) grid1(i,j) = acprec(i,j)*1000
3539 if(lspa(i,j)/=spval) grid1(i,j) = lspa(i,j)*1000.
3544 itprec = nint(tprec)
3546 if (itprec /= 0)
then
3547 ifincr = mod(ifhr,itprec)
3548 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3555 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3558 id(18) = ifhr-itprec
3560 id(18) = ifhr-ifincr
3561 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3563 IF (id(18)<0) id(18) = 0
3565 if(grib==
'grib2')
then
3567 fld_info(cfld)%ifld=iavblfld(iget(256))
3568 fld_info(cfld)%ntrange=1
3569 fld_info(cfld)%tinvstat=ifhr-id(18)
3575 datapd(i,j,cfld) = grid1(ii,jj)
3582 IF (iget(035)>0)
THEN
3587 grid1(i,j) = acsnow(i,j)
3591 itprec = nint(tprec)
3593 if (itprec /= 0)
then
3594 ifincr = mod(ifhr,itprec)
3595 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3602 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3605 id(18) = ifhr-itprec
3607 id(18) = ifhr-ifincr
3608 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3610 IF (id(18)<0) id(18) = 0
3611 if(grib==
'grib2')
then
3613 fld_info(cfld)%ifld=iavblfld(iget(035))
3614 fld_info(cfld)%ntrange=1
3615 fld_info(cfld)%tinvstat=ifhr
3621 datapd(i,j,cfld) = grid1(ii,jj)
3628 IF (iget(746)>0)
THEN
3632 grid1(i,j) = acgraup(i,j)
3636 itprec = nint(tprec)
3638 if (itprec /= 0)
then
3639 ifincr = mod(ifhr,itprec)
3640 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3647 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3650 id(18) = ifhr-itprec
3652 id(18) = ifhr-ifincr
3653 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3655 IF (id(18)<0) id(18) = 0
3656 if(grib==
'grib2')
then
3658 fld_info(cfld)%ifld=iavblfld(iget(746))
3659 fld_info(cfld)%ntrange=1
3660 if(modelname==
'FV3R' .OR. modelname==
'GFS')
then
3662 fld_info(cfld)%tinvstat=ifhr*60+ifmin
3664 fld_info(cfld)%tinvstat=ifhr
3667 fld_info(cfld)%tinvstat=ifhr-id(18)
3674 datapd(i,j,cfld) = grid1(ii,jj)
3681 IF (iget(782)>0)
THEN
3685 grid1(i,j) = acfrain(i,j)
3689 itprec = nint(tprec)
3691 if (itprec /= 0)
then
3692 ifincr = mod(ifhr,itprec)
3693 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3700 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3703 id(18) = ifhr-itprec
3705 id(18) = ifhr-ifincr
3706 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3708 IF (id(18)<0) id(18) = 0
3709 if(grib==
'grib2')
then
3711 fld_info(cfld)%ifld=iavblfld(iget(782))
3712 fld_info(cfld)%ntrange=1
3713 if(modelname==
'FV3R' .OR. modelname==
'GFS')
then
3715 fld_info(cfld)%tinvstat=ifhr*60+ifmin
3717 fld_info(cfld)%tinvstat=ifhr
3720 fld_info(cfld)%tinvstat=ifhr-id(18)
3727 datapd(i,j,cfld) = grid1(ii,jj)
3734 IF (iget(1004)>0)
THEN
3738 grid1(i,j) = snow_acm(i,j)
3742 itprec = nint(tprec)
3744 if (itprec /= 0)
then
3745 ifincr = mod(ifhr,itprec)
3746 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3753 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3756 id(18) = ifhr-itprec
3758 id(18) = ifhr-ifincr
3759 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3761 IF (id(18)<0) id(18) = 0
3762 if(grib==
'grib2')
then
3764 fld_info(cfld)%ifld=iavblfld(iget(1004))
3765 fld_info(cfld)%ntrange=1
3766 if(modelname==
'FV3R' .OR. modelname==
'GFS')
then
3768 fld_info(cfld)%tinvstat=ifhr*60+ifmin
3770 fld_info(cfld)%tinvstat=ifhr
3773 fld_info(cfld)%tinvstat=ifhr-id(18)
3781 datapd(i,j,cfld) = grid1(ii,jj)
3789 IF (iget(121)>0)
THEN
3794 grid1(i,j) = acsnom(i,j)
3798 itprec = nint(tprec)
3800 if (itprec /= 0)
then
3801 ifincr = mod(ifhr,itprec)
3802 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3809 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3812 id(18) = ifhr-itprec
3814 id(18) = ifhr-ifincr
3815 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3817 IF (id(18)<0) id(18) = 0
3818 if(grib==
'grib2')
then
3820 fld_info(cfld)%ifld=iavblfld(iget(121))
3821 fld_info(cfld)%ntrange=1
3822 fld_info(cfld)%tinvstat=ifhr-id(18)
3828 datapd(i,j,cfld) = grid1(ii,jj)
3835 IF (iget(405)>0)
THEN
3839 grid1(i,j) = snowfall(i,j)
3843 itprec = nint(tprec)
3845 if (itprec /= 0)
then
3846 ifincr = mod(ifhr,itprec)
3847 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3854 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3857 id(18) = ifhr-itprec
3859 id(18) = ifhr-ifincr
3860 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3862 IF (id(18)<0) id(18) = 0
3863 IF(itprec < 0)id(1:25)=0
3864 if(grib==
'grib2')
then
3866 fld_info(cfld)%ifld=iavblfld(iget(405))
3867 fld_info(cfld)%ntrange=1
3868 fld_info(cfld)%tinvstat=ifhr-id(18)
3874 datapd(i,j,cfld) = grid1(ii,jj)
3881 IF (iget(122)>0)
THEN
3886 grid1(i,j) = ssroff(i,j)
3890 itprec = nint(tprec)
3892 if (itprec /= 0)
then
3893 ifincr = mod(ifhr,itprec)
3894 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3901 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3904 id(18) = ifhr-itprec
3906 id(18) = ifhr-ifincr
3907 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3909 IF (id(18)<0) id(18) = 0
3911 IF (modelname==
'RAPR')
THEN
3918 if(grib==
'grib2')
then
3920 fld_info(cfld)%ifld=iavblfld(iget(122))
3921 fld_info(cfld)%ntrange=1
3922 fld_info(cfld)%tinvstat=ifhr-id(18)
3928 datapd(i,j,cfld) = grid1(ii,jj)
3935 IF (iget(123)>0)
THEN
3940 grid1(i,j) = bgroff(i,j)
3944 itprec = nint(tprec)
3946 if (itprec /= 0)
then
3947 ifincr = mod(ifhr,itprec)
3948 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
3955 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
3958 id(18) = ifhr-itprec
3960 id(18) = ifhr-ifincr
3961 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
3963 IF (id(18)<0) id(18) = 0
3965 IF (modelname==
'RAPR')
THEN
3972 if(grib==
'grib2')
then
3974 fld_info(cfld)%ifld=iavblfld(iget(123))
3975 fld_info(cfld)%ntrange=1
3976 fld_info(cfld)%tinvstat=ifhr-id(18)
3982 datapd(i,j,cfld) = grid1(ii,jj)
3989 IF (iget(343)>0)
THEN
3993 grid1(i,j) = runoff(i,j)
3997 itprec = nint(tprec)
4000 if(modelname ==
'GFS')itprec=nint(tmaxmin)
4002 if (itprec /= 0)
then
4003 ifincr = mod(ifhr,itprec)
4004 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4011 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4014 id(18) = ifhr-itprec
4016 id(18) = ifhr-ifincr
4017 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4019 IF (id(18)<0) id(18) = 0
4020 if(grib==
'grib2')
then
4022 fld_info(cfld)%ifld=iavblfld(iget(343))
4023 fld_info(cfld)%ntrange=1
4024 fld_info(cfld)%tinvstat=ifhr-id(18)
4030 datapd(i,j,cfld) = grid1(ii,jj)
4038 need_ifi = iget(1007)>0 .or. iget(1008)>0 .or. iget(1009)>0 .or. iget(1010)>0
4039 IF (iget(434)>0. .or. need_ifi)
THEN
4046 ifi_apcp(i,j) = pcp_bucket(i,j)
4053 IF (iget(434)>0.)
THEN
4055 itprec = nint(tprec)
4057 if (itprec /= 0)
then
4058 ifincr = mod(ifhr,itprec)
4059 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4064 if(modelname==
'NCAR' .OR. modelname==
'RAPR') ifincr = nint(prec_acc_dt)/60
4067 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4070 id(18) = ifhr-itprec
4072 id(18) = ifhr-ifincr
4073 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4075 IF (id(18)<0) id(18) = 0
4076 if(grib==
'grib2' .and. iget(434)>0)
then
4078 fld_info(cfld)%ifld=iavblfld(iget(434))
4080 fld_info(cfld)%ntrange=(ifhr-id(18))/itprec
4082 fld_info(cfld)%ntrange=0
4084 fld_info(cfld)%tinvstat=itprec
4085 if(fld_info(cfld)%ntrange==0)
then
4087 fld_info(cfld)%tinvstat=0
4089 fld_info(cfld)%tinvstat=1
4091 fld_info(cfld)%ntrange=1
4098 datapd(i,j,cfld) = ifi_apcp(ii,jj)
4106 IF (iget(435)>0.)
THEN
4113 grid1(i,j) = rainc_bucket(i,j)
4118 itprec = nint(tprec)
4120 if (itprec /= 0)
then
4121 ifincr = mod(ifhr,itprec)
4122 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4127 if(modelname==
'NCAR' .OR. modelname==
'RAPR') ifincr = nint(prec_acc_dt)/60
4131 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4134 id(18) = ifhr-itprec
4136 id(18) = ifhr-ifincr
4137 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4139 IF (id(18)<0) id(18) = 0
4142 if(debugprint .and. me==0)
then
4143 print *,
'PREC_ACC_DT,ID(18),ID(19)',prec_acc_dt,id(18),id(19)
4146 if(grib==
'grib2')
then
4148 fld_info(cfld)%ifld=iavblfld(iget(435))
4150 fld_info(cfld)%ntrange=(ifhr-id(18))/itprec
4152 fld_info(cfld)%ntrange=0
4154 fld_info(cfld)%tinvstat=itprec
4155 if(fld_info(cfld)%ntrange==0)
then
4157 fld_info(cfld)%tinvstat=0
4159 fld_info(cfld)%tinvstat=1
4161 fld_info(cfld)%ntrange=1
4168 datapd(i,j,cfld) = grid1(ii,jj)
4175 IF (iget(436)>0.)
THEN
4182 grid1(i,j) = rainnc_bucket(i,j)
4187 itprec = nint(tprec)
4189 if (itprec /= 0)
then
4190 ifincr = mod(ifhr,itprec)
4191 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4196 if(modelname==
'NCAR' .OR. modelname==
'RAPR') ifincr = nint(prec_acc_dt)/60
4199 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4202 id(18) = ifhr-itprec
4204 id(18) = ifhr-ifincr
4205 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4207 IF (id(18)<0) id(18) = 0
4208 if(grib==
'grib2')
then
4210 fld_info(cfld)%ifld=iavblfld(iget(436))
4212 fld_info(cfld)%ntrange=(ifhr-id(18))/itprec
4214 fld_info(cfld)%ntrange=0
4216 fld_info(cfld)%tinvstat=itprec
4217 if(fld_info(cfld)%ntrange==0)
then
4219 fld_info(cfld)%tinvstat=0
4221 fld_info(cfld)%tinvstat=1
4223 fld_info(cfld)%ntrange=1
4230 datapd(i,j,cfld) = grid1(ii,jj)
4237 IF (iget(437)>0.)
THEN
4241 grid1(i,j) = snow_bucket(i,j)
4245 itprec = nint(tprec)
4247 if (itprec /= 0)
then
4248 ifincr = mod(ifhr,itprec)
4249 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4254 if(modelname==
'NCAR' .OR. modelname==
'RAPR') ifincr = nint(prec_acc_dt)/60
4257 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4260 id(18) = ifhr-itprec
4262 id(18) = ifhr-ifincr
4263 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4265 IF (id(18)<0) id(18) = 0
4267 if(grib==
'grib2')
then
4269 fld_info(cfld)%ifld=iavblfld(iget(437))
4271 fld_info(cfld)%ntrange=(ifhr-id(18))/itprec
4273 fld_info(cfld)%ntrange=0
4275 fld_info(cfld)%tinvstat=itprec
4276 if(fld_info(cfld)%ntrange==0)
then
4278 fld_info(cfld)%tinvstat=0
4280 fld_info(cfld)%tinvstat=1
4282 fld_info(cfld)%ntrange=1
4289 datapd(i,j,cfld) = grid1(ii,jj)
4296 IF (iget(775)>0.)
THEN
4300 grid1(i,j) = graup_bucket(i,j)
4304 itprec = nint(tprec)
4306 if (itprec /= 0)
then
4307 ifincr = mod(ifhr,itprec)
4308 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4313 if(modelname==
'NCAR' .OR. modelname==
'RAPR') ifincr = nint(prec_acc_dt)/60
4316 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4319 id(18) = ifhr-itprec
4321 id(18) = ifhr-ifincr
4322 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4324 IF (id(18)<0) id(18) = 0
4326 if(grib==
'grib2')
then
4328 fld_info(cfld)%ifld=iavblfld(iget(775))
4330 fld_info(cfld)%ntrange=(ifhr-id(18))/itprec
4332 fld_info(cfld)%ntrange=0
4334 fld_info(cfld)%tinvstat=itprec
4335 if(fld_info(cfld)%ntrange==0)
then
4337 fld_info(cfld)%tinvstat=0
4339 fld_info(cfld)%tinvstat=1
4341 fld_info(cfld)%ntrange=1
4343 if(modelname ==
'GFS' .OR. modelname ==
'FV3R')
then
4344 fld_info(cfld)%ntrange=1
4345 fld_info(cfld)%tinvstat=ifhr-id(18)
4352 datapd(i,j,cfld) = grid1(ii,jj)
4359 IF (iget(1003)>0.)
THEN
4363 grid1(i,j) = frzrn_bucket(i,j)
4367 itprec = nint(tprec)
4369 if (itprec /= 0)
then
4370 ifincr = mod(ifhr,itprec)
4371 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4378 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4381 id(18) = ifhr-itprec
4383 id(18) = ifhr-ifincr
4384 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4386 IF (id(18)<0) id(18) = 0
4388 if(grib==
'grib2')
then
4390 fld_info(cfld)%ifld=iavblfld(iget(1003))
4391 fld_info(cfld)%ntrange=1
4392 fld_info(cfld)%tinvstat=ifhr-id(18)
4412 datapd(i,j,cfld) = grid1(ii,jj)
4419 IF (iget(1005)>0.)
THEN
4423 grid1(i,j) = snow_bkt(i,j)
4427 itprec = nint(tprec)
4429 if (itprec /= 0)
then
4430 ifincr = mod(ifhr,itprec)
4431 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
4438 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
4441 id(18) = ifhr-itprec
4443 id(18) = ifhr-ifincr
4444 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
4446 IF (id(18)<0) id(18) = 0
4448 if(grib==
'grib2')
then
4450 fld_info(cfld)%ifld=iavblfld(iget(1005))
4451 fld_info(cfld)%ntrange=1
4452 fld_info(cfld)%tinvstat=ifhr-id(18)
4458 datapd(i,j,cfld) = grid1(ii,jj)
4467 IF (iget(913).GT.0)
THEN
4468 ffgfile=
'ffg_01h.grib2'
4471 IF (iget(914).GT.0)
THEN
4472 IF (ifhr .EQ. 1)
THEN
4473 ffgfile=
'ffg_01h.grib2'
4475 ELSEIF (ifhr .EQ. 3)
THEN
4476 ffgfile=
'ffg_03h.grib2'
4478 ELSEIF (ifhr .EQ. 6)
THEN
4479 ffgfile=
'ffg_06h.grib2'
4481 ELSEIF (ifhr .EQ. 12)
THEN
4482 ffgfile=
'ffg_12h.grib2'
4485 ffgfile=
'ffg_01h.grib2'
4493 IF (iget(915).GT.0)
THEN
4494 arifile=
'ari2y_01h.grib2'
4497 IF (iget(916).GT.0)
THEN
4498 IF (ifhr .EQ. 1)
THEN
4499 arifile=
'ari2y_01h.grib2'
4501 ELSEIF (ifhr .EQ. 3)
THEN
4502 arifile=
'ari2y_03h.grib2'
4504 ELSEIF (ifhr .EQ. 6)
THEN
4505 arifile=
'ari2y_06h.grib2'
4507 ELSEIF (ifhr .EQ. 12)
THEN
4508 arifile=
'ari2y_12h.grib2'
4510 ELSEIF (ifhr .EQ. 24)
THEN
4511 arifile=
'ari2y_24h.grib2'
4514 arifile=
'ari2y_01h.grib2'
4519 IF (iget(917).GT.0)
THEN
4520 arifile=
'ari5y_01h.grib2'
4523 IF (iget(918).GT.0)
THEN
4524 IF (ifhr .EQ. 1)
THEN
4525 arifile=
'ari5y_01h.grib2'
4527 ELSEIF (ifhr .EQ. 3)
THEN
4528 arifile=
'ari5y_03h.grib2'
4530 ELSEIF (ifhr .EQ. 6)
THEN
4531 arifile=
'ari5y_06h.grib2'
4533 ELSEIF (ifhr .EQ. 12)
THEN
4534 arifile=
'ari5y_12h.grib2'
4536 ELSEIF (ifhr .EQ. 24)
THEN
4537 arifile=
'ari5y_24h.grib2'
4540 arifile=
'ari5y_01h.grib2'
4545 IF (iget(919).GT.0)
THEN
4546 arifile=
'ari10y_01h.grib2'
4549 IF (iget(920).GT.0)
THEN
4550 IF (ifhr .EQ. 1)
THEN
4551 arifile=
'ari10y_01h.grib2'
4553 ELSEIF (ifhr .EQ. 3)
THEN
4554 arifile=
'ari10y_03h.grib2'
4556 ELSEIF (ifhr .EQ. 6)
THEN
4557 arifile=
'ari10y_06h.grib2'
4559 ELSEIF (ifhr .EQ. 12)
THEN
4560 arifile=
'ari10y_12h.grib2'
4562 ELSEIF (ifhr .EQ. 24)
THEN
4563 arifile=
'ari10y_24h.grib2'
4566 arifile=
'ari10y_01h.grib2'
4571 IF (iget(921).GT.0)
THEN
4572 arifile=
'ari100y_01h.grib2'
4575 IF (iget(922).GT.0)
THEN
4576 IF (ifhr .EQ. 1)
THEN
4577 arifile=
'ari100y_01h.grib2'
4579 ELSEIF (ifhr .EQ. 3)
THEN
4580 arifile=
'ari100y_03h.grib2'
4582 ELSEIF (ifhr .EQ. 6)
THEN
4583 arifile=
'ari100y_06h.grib2'
4585 ELSEIF (ifhr .EQ. 12)
THEN
4586 arifile=
'ari100y_12h.grib2'
4588 ELSEIF (ifhr .EQ. 24)
THEN
4589 arifile=
'ari100y_24h.grib2'
4592 arifile=
'ari100y_01h.grib2'
4600 IF (iget(525)>0.)
THEN
4604 IF(sndepac(i,j) < spval)
THEN
4605 grid1(i,j) = sndepac(i,j)/(1e3)
4609 ifincr = nint(prec_acc_dt1)
4610 if(grib==
'grib2')
then
4612 fld_info(cfld)%ifld=iavblfld(iget(525))
4613 if(fld_info(cfld)%ntrange==0)
then
4614 if (ifhr==0 .and. ifmin==0)
then
4615 fld_info(cfld)%tinvstat=0
4617 fld_info(cfld)%tinvstat=ifincr
4619 fld_info(cfld)%ntrange=1
4626 datapd(i,j,cfld) = grid1(ii,jj)
4632 IF (iget(526)>0.)
THEN
4633 IF (modelname .EQ.
'FV3R')
THEN
4637 IF(avgprec_cont(i,j) < spval)
THEN
4638 grid1(i,j) = avgprec_cont(i,j)*900.*1000./dtq2
4646 IF (ifhr == 0 .AND. ifmin == 0)
THEN
4649 grid1(i,j) = pcp_bucket1(i,j)
4654 ifincr = nint(prec_acc_dt1)
4655 if(grib==
'grib2')
then
4657 fld_info(cfld)%ifld=iavblfld(iget(526))
4658 if(fld_info(cfld)%ntrange==0)
then
4659 if (ifhr==0 .and. ifmin==0)
then
4660 fld_info(cfld)%tinvstat=0
4662 fld_info(cfld)%tinvstat=ifincr
4664 fld_info(cfld)%ntrange=1
4671 datapd(i,j,cfld) = grid1(ii,jj)
4677 IF (iget(527)>0.)
THEN
4681 IF(acfrain(i,j) < spval)
THEN
4682 grid1(i,j) = acfrain(i,j)
4686 ifincr = nint(prec_acc_dt1)
4687 if(grib==
'grib2')
then
4689 fld_info(cfld)%ifld=iavblfld(iget(527))
4690 if(fld_info(cfld)%ntrange==0)
then
4691 if (ifhr==0 .and. ifmin==0)
then
4692 fld_info(cfld)%tinvstat=0
4694 fld_info(cfld)%tinvstat=ifincr
4696 fld_info(cfld)%ntrange=1
4703 datapd(i,j,cfld) = grid1(ii,jj)
4709 IF (iget(528)>0.)
THEN
4713 IF(snow_acm(i,j) < spval)
THEN
4714 grid1(i,j) = snow_acm(i,j)
4718 ifincr = nint(prec_acc_dt1)
4719 if(grib==
'grib2')
then
4721 fld_info(cfld)%ifld=iavblfld(iget(528))
4722 if(fld_info(cfld)%ntrange==0)
then
4723 if (ifhr==0 .and. ifmin==0)
then
4724 fld_info(cfld)%tinvstat=0
4726 fld_info(cfld)%tinvstat=ifincr
4728 fld_info(cfld)%ntrange=1
4735 datapd(i,j,cfld) = grid1(ii,jj)
4741 IF (iget(529)>0.)
THEN
4745 IF (ifhr == 0 .AND. ifmin == 0)
THEN
4748 grid1(i,j) = snow_bucket1(i,j)
4752 ifincr = nint(prec_acc_dt1)
4754 if(grib==
'grib2')
then
4756 fld_info(cfld)%ifld=iavblfld(iget(529))
4757 if(fld_info(cfld)%ntrange==0)
then
4758 if (ifhr==0 .and. ifmin==0)
then
4759 fld_info(cfld)%tinvstat=0
4761 fld_info(cfld)%tinvstat=ifincr
4763 fld_info(cfld)%ntrange=1
4770 datapd(i,j,cfld) = grid1(ii,jj)
4776 IF (iget(530)>0.)
THEN
4777 IF (modelname .EQ.
'FV3R')
THEN
4781 IF(acgraup(i,j) < spval)
THEN
4782 grid1(i,j) = acgraup(i,j)
4790 IF (ifhr == 0 .AND. ifmin == 0)
THEN
4793 grid1(i,j) = graup_bucket1(i,j)
4798 ifincr = nint(prec_acc_dt1)
4800 if(grib==
'grib2')
then
4802 fld_info(cfld)%ifld=iavblfld(iget(530))
4803 if(fld_info(cfld)%ntrange==0)
then
4804 if (ifhr==0 .and. ifmin==0)
then
4805 fld_info(cfld)%tinvstat=0
4807 fld_info(cfld)%tinvstat=ifincr
4809 fld_info(cfld)%ntrange=1
4816 datapd(i,j,cfld) = grid1(ii,jj)
4824 IF (iget(160)>0 .OR.(iget(247)>0))
THEN
4826 allocate(sleet(ista:iend,jsta:jend,nalg), rain(ista:iend,jsta:jend,nalg), &
4827 freezr(ista:iend,jsta:jend,nalg), snow(ista:iend,jsta:jend,nalg))
4828 allocate(zwet(ista:iend,jsta:jend))
4829 CALL calwxt_post(t,q,pmid,pint,htm,lmh,prec,zint,iwx1,zwet)
4833 IF (iget(160)>0)
THEN
4837 IF(zwet(i,j)<spval)
THEN
4839 snow(i,j,1) = mod(iwx,2)
4840 sleet(i,j,1) = mod(iwx,4)/2
4841 freezr(i,j,1) = mod(iwx,8)/4
4845 sleet(i,j,1) = spval
4846 freezr(i,j,1) = spval
4854 IF (iget(247)>0)
THEN
4857 grid1(i,j) = zwet(i,j)
4860 if(grib==
'grib2')
then
4862 fld_info(cfld)%ifld=iavblfld(iget(247))
4868 datapd(i,j,cfld) = grid1(ii,jj)
4879 IF (iget(160)>0)
THEN
4881 CALL calwxt_ramer_post(t,q,pmid,pint,lmh,prec,iwx1)
4890 snow(i,j,2) = mod(iwx,2)
4891 sleet(i,j,2) = mod(iwx,4)/2
4892 freezr(i,j,2) = mod(iwx,8)/4
4898 iseed=44641*(int(sdat(1)-1)*24*31+int(sdat(2))*24+ihrst)+ &
4899 & mod(ifhr*60+ifmin,44641)+4357
4901 CALL calwxt_bourg_post(im,ista_2l,iend_2u,ista,iend,jm,jsta_2l,jend_2u,jsta,jend,lm,lp1,&
4902 & iseed,g,pthresh, &
4903 & t,q,pmid,pint,lmh,prec,zint,iwx1,me)
4913 snow(i,j,3) = mod(iwx,2)
4914 sleet(i,j,3) = mod(iwx,4)/2
4915 freezr(i,j,3) = mod(iwx,8)/4
4921 CALL calwxt_revised_post(t,q,pmid,pint,htm,lmh,prec,zint,iwx1)
4929 snow(i,j,4) = mod(iwx,2)
4930 sleet(i,j,4) = mod(iwx,4)/2
4931 freezr(i,j,4) = mod(iwx,8)/4
4938 IF(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)
then
4939 CALL calwxt_explicit_post(lmh,ths,pmid,prec,sr,f_rimef,iwx1)
4955 snow(i,j,5) = mod(iwx,2)
4956 sleet(i,j,5) = mod(iwx,4)/2
4957 freezr(i,j,5) = mod(iwx,8)/4
4962 allocate(domr(ista:iend,jsta:jend), doms(ista:iend,jsta:jend), &
4963 domzr(ista:iend,jsta:jend), domip(ista:iend,jsta:jend))
4964 CALL calwxt_dominant_post(prec(ista_2l,jsta_2l),rain,freezr,sleet,snow, &
4965 domr,domzr,domip,doms)
4972 if(prec(i,j) /= spval) grid1(i,j) = doms(i,j)
4975 if(grib==
'grib2')
then
4977 fld_info(cfld)%ifld=iavblfld(iget(551))
4983 datapd(i,j,cfld) = grid1(ii,jj)
4992 if(prec(i,j)/=spval) grid1(i,j) = domip(i,j)
4995 if(grib==
'grib2')
then
4997 fld_info(cfld)%ifld=iavblfld(iget(552))
5003 datapd(i,j,cfld) = grid1(ii,jj)
5018 if(prec(i,j)/=spval)grid1(i,j) = domzr(i,j)
5021 if(grib==
'grib2')
then
5023 fld_info(cfld)%ifld=iavblfld(iget(553))
5029 datapd(i,j,cfld) = grid1(ii,jj)
5038 if(prec(i,j)/=spval)grid1(i,j) = domr(i,j)
5041 if(grib==
'grib2')
then
5043 fld_info(cfld)%ifld=iavblfld(iget(160))
5049 datapd(i,j,cfld) = grid1(ii,jj)
5057 IF (iget(317)>0)
THEN
5059 if (.not.
allocated(sleet))
allocate(sleet(ista:iend,jsta:jend,nalg))
5060 if (.not.
allocated(rain))
allocate(rain(ista:iend,jsta:jend,nalg))
5061 if (.not.
allocated(freezr))
allocate(freezr(ista:iend,jsta:jend,nalg))
5062 if (.not.
allocated(snow))
allocate(snow(ista:iend,jsta:jend,nalg))
5063 if (.not.
allocated(zwet))
allocate(zwet(ista:iend,jsta:jend))
5064 CALL calwxt_post(t,q,pmid,pint,htm,lmh,avgprec,zint,iwx1,zwet)
5069 IF(zwet(i,j)<spval)
THEN
5071 snow(i,j,1) = mod(iwx,2)
5072 sleet(i,j,1) = mod(iwx,4)/2
5073 freezr(i,j,1) = mod(iwx,8)/4
5077 sleet(i,j,1) = spval
5078 freezr(i,j,1) = spval
5083 if (
allocated(zwet))
deallocate(zwet)
5093 CALL calwxt_ramer_post(t,q,pmid,pint,lmh,avgprec,iwx1)
5102 snow(i,j,2) = mod(iwx,2)
5103 sleet(i,j,2) = mod(iwx,4)/2
5104 freezr(i,j,2) = mod(iwx,8)/4
5110 iseed=44641*(int(sdat(1)-1)*24*31+int(sdat(2))*24+ihrst)+ &
5111 & mod(ifhr*60+ifmin,44641)+4357
5113 CALL calwxt_bourg_post(im,ista_2l,iend_2u,ista,iend,jm,jsta_2l,jend_2u,jsta,jend,lm,lp1,&
5114 & iseed,g,pthresh, &
5115 & t,q,pmid,pint,lmh,avgprec,zint,iwx1,me)
5125 snow(i,j,3) = mod(iwx,2)
5126 sleet(i,j,3) = mod(iwx,4)/2
5127 freezr(i,j,3) = mod(iwx,8)/4
5133 CALL calwxt_revised_post(t,q,pmid,pint,htm,lmh,avgprec,zint,iwx1)
5142 snow(i,j,4) = mod(iwx,2)
5143 sleet(i,j,4) = mod(iwx,4)/2
5144 freezr(i,j,4) = mod(iwx,8)/4
5152 IF(imp_physics == 5)
then
5153 CALL calwxt_explicit_post(lmh,ths,pmid,avgprec,sr,f_rimef,iwx1)
5169 snow(i,j,5) = mod(iwx,2)
5170 sleet(i,j,5) = mod(iwx,4)/2
5171 freezr(i,j,5) = mod(iwx,8)/4
5181 if (.not.
allocated(domr))
allocate(domr(ista:iend,jsta:jend))
5182 if (.not.
allocated(doms))
allocate(doms(ista:iend,jsta:jend))
5183 if (.not.
allocated(domzr))
allocate(domzr(ista:iend,jsta:jend))
5184 if (.not.
allocated(domip))
allocate(domip(ista:iend,jsta:jend))
5186 CALL calwxt_dominant_post(avgprec,rain,freezr,sleet,snow, &
5187 domr,domzr,domip,doms)
5190 itprec = nint(tprec)
5192 if (itprec /= 0)
then
5193 ifincr = mod(ifhr,itprec)
5194 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
5201 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5204 id(18) = ifhr-itprec
5206 id(18) = ifhr-ifincr
5207 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5218 if(avgprec(i,j) /= spval) grid1(i,j) = doms(i,j)
5222 if(grib==
'grib2')
then
5224 fld_info(cfld)%ifld=iavblfld(iget(555))
5226 fld_info(cfld)%ntrange=0
5228 fld_info(cfld)%ntrange=1
5230 fld_info(cfld)%tinvstat=ifhr-id(18)
5237 datapd(i,j,cfld) = grid1(ii,jj)
5243 itprec = nint(tprec)
5245 if (itprec /= 0)
then
5246 ifincr = mod(ifhr,itprec)
5247 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
5254 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5257 id(18) = ifhr-itprec
5259 id(18) = ifhr-ifincr
5260 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5266 if(avgprec(i,j)/=spval) grid1(i,j) = domip(i,j)
5269 if(grib==
'grib2')
then
5271 fld_info(cfld)%ifld=iavblfld(iget(556))
5273 fld_info(cfld)%ntrange=0
5275 fld_info(cfld)%ntrange=1
5277 fld_info(cfld)%tinvstat=ifhr-id(18)
5284 datapd(i,j,cfld) = grid1(ii,jj)
5291 itprec = nint(tprec)
5293 if (itprec /= 0)
then
5294 ifincr = mod(ifhr,itprec)
5295 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
5302 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5305 id(18) = ifhr-itprec
5307 id(18) = ifhr-ifincr
5308 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5320 if(avgprec(i,j)/=spval) grid1(i,j) = domzr(i,j)
5323 if(grib==
'grib2')
then
5325 fld_info(cfld)%ifld=iavblfld(iget(557))
5327 fld_info(cfld)%ntrange=0
5329 fld_info(cfld)%ntrange=1
5331 fld_info(cfld)%tinvstat=ifhr-id(18)
5338 datapd(i,j,cfld) = grid1(ii,jj)
5345 itprec = nint(tprec)
5347 if (itprec /= 0)
then
5348 ifincr = mod(ifhr,itprec)
5349 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
5357 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5360 id(18) = ifhr-itprec
5362 id(18) = ifhr-ifincr
5363 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5369 if(avgprec(i,j)/=spval) grid1(i,j) = domr(i,j)
5372 if(grib==
'grib2')
then
5374 fld_info(cfld)%ifld=iavblfld(iget(317))
5376 fld_info(cfld)%ntrange=0
5378 fld_info(cfld)%ntrange=1
5380 fld_info(cfld)%tinvstat=ifhr-id(18)
5387 datapd(i,j,cfld) = grid1(ii,jj)
5394 if (
allocated(rain))
deallocate(rain)
5395 if (
allocated(snow))
deallocate(snow)
5396 if (
allocated(sleet))
deallocate(sleet)
5397 if (
allocated(freezr))
deallocate(freezr)
5400 IF (iget(407)>0 .or. iget(559)>0 .or. &
5401 iget(560)>0 .or. iget(561)>0)
THEN
5403 if (.not.
allocated(domr))
allocate(domr(ista:iend,jsta:jend))
5404 if (.not.
allocated(doms))
allocate(doms(ista:iend,jsta:jend))
5405 if (.not.
allocated(domzr))
allocate(domzr(ista:iend,jsta:jend))
5406 if (.not.
allocated(domip))
allocate(domip(ista:iend,jsta:jend))
5418 IF (modelname .eq.
'FV3R')
THEN
5421 snow_bucket(i,j) = snow_bkt(i,j)
5422 rainnc_bucket(i,j) = 0.0
5432 IF (modelname .eq.
'FV3R')
THEN
5433 if(avgprec(i,j)/=spval)
then
5434 totprcp = (avgprec(i,j)*3600./dtq2)
5439 totprcp = (rainc_bucket(i,j) + rainnc_bucket(i,j))*1.e-3
5458 if (totprcp-graup_bucket(i,j)*1.e-3 > 0.0000001)
then
5464 IF(modelname ==
'FV3R')
THEN
5467 snowratio = snow_bucket(i,j)*1.e-3 / (totprcp-graup_bucket(i,j)*1.e-3)
5471 t2 = tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
5478 if( (snownc(i,j)/dt > 0.2e-9 .and. snowratio>=0.25 .and. snownc(i,j)/=spval) &
5480 (totprcp>0.00001.and.snowratio>=0.25))
then
5482 if (t2>=276.15)
then
5493 rainl = (1. - sr(i,j))*prec(i,j)/dt
5496 if((rainl > 2.8e-9 .and. snowratio<0.60) .or. &
5497 (totprcp>0.00001 .and. snowratio<0.60))
then
5499 if (t2>=273.15)
then
5514 if(graupelnc(i,j)/dt > 1.e-9 .and. graupelnc(i,j)/=spval)
then
5515 if (t2<=276.15)
then
5521 if (qrmax(i,j)>0.000005)
then
5522 if(graupelnc(i,j) > 0.5*snownc(i,j))
then
5531 if ((graupelnc(i,j)/dt) > rainl)
then
5538 else if (rainl > (4.*graupelnc(i,j)/dt))
then
5570 if (snow_bucket(i,j)*0.1<0.1*float(icat).and. &
5571 snow_bucket(i,j)*0.1>0.1*float(icat-1))
then
5572 cnt_snowratio(icat)=cnt_snowratio(icat)+1
5583 icnt_snow_rain_mixed = 0
5586 if (domr(i,j)==1 .and. doms(i,j)==1)
then
5587 icnt_snow_rain_mixed = icnt_snow_rain_mixed + 1
5600 grid1(i,j)=doms(i,j)
5603 if(grib==
'grib2')
then
5605 fld_info(cfld)%ifld=iavblfld(iget(559))
5611 datapd(i,j,cfld) = grid1(ii,jj)
5619 grid1(i,j) = domip(i,j)
5625 if(grib==
'grib2')
then
5627 fld_info(cfld)%ifld=iavblfld(iget(560))
5633 datapd(i,j,cfld) = grid1(ii,jj)
5645 grid1(i,j) = domzr(i,j)
5648 if(grib==
'grib2')
then
5650 fld_info(cfld)%ifld=iavblfld(iget(561))
5656 datapd(i,j,cfld) = grid1(ii,jj)
5664 grid1(i,j) = domr(i,j)
5667 if(grib==
'grib2')
then
5669 fld_info(cfld)%ifld=iavblfld(iget(407))
5675 datapd(i,j,cfld) = grid1(ii,jj)
5682 if (
allocated(psfc))
deallocate(psfc)
5683 if (
allocated(domr))
deallocate(domr)
5684 if (
allocated(doms))
deallocate(doms)
5685 if (
allocated(domzr))
deallocate(domzr)
5686 if (
allocated(domip))
deallocate(domip)
5692 IF (iget(042)>0)
THEN
5693 IF(modelname ==
'NCAR'.OR.modelname==
'RSM' .OR. &
5694 modelname==
'RAPR')
THEN
5705 IF(sfclhx(i,j)/=spval)
THEN
5706 grid1(i,j)=-1.*sfclhx(i,j)*rrnum
5708 grid1(i,j)=sfclhx(i,j)
5713 itsrfc = nint(tsrfc)
5714 IF(itsrfc /= 0)
then
5715 ifincr = mod(ifhr,itsrfc)
5716 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
5721 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5724 id(18) = ifhr-itsrfc
5726 id(18) = ifhr-ifincr
5727 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5729 IF (id(18)<0) id(18) = 0
5730 if(grib==
'grib2')
then
5732 fld_info(cfld)%ifld=iavblfld(iget(042))
5734 fld_info(cfld)%ntrange=1
5736 fld_info(cfld)%ntrange=0
5738 fld_info(cfld)%tinvstat=ifhr-id(18)
5739 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
5745 IF (iget(043)>0)
THEN
5746 IF(modelname ==
'NCAR'.OR.modelname==
'RSM' .OR. &
5747 modelname==
'RAPR')
THEN
5758 IF(sfcshx(i,j)/=spval)
THEN
5759 grid1(i,j) = -1.* sfcshx(i,j)*rrnum
5761 grid1(i,j)=sfcshx(i,j)
5766 itsrfc = nint(tsrfc)
5767 IF(itsrfc /= 0)
then
5768 ifincr = mod(ifhr,itsrfc)
5769 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
5774 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5777 id(18) = ifhr-itsrfc
5779 id(18) = ifhr-ifincr
5780 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5782 IF (id(18)<0) id(18) = 0
5784 if(grib==
'grib2')
then
5786 fld_info(cfld)%ifld=iavblfld(iget(043))
5788 fld_info(cfld)%ntrange=1
5790 fld_info(cfld)%ntrange=0
5792 fld_info(cfld)%tinvstat=ifhr-id(18)
5793 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
5798 IF (iget(135)>0)
THEN
5799 IF(modelname ==
'NCAR'.OR.modelname==
'RSM' .OR. &
5800 modelname==
'RAPR')
THEN
5812 if(subshx(i,j)/=spval) grid1(i,j) = subshx(i,j)*rrnum
5816 itsrfc = nint(tsrfc)
5817 IF(itsrfc /= 0)
then
5818 ifincr = mod(ifhr,itsrfc)
5819 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
5824 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5827 id(18) = ifhr-itsrfc
5829 id(18) = ifhr-ifincr
5830 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5832 IF (id(18)<0) id(18) = 0
5834 if(grib==
'grib2')
then
5836 fld_info(cfld)%ifld=iavblfld(iget(135))
5838 fld_info(cfld)%ntrange=1
5840 fld_info(cfld)%ntrange=0
5842 fld_info(cfld)%tinvstat=ifhr-id(18)
5843 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
5848 IF (iget(136)>0)
THEN
5849 IF(modelname ==
'NCAR'.OR.modelname==
'RSM' .OR. &
5850 modelname==
'RAPR')
THEN
5862 if(snopcx(i,j)/=spval) grid1(i,j) = snopcx(i,j)*rrnum
5866 itsrfc = nint(tsrfc)
5867 IF(itsrfc /= 0)
then
5868 ifincr = mod(ifhr,itsrfc)
5869 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
5874 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5877 id(18) = ifhr-itsrfc
5879 id(18) = ifhr-ifincr
5880 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5882 IF (id(18)<0) id(18) = 0
5884 if(grib==
'grib2')
then
5886 fld_info(cfld)%ifld=iavblfld(iget(136))
5888 fld_info(cfld)%ntrange=1
5890 fld_info(cfld)%ntrange=0
5892 fld_info(cfld)%tinvstat=ifhr-id(18)
5893 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
5898 IF (iget(046)>0)
THEN
5899 IF(modelname ==
'NCAR'.OR.modelname==
'RSM' .OR. &
5900 modelname==
'RAPR')
THEN
5911 IF(sfcuvx(i,j)/=spval)
THEN
5912 grid1(i,j) = sfcuvx(i,j)*rrnum
5914 grid1(i,j) = sfcuvx(i,j)
5919 itsrfc = nint(tsrfc)
5920 IF(itsrfc /= 0)
then
5921 ifincr = mod(ifhr,itsrfc)
5922 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
5927 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5930 id(18) = ifhr-itsrfc
5932 id(18) = ifhr-ifincr
5933 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5935 IF (id(18)<0) id(18) = 0
5937 if(grib==
'grib2')
then
5939 fld_info(cfld)%ifld=iavblfld(iget(046))
5941 fld_info(cfld)%ntrange=1
5943 fld_info(cfld)%ntrange=0
5945 fld_info(cfld)%tinvstat=ifhr-id(18)
5946 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
5951 IF (iget(269)>0)
THEN
5952 IF(modelname ==
'NCAR'.OR.modelname==
'RSM' .OR. &
5953 modelname==
'RAPR')
THEN
5965 if(sfcux(i,j)/=spval) grid1(i,j) = sfcux(i,j)*rrnum
5969 itsrfc = nint(tsrfc)
5970 IF(itsrfc /= 0)
then
5971 ifincr = mod(ifhr,itsrfc)
5972 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
5977 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
5980 id(18) = ifhr-itsrfc
5982 id(18) = ifhr-ifincr
5983 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
5985 IF (id(18)<0) id(18) = 0
5987 if(grib==
'grib2')
then
5989 fld_info(cfld)%ifld=iavblfld(iget(269))
5991 fld_info(cfld)%ntrange=1
5993 fld_info(cfld)%ntrange=0
5995 fld_info(cfld)%tinvstat=ifhr-id(18)
5996 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6001 IF (iget(270)>0)
THEN
6002 IF(modelname ==
'NCAR'.OR.modelname==
'RSM' .OR. &
6003 modelname==
'RAPR')
THEN
6015 if(sfcvx(i,j)/=spval) grid1(i,j) = sfcvx(i,j)*rrnum
6019 itsrfc = nint(tsrfc)
6020 IF(itsrfc /= 0)
then
6021 ifincr = mod(ifhr,itsrfc)
6022 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
6027 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
6030 id(18) = ifhr-itsrfc
6032 id(18) = ifhr-ifincr
6033 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
6035 IF (id(18)<0) id(18) = 0
6037 if(grib==
'grib2')
then
6039 fld_info(cfld)%ifld=iavblfld(iget(270))
6041 fld_info(cfld)%ntrange=1
6043 fld_info(cfld)%ntrange=0
6045 fld_info(cfld)%tinvstat=ifhr-id(18)
6046 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6051 IF (iget(047)>0)
THEN
6055 if(sfcevp(i,j)/=spval) grid1(i,j) = sfcevp(i,j)*1000.
6059 itprec = nint(tprec)
6061 if (itprec /= 0)
then
6062 ifincr = mod(ifhr,itprec)
6063 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
6070 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
6073 id(18) = ifhr-itprec
6075 id(18) = ifhr-ifincr
6076 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
6078 IF (id(18)<0) id(18) = 0
6079 if(grib==
'grib2')
then
6081 fld_info(cfld)%ifld=iavblfld(iget(047))
6083 fld_info(cfld)%ntrange=1
6085 fld_info(cfld)%ntrange=0
6087 fld_info(cfld)%tinvstat=ifhr-id(18)
6088 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6094 IF (iget(137)>0)
THEN
6098 if(potevp(i,j)/=spval) grid1(i,j) = potevp(i,j)*1000.
6102 itprec = nint(tprec)
6104 if (itprec /= 0)
then
6105 ifincr = mod(ifhr,itprec)
6106 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itprec*60)
6113 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
6116 id(18) = ifhr-itprec
6118 id(18) = ifhr-ifincr
6119 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
6121 IF (id(18)<0) id(18) = 0
6122 if(grib==
'grib2')
then
6124 fld_info(cfld)%ifld=iavblfld(iget(137))
6126 fld_info(cfld)%ntrange=1
6128 fld_info(cfld)%ntrange=0
6130 fld_info(cfld)%tinvstat=ifhr-id(18)
6131 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6136 IF (iget(044)>0)
THEN
6139 grid1(i,j) = z0(i,j)
6142 if(grib==
'grib2')
then
6144 fld_info(cfld)%ifld=iavblfld(iget(044))
6145 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6150 IF (iget(045)>0)
THEN
6153 grid1(i,j) = ustar(i,j)
6156 if(grib==
'grib2')
then
6158 fld_info(cfld)%ifld=iavblfld(iget(045))
6159 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6165 IF (iget(132)>0)
THEN
6167 CALL caldrg(egrid1(ista_2l:iend_2u,jsta_2l:jend_2u))
6170 IF(ustar(i,j) < spval) grid1(i,j)=egrid1(i,j)
6173 if(grib==
'grib2')
then
6175 fld_info(cfld)%ifld=iavblfld(iget(132))
6176 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6180 write_cd:
IF(iget(924)>0)
THEN
6183 grid1(i,j)=cd10(i,j)
6186 if(grib==
'grib2')
then
6188 fld_info(cfld)%ifld=iavblfld(iget(924))
6189 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6192 write_ch:
IF(iget(923)>0)
THEN
6195 grid1(i,j)=ch10(i,j)
6198 if(grib==
'grib2')
then
6200 fld_info(cfld)%ifld=iavblfld(iget(923))
6201 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6206 IF ( (iget(900)>0) .OR. (iget(901)>0) )
THEN
6209 IF (iget(900)>0)
THEN
6212 grid1(i,j)=mdltaux(i,j)
6215 if(grib==
'grib2')
then
6217 fld_info(cfld)%ifld=iavblfld(iget(900))
6218 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6224 IF (iget(901)>0)
THEN
6227 grid1(i,j)=mdltauy(i,j)
6230 if(grib==
'grib2')
then
6232 fld_info(cfld)%ifld=iavblfld(iget(901))
6233 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6239 IF ( (iget(133)>0) .OR. (iget(134)>0) )
THEN
6242 IF(modelname /=
'FV3R') &
6243 CALL caltau(egrid1(ista:iend,jsta:jend),egrid2(ista:iend,jsta:jend))
6247 IF (iget(133)>0)
THEN
6250 IF(modelname ==
'FV3R')
THEN
6251 grid1(i,j)=sfcuxi(i,j)
6253 grid1(i,j)=egrid1(i,j)
6258 if(grib==
'grib2')
then
6260 fld_info(cfld)%ifld=iavblfld(iget(133))
6261 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6266 IF (iget(134)>0)
THEN
6269 IF(modelname ==
'FV3R')
THEN
6270 grid1(i,j)=sfcvxi(i,j)
6272 grid1(i,j)=egrid2(i,j)
6276 if(grib==
'grib2')
then
6278 fld_info(cfld)%ifld=iavblfld(iget(134))
6279 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6285 IF ( (iget(315)>0) .OR. (iget(316)>0) )
THEN
6288 IF (iget(315)>0)
THEN
6291 grid1(i,j) = gtaux(i,j)
6295 itsrfc = nint(tsrfc)
6296 IF(itsrfc /= 0)
then
6297 ifincr = mod(ifhr,itsrfc)
6298 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
6303 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
6306 id(18) = ifhr-itsrfc
6308 id(18) = ifhr-ifincr
6309 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
6311 IF (id(18)<0) id(18) = 0
6312 if(grib==
'grib2')
then
6314 fld_info(cfld)%ifld=iavblfld(iget(315))
6316 fld_info(cfld)%ntrange=0
6318 fld_info(cfld)%ntrange=1
6320 fld_info(cfld)%tinvstat=ifhr-id(18)
6321 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6326 IF (iget(316)>0)
THEN
6329 grid1(i,j)=gtauy(i,j)
6333 itsrfc = nint(tsrfc)
6334 IF(itsrfc /= 0)
then
6335 ifincr = mod(ifhr,itsrfc)
6336 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
6341 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
6344 id(18) = ifhr-itsrfc
6346 id(18) = ifhr-ifincr
6347 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
6349 IF (id(18)<0) id(18) = 0
6350 if(grib==
'grib2')
then
6352 fld_info(cfld)%ifld=iavblfld(iget(316))
6354 fld_info(cfld)%ntrange=0
6356 fld_info(cfld)%ntrange=1
6358 fld_info(cfld)%tinvstat=ifhr-id(18)
6359 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6365 IF (iget(154)>0)
THEN
6368 IF(modelname==
'NCAR'.OR.modelname==
'RSM' .OR. &
6369 modelname==
'RAPR')
THEN
6373 grid1(i,j) = twbs(i,j)
6380 IF(twbs(i,j) < spval) grid1(i,j) = -twbs(i,j)
6384 if(grib==
'grib2')
then
6386 fld_info(cfld)%ifld=iavblfld(iget(154))
6387 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6392 IF (iget(155)>0)
THEN
6395 IF(modelname==
'NCAR'.OR.modelname==
'RSM' .OR. &
6396 modelname==
'RAPR')
THEN
6400 grid1(i,j) = qwbs(i,j)
6407 IF(qwbs(i,j) < spval) grid1(i,j) = -qwbs(i,j)
6411 if(grib==
'grib2')
then
6413 fld_info(cfld)%ifld=iavblfld(iget(155))
6414 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6419 IF (iget(169)>0)
THEN
6422 grid1(i,j)=sfcexc(i,j)
6425 if(grib==
'grib2')
then
6427 fld_info(cfld)%ifld=iavblfld(iget(169))
6428 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6433 IF (iget(170)>0)
THEN
6437 if(vegfrc(i,j)/=spval) grid1(i,j)=vegfrc(i,j)*100.
6440 if(grib==
'grib2')
then
6442 fld_info(cfld)%ifld=iavblfld(iget(170))
6443 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6449 IF (iget(726)>0)
THEN
6453 if(shdmin(i,j)/=spval) grid1(i,j)=shdmin(i,j)*100.
6456 if(grib==
'grib2')
then
6458 fld_info(cfld)%ifld=iavblfld(iget(726))
6459 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6464 IF (iget(729)>0)
THEN
6468 if(shdmax(i,j)/=spval) grid1(i,j)=shdmax(i,j)*100.
6471 if(grib==
'grib2')
then
6473 fld_info(cfld)%ifld=iavblfld(iget(729))
6474 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6479 IF (modelname ==
'NCAR'.OR.modelname==
'NMM' .OR. &
6480 modelname ==
'FV3R' .OR. modelname==
'RAPR')
THEN
6481 IF (isf_surface_physics == 2 .OR. modelname==
'FV3R' .OR. modelname==
'RAPR')
THEN
6482 IF (iget(254)>0)
THEN
6483 if (me==0)print*,
'starting LAI'
6486 IF (modelname==
'RAPR')
THEN
6488 ELSE IF (modelname==
'FV3R')
THEN
6489 grid1(i,j)=xlaixy(i,j)
6495 if(grib==
'grib2')
then
6497 fld_info(cfld)%ifld=iavblfld(iget(254))
6498 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6505 IF (iget(152)>0)
THEN
6508 grid1(i,j)=grnflx(i,j)
6511 if(grib==
'grib2')
then
6513 fld_info(cfld)%ifld=iavblfld(iget(152))
6514 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6518 IF (iget(218)>0)
THEN
6521 grid1(i,j) = float(ivgtyp(i,j))
6524 if(grib==
'grib2')
then
6526 fld_info(cfld)%ifld=iavblfld(iget(218))
6527 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6532 IF (iget(219)>0)
THEN
6535 grid1(i,j) = float(isltyp(i,j))
6538 if(grib==
'grib2')
then
6540 fld_info(cfld)%ifld=iavblfld(iget(219))
6541 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6545 IF (iget(223)>0)
THEN
6548 grid1(i,j) = float(islope(i,j))
6551 if(grib==
'grib2')
then
6553 fld_info(cfld)%ifld=iavblfld(iget(223))
6554 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6561 IF (modelname ==
'NCAR'.OR.modelname==
'NMM' .OR. &
6562 modelname ==
'FV3R' .OR. modelname==
'RAPR')
THEN
6563 IF (iget(220)>0 .OR. iget(234)>0 &
6564 & .OR. iget(235)>0 .OR. iget(236)>0 &
6565 & .OR. iget(237)>0 .OR. iget(238)>0 &
6566 & .OR. iget(239)>0 .OR. iget(240)>0 &
6567 & .OR. iget(241)>0 )
THEN
6568 IF (isf_surface_physics == 2 .OR. isf_surface_physics == 3)
THEN
6570 allocate(rsmin(ista:iend,jsta:jend), smcref(ista:iend,jsta:jend), gc(ista:iend,jsta:jend), &
6571 rcq(ista:iend,jsta:jend), rct(ista:iend,jsta:jend), rcsoil(ista:iend,jsta:jend), rcs(ista:iend,jsta:jend))
6574 IF( (abs(sm(i,j)-0.) < 1.0e-5) .AND. &
6575 & (abs(sice(i,j)-0.) < 1.0e-5) )
THEN
6576 IF(czmean(i,j)>1.e-6)
THEN
6577 factrs = czen(i,j)/czmean(i,j)
6582 llmh = nint(lmh(i,j))
6583 solar = rswin(i,j)*factrs
6584 sfctmp = t(i,j,llmh)
6586 sfcprs = pint(i,j,llmh+1)
6594 CALL canres(solar,sfctmp,sfcq,sfcprs &
6595 & ,sh2o(i,j,1:nsoil),gc(i,j),rc,ivg,isltyp(i,j) &
6596 & ,rsmin(i,j),nroots(i,j),smcwlt(i,j),smcref(i,j) &
6597 & ,rcs(i,j),rcq(i,j),rct(i,j),rcsoil(i,j),sldpth)
6598 IF(abs(smcwlt(i,j)-0.5)<1.e-5)print*, &
6599 &
'LARGE SMCWLT',i,j,sm(i,j),isltyp(i,j),smcwlt(i,j)
6614 IF (iget(220)>0 )
THEN
6617 grid1(i,j) = gc(i,j)
6620 if(grib==
'grib2')
then
6622 fld_info(cfld)%ifld=iavblfld(iget(220))
6623 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6627 IF (iget(234)>0 )
THEN
6630 grid1(i,j) = rsmin(i,j)
6633 if(grib==
'grib2')
then
6635 fld_info(cfld)%ifld=iavblfld(iget(234))
6636 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6640 IF (iget(235)>0 )
THEN
6643 grid1(i,j) = float(nroots(i,j))
6646 if(grib==
'grib2')
then
6648 fld_info(cfld)%ifld=iavblfld(iget(235))
6649 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6653 IF (iget(236)>0 )
THEN
6656 grid1(i,j) = smcwlt(i,j)
6659 if(grib==
'grib2')
then
6661 fld_info(cfld)%ifld=iavblfld(iget(236))
6662 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6666 IF (iget(237)>0 )
THEN
6669 grid1(i,j) = smcref(i,j)
6672 if(grib==
'grib2')
then
6674 fld_info(cfld)%ifld=iavblfld(iget(237))
6675 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6679 IF (iget(238)>0 )
THEN
6682 grid1(i,j) = rcs(i,j)
6685 if(grib==
'grib2')
then
6687 fld_info(cfld)%ifld=iavblfld(iget(238))
6688 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6692 IF (iget(239)>0 )
THEN
6695 grid1(i,j) = rct(i,j)
6698 if(grib==
'grib2')
then
6700 fld_info(cfld)%ifld=iavblfld(iget(239))
6701 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6705 IF (iget(240)>0 )
THEN
6708 grid1(i,j) = rcq(i,j)
6711 if(grib==
'grib2')
then
6713 fld_info(cfld)%ifld=iavblfld(iget(240))
6714 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6718 IF (iget(241)>0 )
THEN
6721 grid1(i,j) = rcsoil(i,j)
6724 if(grib==
'grib2')
then
6726 fld_info(cfld)%ifld=iavblfld(iget(241))
6727 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6731 if (
allocated(rsmin))
deallocate(rsmin)
6732 if (
allocated(smcref))
deallocate(smcref)
6733 if (
allocated(rcq))
deallocate(rcq)
6734 if (
allocated(rct))
deallocate(rct)
6735 if (
allocated(rcsoil))
deallocate(rcsoil)
6736 if (
allocated(rcs))
deallocate(rcs)
6737 if (
allocated(gc))
deallocate(gc)
6744 IF(modelname ==
'GFS')
THEN
6750 grid1(i,j) = smcwlt(i,j)
6758 if(grib==
'grib2')
then
6760 fld_info(cfld)%ifld=iavblfld(iget(236))
6766 datapd(i,j,cfld) = grid1(ii,jj)
6776 grid1(i,j) = fieldcapa(i,j)
6784 if(grib==
'grib2')
then
6786 fld_info(cfld)%ifld=iavblfld(iget(397))
6792 datapd(i,j,cfld) = grid1(ii,jj)
6802 grid1(i,j) = suntime(i,j)
6806 itsrfc = nint(tsrfc)
6807 IF(itsrfc /= 0)
then
6808 ifincr = mod(ifhr,itsrfc)
6809 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
6814 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
6817 id(18) = ifhr-itsrfc
6819 id(18) = ifhr-ifincr
6820 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
6822 IF (id(18)<0) id(18) = 0
6823 if(grib==
'grib2')
then
6825 fld_info(cfld)%ifld=iavblfld(iget(396))
6827 fld_info(cfld)%ntrange=1
6829 fld_info(cfld)%ntrange=0
6831 fld_info(cfld)%tinvstat=ifhr-id(18)
6837 datapd(i,j,cfld) = grid1(ii,jj)
6847 grid1(i,j) = avgpotevp(i,j)
6851 itsrfc = nint(tsrfc)
6852 IF(itsrfc /= 0)
then
6853 ifincr = mod(ifhr,itsrfc)
6854 IF(ifmin >= 1)ifincr= mod(ifhr*60+ifmin,itsrfc*60)
6859 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
6862 id(18) = ifhr-itsrfc
6864 id(18) = ifhr-ifincr
6865 IF(ifmin >= 1)id(18)=ifhr*60+ifmin-ifincr
6867 IF (id(18)<0) id(18) = 0
6868 if(grib==
'grib2')
then
6870 fld_info(cfld)%ifld=iavblfld(iget(517))
6872 fld_info(cfld)%ntrange=1
6874 fld_info(cfld)%ntrange=0
6876 fld_info(cfld)%tinvstat=ifhr-id(18)
6882 datapd(i,j,cfld) = grid1(ii,jj)
6891 IF (iget(282)>0)
THEN
6898 if(grib==
'grib2')
then
6900 fld_info(cfld)%ifld=iavblfld(iget(282))
6901 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6906 IF (iget(283)>0)
THEN
6915 IF(pmid(1,1,l)>=(pdtop+pt))
EXIT
6919 CALL mpi_bcast(l,1,mpi_integer,0,mpi_comm_comp,irtn)
6920 if(grib==
'grib2')
then
6922 fld_info(cfld)%ifld=iavblfld(iget(283))
6923 fld_info(cfld)%lvl1=1
6924 fld_info(cfld)%lvl2=l
6925 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6930 IF (iget(273)>0)
THEN
6939 IF((pint(1,1,lm+1)-pd(1,1))<=(pint(1,1,l)+1.00))
EXIT
6943 CALL mpi_bcast(l,1,mpi_integer,0,mpi_comm_comp,irtn)
6944 if(grib==
'grib2')
then
6946 fld_info(cfld)%ifld=iavblfld(iget(273))
6947 fld_info(cfld)%lvl1=l
6948 fld_info(cfld)%lvl2=lm+1
6949 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6955 IF (iget(503)>0)
THEN
6958 grid1(i,j)=akhsavg(i,j)
6970 itsrfc = nint(tsrfc)
6971 if(grib==
'grib2')
then
6973 fld_info(cfld)%ifld=iavblfld(iget(503))
6975 fld_info(cfld)%ntrange=1
6977 fld_info(cfld)%ntrange=0
6979 fld_info(cfld)%tinvstat=ifhr-id(18)
6980 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
6985 IF (iget(504)>0)
THEN
6988 grid1(i,j)=akmsavg(i,j)
7000 itsrfc = nint(tsrfc)
7001 if(grib==
'grib2')
then
7003 fld_info(cfld)%ifld=iavblfld(iget(504))
7005 fld_info(cfld)%ntrange=1
7007 fld_info(cfld)%ntrange=0
7009 fld_info(cfld)%tinvstat=ifhr-id(18)
7010 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)