102 use vrbls4d,
only: dust, salt, suso, waso, soot, no3, nh4, smoke, fv3dust,&
104 use vrbls3d,
only: zmid, t, pmid, q, cwm, f_ice, f_rain, f_rimef, qqw, qqi,&
105 qqr, qqs, cfr, cfr_raw, dbz, dbzr, dbzi, dbzc, qqw, nlice, nrain, qqg, qqh, zint,&
106 qqni, qqnr, qqnw, qqnwfa, qqnifa, uh, vh, mcvg, omga, wh, q2, ttnd, rswtt, &
107 rlwtt, train, tcucn, o3, rhomid, dpres, el_pbl, pint, icing_gfip, icing_gfis, &
108 catedr,mwt,gtg,cit, ref_10cm, avgpmtf, avgozcon
110 use vrbls2d,
only: slp, hbot, htop, cnvcfr, cprate, cnvcfr, sfcshx,sfclhx,ustar,z0,&
111 sr, prec, vis, czen, pblh, pblhgust, u10, v10, avgprec, avgcprate, &
112 ref1km_10cm,ref4km_10cm,refc_10cm,refd_max
113 use masks,
only: lmh, gdlat, gdlon,sm,sice,dx,dy
114 use params_mod,
only: rd, gi, g, rog, h1, tfrz, d00, dbzmin, d608, small,&
115 h100, h1m12, h99999,pi,erad
116 use pmicrph_mod,
only: r1, const1r, qr0, delqr0, const2r, ron, topr, son,&
117 tops, dsnow, drain,const_ng1, const_ng2, gon, topg, dgraupel
118 use ctlblk_mod,
only: jsta_2l, jend_2u, lm, jsta, jend, grib, cfld, datapd,&
119 fld_info, modelname, imp_physics, dtq2, spval, icount_calmict,&
120 me, dt, avrain, theat, ifhr, ifmin, avcnvc, lp1, im, jm, &
121 ista, iend, ista_2l, iend_2u, aqf_on, gocart_on, gccpp_on, nasa_on, gtg_on
122 use rqstfld_mod,
only: iget, id, lvls, iavblfld, lvlsxml
123 use gridspec_mod,
only: gridtype,maptype,dxval
124 use upp_physics,
only: calrh, calcape, calvor
125 use upp_math,
only: h2u, h2v, u2h, v2h
131 REAL,
PARAMETER :: CURATE=24.*1000., ctim1=0., ctim2=24.*3600. &
132 &, raincon=0.8333*1.1787e4, snocon=0.94*1.4594e5 &
137 &, dbzmax=80., zr_a=300., zr_b=1.4
142 DATA cc / 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0 /
143 DATA ppt/ 0., .14, .31, .70, 1.6, 3.4, 7.7, 17., 38., 85. /
144 INTEGER,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: ICBOT, ICTOP, LPBL
152 real,
dimension(im,jm) :: GRID1, GRID2
153 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: EGRID1, EGRID2, EGRID3, EGRID4, EGRID5,&
154 el0, p1d, t1d, q1d, c1d, &
155 fi1d, fr1d, fs1d, qw1, qi1, &
156 qr1, qs1, curefl_s, &
157 curefl, curefl_i, zfrz, dbz1, dbzr1, &
158 dbzi1, dbzc1, egrid6, egrid7, nlice1, &
159 qi, qint, tt, ppp, qv, &
160 qcd, qice1, qrain1, qsno1, refl, &
161 qg1, refl1km, refl4km, rh, gust, nrain1,zm10c, &
165 REAL,
ALLOCATABLE :: EL(:,:,:),RICHNO(:,:,:) ,PBLRI(:,:), PBLREGIME(:,:)
167 integer I,J,L,Lctop,LLMH,IICE,LL,II,JJ,IFINCR,ITHEAT,NC,NMOD,LLL &
168 ,iz1km,iz4km, lcount, hcount, itype, item
170 real RDTPHS,CFRdum,PMOD,CC1,CC2,P1,P2,CUPRATE,FACR,RRNUM &
171 ,rainrate,term1,term2,term3,qrold,snorate,dens,delz,fctr,hgt &
172 ,rain,ronv,slor,snow,rhoqs,temp_c,sonv,slos &
173 ,graupel,rhoqg,gonv,slog, alpha, rhod, bb &
174 ,ze_s, ze_r, ze_g, ze_max, ze_nc, ze_conv, ze_sum &
175 ,ze_smax, ze_rmax,ze_gmax, ze_nc_1km, ze_nc_4km, dz &
176 ,lapses, expo,expinv,tsfcnew, gam,gamd,gams, pblhold &
177 ,psfc,tsfc,zsfc,dp,dpbnd,zmin
179 real,
allocatable :: RH3D(:,:,:)
183 REAL SDUMMY(IM,2),dxm
185 real,
dimension(ista:iend,jsta:jend) :: dummy, cape, cin
186 integer idummy(ista:iend,jsta:jend)
188 real,
PARAMETER :: ZSL=0.0, taucr=rd*gi*290.66, const=0.005*g/rd, gord=g/rd
189 logical,
parameter :: debugprint = .false.
198 zmin=10.**(0.1*dbzmin)
216 model_radar = .false.
221 IF(abs(ref_10cm(i,j,l)-spval)>small)
THEN
228 if(debugprint .and. me==0)print*,
'Did post read in model derived radar ref ',model_radar, &
229 'MODELNAME=',trim(modelname),
' imp_physics=',imp_physics
230 ALLOCATE(el(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
231 ALLOCATE(richno(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
232 ALLOCATE(pblri(ista_2l:iend_2u,jsta_2l:jend_2u))
235 IF (iget(023) > 0 .OR. iget(105) > 0 .OR. iget(445) > 0)
THEN
238 IF (iget(105) > 0)
THEN
242 grid1(i,j) = slp(i,j)
245 if(grib==
"grib2")
then
247 fld_info(cfld)%ifld=iavblfld(iget(105))
253 datapd(i,j,cfld) = grid1(ii,jj)
263 IF (modelname==
'NMM' .OR. imp_physics==5 .or. &
264 imp_physics==85 .or. imp_physics==95)
THEN
266 rdtphs=24.*3.6e6/dtq2
269 IF ((hbot(i,j)-htop(i,j)) <= 1.0)
THEN
274 icbot(i,j)=nint(hbot(i,j))
275 ictop(i,j)=nint(htop(i,j))
277 pmod=rdtphs*cprate(i,j)
278 IF (pmod > ppt(1))
THEN
280 IF(pmod>ppt(nc)) nmod=nc
289 cfrdum=cc1+(cc2-cc1)*(pmod-p1)/(p2-p1)
291 cfrdum=min(h1, cfrdum)
301 IF (modelname==
'NMM' .AND. imp_physics==9)
THEN
310 IF(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95 &
311 .or. nmm_gfsmicro)
THEN
315 cuprate=rdtphs*cprate(i,j)
317 zfrz(i,j)=zmid(i,j,nint(lmh(i,j)))
318 DO l=1,nint(lmh(i,j))
319 IF (t(i,j,l) >= tfrz)
THEN
320 zfrz(i,j)=zmid(i,j,l)
325 IF (cuprate <= 0. .or. htop(i,j)>=spval)
THEN
329 curefl_s(i,j)=zr_a*cuprate**zr_b
330 lctop=nint(htop(i,j))
337 curefl_i(i,j)=-2./max( 1000., zmid(i,j,lctop)-zfrz(i,j) )
347 if(icount_calmict==0)
then
355 fi1d(i,j)=f_ice(i,j,l)
356 fr1d(i,j)=f_rain(i,j,l)
357 fs1d(i,j)=max(h1, f_rimef(i,j,l))
362 IF (curefl_s(i,j) > 0.)
THEN
364 llmh = nint(lmh(i,j))
365 lctop=nint(htop(i,j))
366 IF (l>=lctop .AND. l<=llmh)
THEN
367 delz=zmid(i,j,l)-zfrz(i,j)
374 fctr=10.**(curefl_i(i,j)*delz)
377 curefl(i,j)=fctr*curefl_s(i,j)
382 IF(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)
THEN
383 fer_mic:
IF (imp_physics==5)
THEN
392 CALL calmict_new(p1d,t1d,q1d,c1d,fi1d,fr1d,fs1d,curefl &
393 & ,qw1,qi1,qr1,qs1,dbz1,dbzr1,dbzi1,dbzc1,nlice1, nrain1)
394 IF(modelname ==
'NMM' .and. gridtype==
'B')
THEN
400refl_miss:
IF (model_radar)
THEN
404 IF(p1d(i,j)<spval.and.t1d(i,j)<spval.and.q1d(i,j)<spval)
THEN
405 ze_nc=10.**(0.1*ref_10cm(i,j,l))
406 dbz1(i,j)=10.*log10(max(zmin,(ze_nc+curefl(i,j))))
407 dbzr1(i,j)=min(dbzr1(i,j), ref_10cm(i,j,l))
408 dbzi1(i,j)=min(dbzi1(i,j), ref_10cm(i,j,l))
409 ze_max=max(dbzr1(i,j),dbzi1(i,j))
410refl_comp:
IF(ref_10cm(i,j,l)>dbzmin .OR. ze_max>dbzmin)
THEN
411refl_adj:
IF(ref_10cm(i,j,l)<=dbzmin)
THEN
414 ELSE IF(ze_max<=dbzmin)
THEN
415 IF(qr1(i,j)>qs1(i,j))
THEN
416 dbzr1(i,j)=ref_10cm(i,j,l)
417 ELSE IF(qs1(i,j)>qr1(i,j))
THEN
418 dbzi1(i,j)=ref_10cm(i,j,l)
420 IF(t1d(i,j)>=tfrz)
THEN
421 dbzr1(i,j)=ref_10cm(i,j,l)
423 dbzi1(i,j)=ref_10cm(i,j,l)
427 ze_nc=10.**(0.1*ref_10cm(i,j,l))
428 ze_r=10.**(0.1*dbzr1(i,j))
429 ze_s=10.**(0.1*dbzi1(i,j))
434 dbzr1(i,j)=10.*log10(ze_r)
435 dbzi1(i,j)=10.*log10(ze_s)
446 IF (me==0 .AND. l==1)
THEN
447 WRITE(6,
'(4A,1x,F7.2)')
'WARNING - MDLFLD: REF_10CM NOT ', &
448 'IN NMMB OUTPUT. CHECK ', &
449 'SOLVER_STATE.TXT FILE. USING ', &
450 'REFL OUTPUT FROM CALMICT.'
461 CALL calmict_old(p1d,t1d,q1d,c1d,fi1d,fr1d,fs1d,curefl &
462 & ,qw1,qi1,qr1,qs1,dbz1,dbzr1,dbzi1,dbzc1,nlice1, nrain1)
471 IF(c1d(i,j)<spval.and.fi1d(i,j)<spval)
THEN
472 qi1(i,j)=c1d(i,j)*fi1d(i,j)
473 qw1(i,j)=c1d(i,j)-qi1(i,j)
489 llmh = nint(lmh(i,j))
501 qqw(i,j,l) = max(d00, qw1(i,j))
502 qqi(i,j,l) = max(d00, qi1(i,j))
503 qqr(i,j,l) = max(d00, qr1(i,j))
504 qqs(i,j,l) = max(d00, qs1(i,j))
505 dbz(i,j,l) = max(dbzmin, dbz1(i,j))
506 dbzr(i,j,l) = max(dbzmin, dbzr1(i,j))
507 dbzi(i,j,l) = max(dbzmin, dbzi1(i,j))
508 dbzc(i,j,l) = max(dbzmin, dbzc1(i,j))
509 nlice(i,j,l) = max(d00, nlice1(i,j))
510 nrain(i,j,l) = max(d00, nrain1(i,j))
517 icount_calmict=icount_calmict+1
518 if(debugprint .and. me==0)print*,
'debug calmict:icount_calmict= ',icount_calmict
527 ELSE IF(modelname ==
'NMM' .and. gridtype==
'B' .and. imp_physics==99)
THEN
531 llmh = nint(lmh(i,j))
543 qqi(i,j,l) = max(d00, cwm(i,j,l)*f_ice(i,j,l))
544 qqw(i,j,l) = max(d00, cwm(i,j,l)-qqi(i,j,l))
555 ELSE IF(modelname ==
'NMM' .and. gridtype==
'B' .and. imp_physics==6)
THEN
559 llmh = nint(lmh(i,j))
572 qqw(i,j,l)=max(d00, (1.-f_ice(i,j,l))*cwm(i,j,l)*(1.-f_rain(i,j,l)))
573 qqr(i,j,l)=max(d00,(1.-f_ice(i,j,l))*cwm(i,j,l)*f_rain(i,j,l))
574 qqs(i,j,l)=max(d00, cwm(i,j,l)*f_ice(i,j,l))
575 dens=pmid(i,j,l)/(rd*t(i,j,l)*(q(i,j,l)*d608+1.0))
576 dbzr(i,j,l)=((qqr(i,j,l)*dens)**1.75)* &
577 & 3.630803e-9 * 1.e18
578 dbzi(i,j,l)= dbzi(i,j,l)+((qqs(i,j,l)*dens)**1.75)* &
579 & 2.18500e-10 * 1.e18
580 dbz(i,j,l)=dbzr(i,j,l)+dbzi(i,j,l)
581 IF (dbz(i,j,l)>0.) dbz(i,j,l)=10.0*log10(dbz(i,j,l))
582 IF (dbzr(i,j,l)>0.)dbzr(i,j,l)=10.0*log10(dbzr(i,j,l))
583 IF (dbzi(i,j,l)>0.) &
584 & dbzi(i,j,l)=10.0*log10(dbzi(i,j,l))
585 dbz(i,j,l)=max(dbzmin, dbz(i,j,l))
586 dbzr(i,j,l)=max(dbzmin, dbzr(i,j,l))
587 dbzi(i,j,l)=max(dbzmin, dbzi(i,j,l))
593 ELSE IF(((modelname ==
'NMM' .and. gridtype==
'B') .OR. modelname ==
'FV3R' &
594 .OR. modelname ==
'GFS') &
595 .and. (imp_physics==8 .or. imp_physics==17 .or. imp_physics==18))
THEN
599 dbz(i,j,l)=ref_10cm(i,j,l)
603 ELSE IF(imp_physics==99 .or. imp_physics==98)
THEN
612 if(debugprint .and. me==0)print*,
'calculating radar ref for non-Ferrier/non-Zhao schemes'
614 IF(imp_physics == 1 .OR. imp_physics == 3)
THEN
624 cuprate=rdtphs*cprate(i,j)
625 zfrz(i,j)=zmid(i,j,nint(lmh(i,j)))
626 DO l=1,nint(lmh(i,j))
627 IF (t(i,j,l) >= tfrz)
THEN
628 zfrz(i,j)=zmid(i,j,l)
633 IF (cuprate <= 0. .or. htop(i,j)>=spval)
THEN
637 curefl_s(i,j)=zr_a*cuprate**zr_b
638 lctop=nint(htop(i,j))
645 curefl_i(i,j)=-2./max( 1000., zmid(i,j,lctop)-zfrz(i,j) )
650 IF(imp_physics /= 8 .AND. imp_physics /= 9 .and. imp_physics /= 28)
THEN
659 IF (curefl_s(i,j) > 0.)
THEN
661 llmh = nint(lmh(i,j))
662 lctop=nint(htop(i,j))
663 IF (l>=lctop .AND. l<=llmh)
THEN
664 delz=zmid(i,j,l)-zfrz(i,j)
671 fctr=10.**(curefl_i(i,j)*delz)
674 curefl(i,j)=fctr*curefl_s(i,j)
675 dbzc(i,j,l)=curefl(i,j)
678 IF(t(i,j,l)<spval)
THEN
680 IF(t(i,j,l) > 1.0e-3) &
681 & dens = pmid(i,j,l)/(rd*t(i,j,l)*(q(i,j,l)*d608+1.0))
686 qqr(i,j,l) = max(qqr(i,j,l),0.0)
687 qqs(i,j,l) = max(qqs(i,j,l),0.0)
689 IF (t(i,j,l) >= tfrz)
THEN
690 dbz(i,j,l) = ((qqr(i,j,l)*dens)**1.75)* &
691 & 3.630803e-9 * 1.e18
692 dbzr(i,j,l) = dbz(i,j,l)
695 dbz(i,j,l) = ((qqs(i,j,l)*dens)**1.75)* &
696 & 2.18500e-10 * 1.e18
697 dbzi(i,j,l) = dbz(i,j,l)
699 ELSEIF (iice == 1)
THEN
701 qqg(i,j,l) = max(qqg(i,j,l),0.0)
702 if(qqr(i,j,l) < spval .and. qqr(i,j,l)> 0.0)
then
703 dbzr(i,j,l) = ((qqr(i,j,l)*dens)**1.75) * 3.630803e-9 * 1.e18
707 if(qqs(i,j,l) < spval .and. qqs(i,j,l) > 0.0)
then
708 dbzi(i,j,l) = ((qqs(i,j,l)*dens)**1.75) * &
709 & 2.18500e-10 * 1.e18
713 IF (qqg(i,j,l) < spval .and. qqg(i,j,l)> 0.0)
then
714 dbzi(i,j,l) = dbzi(i,j,l) + ((qqg(i,j,l)*dens)**1.75) * &
715 & 1.033267e-9 * 1.e18
717 dbzi(i,j,l) = dbzi(i,j,l)
719 IF (model_radar)
THEN
720 ze_nc=10.**(0.1*ref_10cm(i,j,l))
721 dbz(i,j,l) = ze_nc+curefl(i,j)
723 dbz(i,j,l) = dbzr(i,j,l) + dbzi(i,j,l) + curefl(i,j)
728 IF (dbz(i,j,l) > 0.) dbz(i,j,l) = 10.0*log10(dbz(i,j,l))
729 IF (dbzr(i,j,l) > 0.) dbzr(i,j,l) = 10.0*log10(dbzr(i,j,l))
730 IF (dbzi(i,j,l) > 0.) dbzi(i,j,l) = 10.0*log10(dbzi(i,j,l))
731 IF (dbzc(i,j,l) > 0.) dbzc(i,j,l) = 10.0*log10(dbzc(i,j,l))
732 llmh = nint(lmh(i,j))
739 dbz(i,j,l) = max(dbzmin, dbz(i,j,l))
740 dbzr(i,j,l) = max(dbzmin, dbzr(i,j,l))
741 dbzi(i,j,l) = max(dbzmin, dbzi(i,j,l))
742 dbzc(i,j,l) = max(dbzmin, dbzc(i,j,l))
781 IF(t(i,j,ll)<spval)
THEN
782 IF(t(i,j,ll) < 1.0e-3)print*,
'ZERO T'
783 IF(t(i,j,ll) > 1.0e-3) &
785 (rd*t(i,j,ll)*(q(i,j,ll)*d608+1.0))
786 dz=zint(i,j,ll)-zint(i,j,lm+1)
801 if (qqr(i,j,ll) >= 1.e-6)
then
802 rain = max(r1,qqr(i,j,ll))
803 ronv = (const1r*tanh((qr0 - rain)/delqr0) + &
805 slor=(rhod*rain/(topr*ronv))**0.25
806 ze_r = 720.*ronv*ron*slor**7
811 if (qqs(i,j,ll) >= 1.e-6)
then
812 snow = max(r1,qqs(i,j,ll))
815 temp_c = min(-0.001, t(i,j,ll)-273.15)
816 sonv = (min(2.0e8, 2.0e6*exp(-0.12*temp_c)))/son
817 slos=(rhoqs/(tops*sonv))**0.25
818 ze_s = 720.*alpha*sonv*son*slos**7*(dsnow/drain)**2
823 IF (t(i,j,ll) > 273.15) &
824 ze_s = ze_s*(1. + 4.28*bb)
829 if (qqg(i,j,ll) >= 1.e-6)
then
830 graupel = max(r1,qqg(i,j,ll))
833 gonv=const_ng1*(rhoqg**const_ng2)
834 gonv = max(1.e4, min(gonv,gon))
836 slog=(rhoqg/(topg*gonv))**0.25
837 ze_g = 720.*alpha*gonv*gon*slog**7*(dgraupel/drain)**2
841 IF (t(i,j,ll) > 273.15) &
842 ze_g = ze_g*(1. + 4.28*bb)
846 ze_nc = ze_r + ze_s + ze_g
848 if (iz1km==0 .and. dz>1000.)
then
853 if (iz4km==0 .and. dz>4000.)
then
858 ze_rmax = max(ze_r,ze_rmax)
859 ze_smax = max(ze_s,ze_smax)
860 ze_gmax = max(ze_g,ze_gmax)
872 ze_max = max(ze_max, ze_sum )
875 dbzr(i,j,ll) = ze_r*1.e18
876 dbzi(i,j,ll) = (ze_s+ze_g)*1.e18
879 dbzr(i,j,ll) = dbzmin
880 dbzi(i,j,ll) = dbzmin
889 cuprate=rdtphs*cprate(i,j)
893 ze_conv= max(0.1,300*(cuprate)**1.4)
898 ze_sum = ze_max + ze_conv
899 refl(i,j) = 10.*log10(ze_sum)
900 refl1km(i,j) = 10.*log10(ze_nc_1km*1.e18 + ze_conv)
901 refl4km(i,j) = 10.*log10(ze_nc_4km*1.e18 + ze_conv)
906 ze_rmax = 10.*log10(ze_rmax*1.e18)
907 ze_smax = 10.*log10(ze_smax*1.e18)
908 ze_gmax = 10.*log10(ze_gmax*1.e18)
919 allocate (rh3d(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
920 IF ( (iget(001)>0).OR.(iget(077)>0).OR. &
921 (iget(002)>0).OR.(iget(003)>0).OR. &
922 (iget(004)>0).OR.(iget(005)>0).OR. &
923 (iget(006)>0).OR.(iget(083)>0).OR. &
924 (iget(007)>0).OR.(iget(008)>0).OR. &
925 (iget(009)>0).OR.(iget(010)>0).OR. &
926 (iget(084)>0).OR.(iget(011)>0).OR. &
927 (iget(041)>0).OR.(iget(124)>0).OR. &
928 (iget(078)>0).OR.(iget(079)>0).OR. &
929 (iget(125)>0).OR.(iget(145)>0).OR. &
930 (iget(140)>0).OR.(iget(040)>0).OR. &
931 (iget(181)>0).OR.(iget(182)>0).OR. &
932 (iget(199)>0).OR.(iget(185)>0).OR. &
933 (iget(186)>0).OR.(iget(187)>0).OR. &
934 (iget(250)>0).OR.(iget(252)>0).OR. &
935 (iget(276)>0).OR.(iget(277)>0).OR. &
936 (iget(750)>0).OR.(iget(751)>0).OR. &
937 (iget(752)>0).OR.(iget(754)>0).OR. &
938 (iget(278)>0).OR.(iget(264)>0).OR. &
939 (iget(450)>0).OR.(iget(480)>0).OR. &
940 (iget(479)>0).OR.(iget(481)>0).OR. &
941 (iget(774)>0).OR.(iget(747)>0).OR. &
942 (iget(464)>0).OR.(iget(467)>0).OR. &
943 (iget(470)>0).OR.(iget(476)>0).OR. &
944 (iget(629)>0).OR.(iget(630)>0).OR. &
945 (iget(909)>0).OR.(iget(737)>0).OR. &
947 (iget(994)>0).OR.(iget(995)>0) )
THEN
952 IF (iget(001)>0)
THEN
953 IF (lvls(l,iget(001))>0)
THEN
958 grid1(i,j) = pmid(i,j,ll)
961 if(grib==
"grib2" )
then
963 fld_info(cfld)%ifld=iavblfld(iget(001))
964 fld_info(cfld)%lvl=lvlsxml(l,iget(001))
970 datapd(i,j,cfld) = grid1(ii,jj)
980 IF (iget(124) > 0)
THEN
981 IF (lvls(l,iget(124)) > 0)
THEN
986 grid1(i,j) = qqw(i,j,ll)
987 if(grid1(i,j)<1e-20) grid1(i,j) = 0.0
990 if(grib==
"grib2" )
then
992 fld_info(cfld)%ifld=iavblfld(iget(124))
993 fld_info(cfld)%lvl=lvlsxml(l,iget(124))
999 datapd(i,j,cfld) = grid1(ii,jj)
1008 IF (iget(125) > 0)
THEN
1009 IF (lvls(l,iget(125)) > 0)
THEN
1014 grid1(i,j) = qqi(i,j,ll)
1015 if(grid1(i,j)<1e-20) grid1(i,j) = 0.0
1018 if(grib==
"grib2" )
then
1020 fld_info(cfld)%ifld=iavblfld(iget(125))
1021 fld_info(cfld)%lvl=lvlsxml(l,iget(125))
1027 datapd(i,j,cfld) = grid1(ii,jj)
1036 IF (iget(181) > 0)
THEN
1037 IF (lvls(l,iget(181)) > 0)
THEN
1042 grid1(i,j) = qqr(i,j,ll)
1043 if(grid1(i,j)<1e-20) grid1(i,j) = 0.0
1046 if(grib==
"grib2" )
then
1048 fld_info(cfld)%ifld=iavblfld(iget(181))
1049 fld_info(cfld)%lvl=lvlsxml(l,iget(181))
1055 datapd(i,j,cfld) = grid1(ii,jj)
1064 IF (iget(182) > 0)
THEN
1065 IF (lvls(l,iget(182)) > 0)
THEN
1070 grid1(i,j) = qqs(i,j,ll)
1071 if(grid1(i,j)<1e-20) grid1(i,j) = 0.0
1074 if(grib==
"grib2" )
then
1076 fld_info(cfld)%ifld=iavblfld(iget(182))
1077 fld_info(cfld)%lvl=lvlsxml(l,iget(182))
1083 datapd(i,j,cfld) = grid1(ii,jj)
1092 IF (iget(415) > 0)
THEN
1093 IF (lvls(l,iget(415)) > 0)
THEN
1098 if(qqg(i,j,ll) < 1.e-12) qqg(i,j,ll) = 0.
1099 grid1(i,j) = qqg(i,j,ll)
1102 if(grib==
"grib2" )
then
1104 fld_info(cfld)%ifld=iavblfld(iget(415))
1105 fld_info(cfld)%lvl=lvlsxml(l,iget(415))
1111 datapd(i,j,cfld) = grid1(ii,jj)
1120 IF (iget(747) > 0)
THEN
1121 IF (lvls(l,iget(747)) > 0)
THEN
1126 if(qqnw(i,j,ll) < 1.e-8) qqnw(i,j,ll) = 0.
1127 grid1(i,j) = qqnw(i,j,ll)
1130 if(grib==
"grib2" )
then
1132 fld_info(cfld)%ifld=iavblfld(iget(747))
1133 fld_info(cfld)%lvl=lvlsxml(l,iget(747))
1139 datapd(i,j,cfld) = grid1(ii,jj)
1148 IF (iget(752) > 0)
THEN
1149 IF (lvls(l,iget(752)) > 0)
THEN
1154 if(qqni(i,j,ll) < 1.e-8) qqni(i,j,ll) = 0.
1155 grid1(i,j) = qqni(i,j,ll)
1158 if(grib==
"grib2" )
then
1160 fld_info(cfld)%ifld=iavblfld(iget(752))
1161 fld_info(cfld)%lvl=lvlsxml(l,iget(752))
1167 datapd(i,j,cfld) = grid1(ii,jj)
1176 IF (iget(754) > 0)
THEN
1177 IF (lvls(l,iget(754)) > 0)
THEN
1182 if(qqnr(i,j,ll) < 1.e-8) qqnr(i,j,ll) = 0.
1183 grid1(i,j) = qqnr(i,j,ll)
1186 if(grib==
"grib2" )
then
1188 fld_info(cfld)%ifld=iavblfld(iget(754))
1189 fld_info(cfld)%lvl=lvlsxml(l,iget(754))
1195 datapd(i,j,cfld) = grid1(ii,jj)
1203 IF (iget(766) > 0)
THEN
1204 IF (lvls(l,iget(766)) > 0)
THEN
1208 if(qqnwfa(i,j,ll)<1.e-8)qqnwfa(i,j,ll)=0.
1209 grid1(i,j)=qqnwfa(i,j,ll)
1212 if(grib==
"grib2" )
then
1214 fld_info(cfld)%ifld=iavblfld(iget(766))
1215 fld_info(cfld)%lvl=lvlsxml(l,iget(766))
1216 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1223 IF (iget(767) > 0)
THEN
1224 IF (lvls(l,iget(767)) > 0)
THEN
1228 if(qqnifa(i,j,ll)<1.e-8)qqnifa(i,j,ll)=0.
1229 grid1(i,j)=qqnifa(i,j,ll)
1232 if(grib==
"grib2" )
then
1234 fld_info(cfld)%ifld=iavblfld(iget(767))
1235 fld_info(cfld)%lvl=lvlsxml(l,iget(767))
1236 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1243 IF (iget(145) > 0)
THEN
1244 IF (lvls(l,iget(145)) > 0)
THEN
1249 IF(abs(cfr(i,j,ll)-spval) > small)
THEN
1250 grid1(i,j) = cfr(i,j,ll)*h100
1256 CALL bound(grid1,d00,h100)
1257 if(grib==
"grib2" )
then
1259 fld_info(cfld)%ifld=iavblfld(iget(145))
1260 fld_info(cfld)%lvl=lvlsxml(l,iget(145))
1266 datapd(i,j,cfld) = grid1(ii,jj)
1275 IF (iget(774) > 0)
THEN
1276 IF (lvls(l,iget(774)) > 0)
THEN
1281 IF(modelname ==
'RAPR')
THEN
1282 grid1(i,j) = cfr(i,j,ll)
1284 grid1(i,j) = cfr_raw(i,j,ll)
1288 if(grib==
"grib2" )
then
1290 fld_info(cfld)%ifld=iavblfld(iget(774))
1291 fld_info(cfld)%lvl=lvlsxml(l,iget(774))
1297 datapd(i,j,cfld) = grid1(ii,jj)
1306 IF (iget(250) > 0)
THEN
1307 IF (lvls(l,iget(250)) > 0)
THEN
1317 IF(imp_physics == 8 .or. imp_physics == 28)
THEN
1321 grid1(i,j) = ref_10cm(i,j,ll)
1328 grid1(i,j) = dbz(i,j,ll)
1333 CALL bound(grid1,dbzmin,dbzmax)
1334 if(grib==
"grib2" )
then
1336 fld_info(cfld)%ifld=iavblfld(iget(250))
1337 fld_info(cfld)%lvl=lvlsxml(l,iget(250))
1343 datapd(i,j,cfld) = grid1(ii,jj)
1353 IF (iget(199)>0)
THEN
1354 IF (lvls(l,iget(199))>0)
THEN
1359 grid1(i,j) = cwm(i,j,ll)
1362 if(grib==
"grib2" )
then
1364 fld_info(cfld)%ifld=iavblfld(iget(199))
1365 fld_info(cfld)%lvl=lvlsxml(l,iget(199))
1371 datapd(i,j,cfld) = grid1(ii,jj)
1380 IF (iget(185)>0)
THEN
1381 IF (lvls(l,iget(185))>0)
THEN
1386 grid1(i,j) = f_rain(i,j,ll)
1389 if(grib==
"grib2" )
then
1391 fld_info(cfld)%ifld=iavblfld(iget(185))
1392 fld_info(cfld)%lvl=lvlsxml(l,iget(185))
1398 datapd(i,j,cfld) = grid1(ii,jj)
1407 IF (iget(186)>0)
THEN
1408 IF (lvls(l,iget(186))>0)
THEN
1413 grid1(i,j) = f_ice(i,j,ll)
1416 if(grib==
"grib2" )
then
1418 fld_info(cfld)%ifld=iavblfld(iget(186))
1419 fld_info(cfld)%lvl=lvlsxml(l,iget(186))
1425 datapd(i,j,cfld) = grid1(ii,jj)
1434 IF (iget(187)>0)
THEN
1435 IF (lvls(l,iget(187))>0)
THEN
1441 grid1(i,j) = f_rimef(i,j,ll)
1444 if(grib==
"grib2" )
then
1446 fld_info(cfld)%ifld=iavblfld(iget(187))
1447 fld_info(cfld)%lvl=lvlsxml(l,iget(187))
1453 datapd(i,j,cfld) = grid1(ii,jj)
1462 IF (iget(077)>0)
THEN
1463 IF (lvls(l,iget(077))>0)
THEN
1468 grid1(i,j) = zmid(i,j,ll)
1471 if(grib==
"grib2" )
then
1473 fld_info(cfld)%ifld=iavblfld(iget(077))
1474 fld_info(cfld)%lvl=lvlsxml(l,iget(077))
1480 datapd(i,j,cfld) = grid1(ii,jj)
1489 IF (iget(002)>0)
THEN
1490 IF (lvls(l,iget(002))>0)
THEN
1495 grid1(i,j) = t(i,j,ll)
1498 if(grib==
"grib2" )
then
1500 fld_info(cfld)%ifld=iavblfld(iget(002))
1501 fld_info(cfld)%lvl=lvlsxml(l,iget(002))
1507 datapd(i,j,cfld) = grid1(ii,jj)
1516 IF (iget(909)>0)
THEN
1517 IF (lvls(l,iget(909))>0)
THEN
1522 IF(t(i,j,ll)<spval.and.q(i,j,ll)<spval)
THEN
1523 grid1(i,j)=t(i,j,ll)*(1.+d608*q(i,j,ll))
1529 if(grib==
"grib2" )
then
1531 fld_info(cfld)%ifld=iavblfld(iget(909))
1532 fld_info(cfld)%lvl=lvlsxml(l,iget(909))
1533 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1540 IF (iget(003)>0)
THEN
1541 IF (lvls(l,iget(003))>0)
THEN
1546 p1d(i,j) = pmid(i,j,ll)
1547 t1d(i,j) = t(i,j,ll)
1550 CALL calpot(p1d(ista:iend,jsta:jend),t1d(ista:iend,jsta:jend),egrid3(ista:iend,jsta:jend))
1555 grid1(i,j) = egrid3(i,j)
1558 if(grib==
"grib2")
then
1560 fld_info(cfld)%ifld=iavblfld(iget(003))
1561 fld_info(cfld)%lvl=lvlsxml(l,iget(003))
1567 datapd(i,j,cfld) = grid1(ii,jj)
1576 IF (iget(751)>0)
THEN
1577 IF (lvls(l,iget(751))>0)
THEN
1582 p1d(i,j) = pmid(i,j,ll)
1583 t1d(i,j) = t(i,j,ll)
1586 CALL calpot(p1d(ista:iend,jsta:jend),t1d(ista:iend,jsta:jend),egrid3(ista:iend,jsta:jend))
1591 IF(p1d(i,j)<spval.and.t1d(i,j)<spval.and.q(i,j,ll)<spval)
THEN
1592 grid1(i,j) = egrid3(i,j) * (1.+d608*q(i,j,ll))
1598 if(grib==
"grib2")
then
1600 fld_info(cfld)%ifld=iavblfld(iget(751))
1601 fld_info(cfld)%lvl=lvlsxml(l,iget(751))
1607 datapd(i,j,cfld) = grid1(ii,jj)
1617 IF (iget(006) > 0) item = lvls(l,iget(006))
1618 IF (item > 0 .OR. iget(450) > 0 .OR. iget(480) > 0 .OR. &
1619 iget(479) > 0 .OR. iget(481) > 0 )
THEN
1624 p1d(i,j) = pmid(i,j,ll)
1625 t1d(i,j) = t(i,j,ll)
1626 q1d(i,j) = q(i,j,ll)
1630 CALL calrh(p1d(ista:iend,jsta:jend),t1d(ista:iend,jsta:jend),q1d(ista:iend,jsta:jend),egrid4(ista:iend,jsta:jend))
1635 IF(p1d(i,j)<spval.and.t1d(i,j)<spval.and.q1d(i,j)<spval)
THEN
1636 grid1(i,j) = egrid4(i,j)*100.
1637 rh3d(i,j,ll) = grid1(i,j)
1638 egrid2(i,j) = q(i,j,ll)/max(1.e-8,egrid4(i,j))
1641 rh3d(i,j,ll) = spval
1647 if(grib==
"grib2")
then
1649 fld_info(cfld)%ifld=iavblfld(iget(006))
1650 fld_info(cfld)%lvl=lvlsxml(l,iget(006))
1656 datapd(i,j,cfld) = grid1(ii,jj)
1665 IF (iget(004)>0)
THEN
1666 IF (lvls(l,iget(004))>0)
THEN
1671 p1d(i,j) = pmid(i,j,ll)
1672 t1d(i,j) = t(i,j,ll)
1673 q1d(i,j) = q(i,j,ll)
1676 CALL caldwp(p1d(ista:iend,jsta:jend),q1d(ista:iend,jsta:jend),egrid3(ista:iend,jsta:jend),t1d(ista:iend,jsta:jend))
1680 IF(p1d(i,j)<spval.and.t1d(i,j)<spval.and.q1d(i,j)<spval)
THEN
1681 grid1(i,j) = egrid3(i,j)
1687 if(grib==
"grib2")
then
1689 fld_info(cfld)%ifld=iavblfld(iget(004))
1690 fld_info(cfld)%lvl=lvlsxml(l,iget(004))
1696 datapd(i,j,cfld) = grid1(ii,jj)
1704 IF (iget(005)>0)
THEN
1705 IF (lvls(l,iget(005))>0)
THEN
1710 grid1(i,j) = q(i,j,ll)
1713 CALL bound(grid1,h1m12,h99999)
1714 if(grib==
"grib2")
then
1716 fld_info(cfld)%ifld=iavblfld(iget(005))
1717 fld_info(cfld)%lvl=lvlsxml(l,iget(005))
1723 datapd(i,j,cfld) = grid1(ii,jj)
1731 IF (iget(750)>0)
THEN
1732 IF (lvls(l,iget(750))>0)
THEN
1737 IF(q(i,j,ll)<spval)
THEN
1738 grid1(i,j) = q(i,j,ll) / (1.-q(i,j,ll))
1744 CALL bound(grid1,h1m12,h99999)
1745 if(grib==
"grib2")
then
1747 fld_info(cfld)%ifld=iavblfld(iget(750))
1748 fld_info(cfld)%lvl=lvlsxml(l,iget(750))
1754 datapd(i,j,cfld) = grid1(ii,jj)
1763 if (iget(083) > 0) lll = lvls(l,iget(083))
1764 IF (iget(083)>0 .OR. iget(295)>0)
THEN
1765 IF (lll >0 .OR. iget(295)>0)
THEN
1768 DO j=jsta_2l,jend_2u
1769 DO i=ista_2l,iend_2u
1770 q1d(i,j) = q(i,j,ll)
1771 egrid1(i,j) = uh(i,j,ll)
1772 egrid2(i,j) = vh(i,j,ll)
1775 CALL calmcvg(q1d,egrid1,egrid2,egrid3)
1779 IF(q1d(i,j)<spval.and.egrid1(i,j)<spval.and.egrid2(i,j)<spval)
THEN
1780 grid1(i,j) = egrid3(i,j)
1781 mcvg(i,j,ll) = egrid3(i,j)
1784 mcvg(i,j,ll) = spval
1788 IF(iget(083)>0 .AND. lll>0)
THEN
1789 if(grib==
"grib2")
then
1791 fld_info(cfld)%ifld=iavblfld(iget(083))
1792 fld_info(cfld)%lvl=lvlsxml(l,iget(083))
1798 datapd(i,j,cfld) = grid1(ii,jj)
1808 IF (iget(007)>0.OR.iget(008)>0)
THEN
1809 IF (lvls(l,iget(007))>0.OR.lvls(l,iget(008))>0 )
THEN
1814 grid1(i,j) = uh(i,j,ll)
1815 grid2(i,j) = vh(i,j,ll)
1818 if(grib==
"grib2")
then
1820 fld_info(cfld)%ifld=iavblfld(iget(007))
1821 fld_info(cfld)%lvl=lvlsxml(l,iget(007))
1827 datapd(i,j,cfld) = grid1(ii,jj)
1831 fld_info(cfld)%ifld=iavblfld(iget(008))
1832 fld_info(cfld)%lvl=lvlsxml(l,iget(008))
1838 datapd(i,j,cfld) = grid2(ii,jj)
1846 IF (iget(009)>0)
THEN
1847 IF (lvls(l,iget(009))>0)
THEN
1852 grid1(i,j) = omga(i,j,ll)
1855 if(grib==
"grib2")
then
1857 fld_info(cfld)%ifld=iavblfld(iget(009))
1858 fld_info(cfld)%lvl=lvlsxml(l,iget(009))
1864 datapd(i,j,cfld) = grid1(ii,jj)
1872 IF (iget(264)>0)
THEN
1873 IF (lvls(l,iget(264))>0)
THEN
1878 grid1(i,j)=wh(i,j,ll)
1881 if(grib==
"grib2")
then
1883 fld_info(cfld)%ifld=iavblfld(iget(264))
1884 fld_info(cfld)%lvl=lvlsxml(l,iget(264))
1890 datapd(i,j,cfld) = grid1(ii,jj)
1898 IF (iget(010)>0)
THEN
1899 IF (lvls(l,iget(010))>0)
THEN
1902 DO j=jsta_2l,jend_2u
1903 DO i=ista_2l,iend_2u
1904 egrid1(i,j) = uh(i,j,ll)
1905 egrid2(i,j) = vh(i,j,ll)
1908 CALL calvor(egrid1,egrid2,egrid3)
1912 IF(egrid3(i,j)<spval)
THEN
1913 grid1(i,j) = egrid3(i,j)
1919 if(grib==
"grib2")
then
1921 fld_info(cfld)%ifld=iavblfld(iget(010))
1922 fld_info(cfld)%lvl=lvlsxml(l,iget(010))
1928 datapd(i,j,cfld) = grid1(ii,jj)
1936 IF (iget(084)>0)
THEN
1937 IF (lvls(l,iget(084))>0)
THEN
1942 egrid1(i,j) = zmid(i,j,ll)
1945 CALL calstrm(egrid1(ista:iend,jsta:jend),egrid2(ista:iend,jsta:jend))
1949 grid1(i,j) = egrid2(i,j)
1952 if(grib==
"grib2")
then
1954 fld_info(cfld)%ifld=iavblfld(iget(084))
1955 fld_info(cfld)%lvl=lvlsxml(l,iget(084))
1961 datapd(i,j,cfld) = grid1(ii,jj)
1969 IF (iget(011)>0)
THEN
1970 IF (lvls(l,iget(011))>0)
THEN
1975 grid1(i,j) = q2(i,j,ll)
1978 if(grib==
"grib2")
then
1980 fld_info(cfld)%ifld=iavblfld(iget(011))
1981 fld_info(cfld)%lvl=lvlsxml(l,iget(011))
1987 datapd(i,j,cfld) = grid1(ii,jj)
2040 IF (iget(140)>0)
THEN
2041 IF (lvls(l,iget(140))>0)
THEN
2046 grid1(i,j) = ttnd(i,j,ll)
2049 if(grib==
"grib2")
then
2051 fld_info(cfld)%ifld=iavblfld(iget(140))
2052 fld_info(cfld)%lvl=lvlsxml(l,iget(140))
2058 datapd(i,j,cfld) = grid1(ii,jj)
2067 IF (iget(040)>0)
THEN
2068 IF (lvls(l,iget(040))>0)
THEN
2073 grid1(i,j) = rswtt(i,j,ll)
2076 if(grib==
"grib2")
then
2078 fld_info(cfld)%ifld=iavblfld(iget(040))
2079 fld_info(cfld)%lvl=lvlsxml(l,iget(040))
2085 datapd(i,j,cfld) = grid1(ii,jj)
2094 IF (iget(041)>0)
THEN
2095 IF (lvls(l,iget(041))>0)
THEN
2100 grid1(i,j) = rlwtt(i,j,ll)
2103 if(grib==
"grib2")
then
2105 fld_info(cfld)%ifld=iavblfld(iget(041))
2106 fld_info(cfld)%lvl=lvlsxml(l,iget(041))
2112 datapd(i,j,cfld) = grid1(ii,jj)
2123 IF (iget(078)>0)
THEN
2124 IF (lvls(l,iget(078))>0)
THEN
2134 IF(train(i,j,ll)<spval)
THEN
2135 grid1(i,j) = train(i,j,ll)*rrnum
2143 IF (itheat /= 0)
THEN
2144 ifincr = mod(ifhr,itheat)
2149 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2152 id(18) = ifhr-itheat
2154 id(18) = ifhr-ifincr
2156 IF(ifmin >= 1)id(18)=id(18)*60
2157 if(grib==
"grib2")
then
2159 fld_info(cfld)%ifld=iavblfld(iget(078))
2160 fld_info(cfld)%lvl=lvlsxml(l,iget(078))
2162 fld_info(cfld)%ntrange=0
2164 fld_info(cfld)%ntrange=1
2166 fld_info(cfld)%tinvstat=ifhr-id(18)
2172 datapd(i,j,cfld) = grid1(ii,jj)
2180 IF (iget(079)>0)
THEN
2181 IF (lvls(l,iget(079))>0)
THEN
2191 IF(tcucn(i,j,ll)<spval)
THEN
2192 grid1(i,j) = tcucn(i,j,ll)*rrnum
2200 IF (itheat /= 0)
THEN
2201 ifincr = mod(ifhr,itheat)
2206 IF(ifmin >= 1)id(19)=ifhr*60+ifmin
2209 id(18) = ifhr-itheat
2211 id(18) = ifhr-ifincr
2213 IF(ifmin >= 1)id(18)=id(18)*60
2214 if(grib==
"grib2")
then
2216 fld_info(cfld)%ifld=iavblfld(iget(079))
2217 fld_info(cfld)%lvl=lvlsxml(l,iget(079))
2219 fld_info(cfld)%ntrange=0
2221 fld_info(cfld)%ntrange=1
2223 fld_info(cfld)%tinvstat=ifhr-id(18)
2229 datapd(i,j,cfld) = grid1(ii,jj)
2237 IF (iget(267)>0)
THEN
2238 IF (lvls(l,iget(267))>0)
THEN
2243 grid1(i,j) = o3(i,j,ll)
2246 if(grib==
"grib2")
then
2248 fld_info(cfld)%ifld=iavblfld(iget(267))
2249 fld_info(cfld)%lvl=lvlsxml(l,iget(267))
2255 datapd(i,j,cfld) = grid1(ii,jj)
2268 IF (iget(994)>0)
THEN
2269 IF (lvls(l,iget(994))>0)
THEN
2274 IF(avgozcon(i,j,ll)<spval)
THEN
2275 grid1(i,j) = avgozcon(i,j,ll)
2290 if(grib==
"grib2")
then
2292 fld_info(cfld)%ifld=iavblfld(iget(994))
2293 fld_info(cfld)%lvl=lvlsxml(l,iget(994))
2295 fld_info(cfld)%ntrange=0
2297 fld_info(cfld)%ntrange=1
2299 fld_info(cfld)%tinvstat=ifhr-id(18)
2305 datapd(i,j,cfld) = grid1(ii,jj)
2315 IF (iget(995)>0)
THEN
2316 IF (lvls(l,iget(995))>0)
THEN
2321 grid1(i,j) = avgpmtf(i,j,ll)
2333 if(grib==
"grib2")
then
2335 fld_info(cfld)%ifld=iavblfld(iget(995))
2336 fld_info(cfld)%lvl=lvlsxml(l,iget(995))
2338 fld_info(cfld)%ntrange=0
2340 fld_info(cfld)%ntrange=1
2342 fld_info(cfld)%tinvstat=ifhr-id(18)
2348 datapd(i,j,cfld) = grid1(ii,jj)
2362 IF (iget(737)>0)
THEN
2363 IF (lvls(l,iget(737))>0)
THEN
2368 IF(pmid(i,j,ll)<spval.and.t(i,j,ll)<spval.and.smoke(i,j,ll,1)<spval)
THEN
2369 grid1(i,j) = (1./rd)*(pmid(i,j,ll)/t(i,j,ll))*smoke(i,j,ll,1)/(1e9)
2375 if(grib==
"grib2")
then
2377 fld_info(cfld)%ifld=iavblfld(iget(737))
2378 fld_info(cfld)%lvl=lvlsxml(l,iget(737))
2384 datapd(i,j,cfld) = grid1(ii,jj)
2392 IF (iget(742)>0)
THEN
2393 IF (lvls(l,iget(742))>0)
THEN
2398 IF(pmid(i,j,ll)<spval.and.t(i,j,ll)<spval.and.fv3dust(i,j,ll,1)<spval)
THEN
2399 grid1(i,j) = (1./rd)*(pmid(i,j,ll)/t(i,j,ll))*fv3dust(i,j,ll,1)/(1e9)
2405 if(grib==
"grib2")
then
2407 fld_info(cfld)%ifld=iavblfld(iget(742))
2408 fld_info(cfld)%lvl=lvlsxml(l,iget(742))
2414 datapd(i,j,cfld) = grid1(ii,jj)
2422 IF (iget(1012)>0)
THEN
2423 IF (lvls(l,iget(1012))>0)
THEN
2428 IF(pmid(i,j,ll)<spval.and.t(i,j,ll)<spval.and.coarsepm(i,j,ll,1)<spval)
THEN
2429 grid1(i,j) = (1./rd)*(pmid(i,j,ll)/t(i,j,ll))*coarsepm(i,j,ll,1)/(1e9)
2435 if(grib==
"grib2")
then
2437 fld_info(cfld)%ifld=iavblfld(iget(1012))
2438 fld_info(cfld)%lvl=lvlsxml(l,iget(1012))
2444 datapd(i,j,cfld) = grid1(ii,jj)
2453 IF (iget(1015)>0)
THEN
2454 IF (lvls(l,iget(1015))>0)
THEN
2459 grid1(i,j) = ebb(i,j,ll,1)/(1e9)
2462 if(grib==
"grib2")
then
2464 fld_info(cfld)%ifld=iavblfld(iget(1015))
2465 fld_info(cfld)%lvl=lvlsxml(l,iget(1015))
2471 datapd(i,j,cfld) = grid1(ii,jj)
2478 if ( gocart_on .or. gccpp_on .or. nasa_on )
then
2480 IF (iget(629)>0)
THEN
2481 IF (lvls(l,iget(629))>0)
THEN
2486 IF(dust(i,j,ll,1)<spval.and.rhomid(i,j,ll)<spval)
THEN
2488 grid1(i,j) = dust(i,j,ll,1)*rhomid(i,j,ll)
2494 if(grib==
"grib2")
then
2496 fld_info(cfld)%ifld=iavblfld(iget(629))
2497 fld_info(cfld)%lvl=lvlsxml(l,iget(629))
2503 datapd(i,j,cfld) = grid1(ii,jj)
2511 IF (iget(630)>0)
THEN
2512 IF (lvls(l,iget(630))>0)
THEN
2517 IF(dust(i,j,ll,2)<spval.and.rhomid(i,j,ll)<spval)
THEN
2519 grid1(i,j) = dust(i,j,ll,2)*rhomid(i,j,ll)
2525 if(grib==
"grib2")
then
2527 fld_info(cfld)%ifld=iavblfld(iget(630))
2528 fld_info(cfld)%lvl=lvlsxml(l,iget(630))
2534 datapd(i,j,cfld) = grid1(ii,jj)
2542 IF (iget(631)>0)
THEN
2543 IF (lvls(l,iget(631))>0)
THEN
2548 IF(dust(i,j,ll,3)<spval.and.rhomid(i,j,ll)<spval)
THEN
2550 grid1(i,j) = dust(i,j,ll,3)*rhomid(i,j,ll)
2556 if(grib==
"grib2")
then
2558 fld_info(cfld)%ifld=iavblfld(iget(631))
2559 fld_info(cfld)%lvl=lvlsxml(l,iget(631))
2565 datapd(i,j,cfld) = grid1(ii,jj)
2573 IF (iget(632)>0)
THEN
2574 IF (lvls(l,iget(632))>0)
THEN
2579 IF(dust(i,j,ll,4)<spval.and.rhomid(i,j,ll)<spval)
THEN
2581 grid1(i,j) = dust(i,j,ll,4)*rhomid(i,j,ll)
2587 if(grib==
"grib2")
then
2589 fld_info(cfld)%ifld=iavblfld(iget(632))
2590 fld_info(cfld)%lvl=lvlsxml(l,iget(632))
2596 datapd(i,j,cfld) = grid1(ii,jj)
2604 IF (iget(633)>0)
THEN
2605 IF (lvls(l,iget(633))>0)
THEN
2610 IF(dust(i,j,ll,5)<spval.and.rhomid(i,j,ll)<spval)
THEN
2612 grid1(i,j) = dust(i,j,ll,5)*rhomid(i,j,ll)
2618 if(grib==
"grib2")
then
2620 fld_info(cfld)%ifld=iavblfld(iget(633))
2621 fld_info(cfld)%lvl=lvlsxml(l,iget(633))
2627 datapd(i,j,cfld) = grid1(ii,jj)
2635 IF (iget(634)>0)
THEN
2636 IF (lvls(l,iget(634))>0)
THEN
2641 IF(salt(i,j,ll,1)<spval.and.rhomid(i,j,ll)<spval)
THEN
2642 grid1(i,j) = salt(i,j,ll,1)*rhomid(i,j,ll)
2648 if(grib==
"grib2")
then
2650 fld_info(cfld)%ifld=iavblfld(iget(634))
2651 fld_info(cfld)%lvl=lvlsxml(l,iget(634))
2657 datapd(i,j,cfld) = grid1(ii,jj)
2665 IF (iget(635)>0)
THEN
2666 IF (lvls(l,iget(635))>0)
THEN
2671 IF(salt(i,j,ll,2)<spval.and.rhomid(i,j,ll)<spval)
THEN
2672 grid1(i,j) = salt(i,j,ll,2)*rhomid(i,j,ll)
2678 if(grib==
"grib2")
then
2680 fld_info(cfld)%ifld=iavblfld(iget(635))
2681 fld_info(cfld)%lvl=lvlsxml(l,iget(635))
2687 datapd(i,j,cfld) = grid1(ii,jj)
2695 IF (iget(636)>0)
THEN
2696 IF (lvls(l,iget(636))>0)
THEN
2701 IF(salt(i,j,ll,3)<spval.and.rhomid(i,j,ll)<spval)
THEN
2702 grid1(i,j) = salt(i,j,ll,3)*rhomid(i,j,ll)
2708 if(grib==
"grib2")
then
2710 fld_info(cfld)%ifld=iavblfld(iget(636))
2711 fld_info(cfld)%lvl=lvlsxml(l,iget(636))
2717 datapd(i,j,cfld) = grid1(ii,jj)
2725 IF (iget(637)>0)
THEN
2726 IF (lvls(l,iget(637))>0)
THEN
2731 IF(salt(i,j,ll,4)<spval.and.rhomid(i,j,ll)<spval)
THEN
2732 grid1(i,j) = salt(i,j,ll,4)*rhomid(i,j,ll)
2738 if(grib==
"grib2")
then
2740 fld_info(cfld)%ifld=iavblfld(iget(637))
2741 fld_info(cfld)%lvl=lvlsxml(l,iget(637))
2747 datapd(i,j,cfld) = grid1(ii,jj)
2755 IF (iget(638)>0)
THEN
2756 IF (lvls(l,iget(638))>0)
THEN
2761 IF(salt(i,j,ll,5)<spval.and.rhomid(i,j,ll)<spval)
THEN
2762 grid1(i,j) = salt(i,j,ll,5)*rhomid(i,j,ll)
2768 if(grib==
"grib2")
then
2770 fld_info(cfld)%ifld=iavblfld(iget(638))
2771 fld_info(cfld)%lvl=lvlsxml(l,iget(638))
2777 datapd(i,j,cfld) = grid1(ii,jj)
2785 IF (iget(639)>0)
THEN
2786 IF (lvls(l,iget(639))>0)
THEN
2791 IF(suso(i,j,ll,1)<spval.and.rhomid(i,j,ll)<spval)
THEN
2793 grid1(i,j) = suso(i,j,ll,1)*rhomid(i,j,ll)
2799 if(grib==
"grib2")
then
2801 fld_info(cfld)%ifld=iavblfld(iget(639))
2802 fld_info(cfld)%lvl=lvlsxml(l,iget(639))
2808 datapd(i,j,cfld) = grid1(ii,jj)
2816 IF (iget(640)>0)
THEN
2817 IF (lvls(l,iget(640))>0)
THEN
2822 IF(waso(i,j,ll,1)<spval.and.rhomid(i,j,ll)<spval)
THEN
2824 grid1(i,j) = waso(i,j,ll,1)*rhomid(i,j,ll)
2830 if(grib==
"grib2")
then
2832 fld_info(cfld)%ifld=iavblfld(iget(640))
2833 fld_info(cfld)%lvl=lvlsxml(l,iget(640))
2839 datapd(i,j,cfld) = grid1(ii,jj)
2847 IF (iget(641)>0)
THEN
2848 IF (lvls(l,iget(641))>0)
THEN
2853 IF(waso(i,j,ll,2)<spval.and.rhomid(i,j,ll)<spval)
THEN
2855 grid1(i,j) = waso(i,j,ll,2)*rhomid(i,j,ll)
2861 if(grib==
"grib2")
then
2863 fld_info(cfld)%ifld=iavblfld(iget(641))
2864 fld_info(cfld)%lvl=lvlsxml(l,iget(641))
2870 datapd(i,j,cfld) = grid1(ii,jj)
2878 IF (iget(642)>0)
THEN
2879 IF (lvls(l,iget(642))>0)
THEN
2884 IF(soot(i,j,ll,1)<spval.and.rhomid(i,j,ll)<spval)
THEN
2886 grid1(i,j) = soot(i,j,ll,1)*rhomid(i,j,ll)
2892 if(grib==
"grib2")
then
2894 fld_info(cfld)%ifld=iavblfld(iget(642))
2895 fld_info(cfld)%lvl=lvlsxml(l,iget(642))
2901 datapd(i,j,cfld) = grid1(ii,jj)
2909 IF (iget(643)>0)
THEN
2910 IF (lvls(l,iget(643))>0)
THEN
2915 IF(soot(i,j,ll,2)<spval.and.rhomid(i,j,ll)<spval)
THEN
2917 grid1(i,j) = soot(i,j,ll,2)*rhomid(i,j,ll)
2923 if(grib==
"grib2")
then
2925 fld_info(cfld)%ifld=iavblfld(iget(643))
2926 fld_info(cfld)%lvl=lvlsxml(l,iget(643))
2932 datapd(i,j,cfld) = grid1(ii,jj)
2942 IF (iget(688)>0)
THEN
2943 IF (lvls(l,iget(688))>0)
THEN
2948 IF(no3(i,j,ll,1)<spval.and.rhomid(i,j,ll)<spval)
THEN
2949 grid1(i,j) = no3(i,j,ll,1)*rhomid(i,j,ll)
2955 if(grib==
"grib2")
then
2957 fld_info(cfld)%ifld=iavblfld(iget(688))
2958 fld_info(cfld)%lvl=lvlsxml(l,iget(688))
2964 datapd(i,j,cfld) = grid1(ii,jj)
2972 IF (iget(689)>0)
THEN
2973 IF (lvls(l,iget(689))>0)
THEN
2978 IF(nh4(i,j,ll,1)<spval.and.rhomid(i,j,ll)<spval)
THEN
2979 grid1(i,j) = nh4(i,j,ll,1)*rhomid(i,j,ll)
2985 if(grib==
"grib2")
then
2987 fld_info(cfld)%ifld=iavblfld(iget(689))
2988 fld_info(cfld)%lvl=lvlsxml(l,iget(689))
2994 datapd(i,j,cfld) = grid1(ii,jj)
3004 IF (iget(644)>0)
THEN
3005 IF (lvls(l,iget(644))>0)
THEN
3010 grid1(i,j) = rhomid(i,j,ll)
3013 if(grib==
"grib2")
then
3015 fld_info(cfld)%ifld=iavblfld(iget(644))
3016 fld_info(cfld)%lvl=lvlsxml(l,iget(644))
3022 datapd(i,j,cfld) = grid1(ii,jj)
3030 IF (iget(645)>0)
THEN
3031 IF (lvls(l,iget(645))>0)
THEN
3036 grid1(i,j) = dpres(i,j,ll)
3039 if(grib==
"grib2")
then
3041 fld_info(cfld)%ifld=iavblfld(iget(645))
3042 fld_info(cfld)%lvl=lvlsxml(l,iget(645))
3048 datapd(i,j,cfld) = grid1(ii,jj)
3129 IF (iget(252) > 0)
THEN
3130 IF(imp_physics /= 8 .and. imp_physics /= 28)
THEN
3135 DO l=1,nint(lmh(i,j))
3136 grid1(i,j) = max( grid1(i,j), dbz(i,j,l) )
3146 IF(imp_physics == 8 .or. imp_physics == 28)
THEN
3148 IF(modelname==
'NMM' .and. gridtype==
'B' .or. &
3149 modelname==
'NCAR'.or. modelname==
'FV3R' .or. &
3150 modelname==
'GFS' .or. &
3151 modelname==
'NMM' .and. gridtype==
'E')
THEN
3156 DO l=1,nint(lmh(i,j))
3157 grid1(i,j) = max( grid1(i,j), ref_10cm(i,j,l) )
3165 grid1(i,j) = refc_10cm(i,j)
3169 CALL bound(grid1,dbzmin,dbzmax)
3174 grid1(i,j) = refl(i,j)
3180 if(grib==
"grib2")
then
3182 fld_info(cfld)%ifld=iavblfld(iget(252))
3188 datapd(i,j,cfld) = grid1(ii,jj)
3197 IF (iget(581)>0)
THEN
3201 DO l=1,nint(lmh(i,j))
3202 if(zint(i,j,l) < spval .and.zint(i,j,l+1)<spval.and.dbz(i,j,l)<spval)
then
3203 grid1(i,j)=grid1(i,j)+0.00344* &
3204 (10.**(dbz(i,j,l)/10.))**0.57143*(zint(i,j,l)-zint(i,j,l+1))/1000.
3211 if(grib==
"grib2")
then
3213 fld_info(cfld)%ifld=iavblfld(iget(581))
3219 datapd(i,j,cfld) = grid1(ii,jj)
3227 IF (iget(276)>0)
THEN
3231 DO l=1,nint(lmh(i,j))
3232 grid1(i,j)=max( grid1(i,j), dbzr(i,j,l) )
3236 if(grib==
"grib2")
then
3238 fld_info(cfld)%ifld=iavblfld(iget(276))
3244 datapd(i,j,cfld) = grid1(ii,jj)
3253 IF (iget(277)>0)
THEN
3257 DO l=1,nint(lmh(i,j))
3258 grid1(i,j)=max( grid1(i,j), dbzi(i,j,l) )
3262 if(grib==
"grib2")
then
3264 fld_info(cfld)%ifld=iavblfld(iget(277))
3270 datapd(i,j,cfld) = grid1(ii,jj)
3281 IF (iget(278)>0)
THEN
3285 DO l=1,nint(lmh(i,j))
3286 grid1(i,j)=max( grid1(i,j), dbzc(i,j,l) )
3290 if(grib==
"grib2")
then
3292 fld_info(cfld)%ifld=iavblfld(iget(278))
3298 datapd(i,j,cfld) = grid1(ii,jj)
3308 IF (iget(426)>0)
THEN
3312 DO l=1,nint(lmh(i,j))
3313 IF (dbz(i,j,l)>=18.0)
THEN
3314 grid1(i,j)=zmid(i,j,l)*3.2808/1000.
3320 if(grib==
"grib2")
then
3322 fld_info(cfld)%ifld=iavblfld(iget(426))
3328 datapd(i,j,cfld) = grid1(ii,jj)
3343 IF (iget(768) > 0)
THEN
3344 IF(modelname ==
'RAPR' .AND. (imp_physics == 8 .or. imp_physics == 28))
THEN
3348 DO l=1,nint(lmh(i,j))
3349 IF (ref_10cm(i,j,l)>=18.0)
THEN
3350 grid1(i,j)=zmid(i,j,l)
3354 IF(grid1(i,j) >= -900)
THEN
3355 DO l=1,nint(lmh(i,j))
3356 IF (ref_10cm(i,j,l) >= 11.0)
THEN
3358 grid1(i,j) = zmid(i,j,l)
3359 ELSE IF(ref_10cm(i,j,l-1) == ref_10cm(i,j,l))
THEN
3360 grid1(i,j) = zmid(i,j,l)
3362 grid1(i,j) = zmid(i,j,l) + &
3363 (11.0 - ref_10cm(i,j,l)) * &
3364 (zmid(i,j,l-1) - zmid(i,j,l)) / &
3365 (ref_10cm(i,j,l-1) - ref_10cm(i,j,l))
3377 DO l=1,nint(lmh(i,j))
3378 IF (dbz(i,j,l) >= 18.0)
THEN
3379 grid1(i,j) = zmid(i,j,l)
3386 if(grib==
"grib2")
then
3388 fld_info(cfld)%ifld=iavblfld(iget(768))
3394 datapd(i,j,cfld) = grid1(ii,jj)
3402 IF (iget(769)>0)
THEN
3406 DO l=1,nint(lmh(i,j))
3407 IF(qqr(i,j,l)<spval.and.qqs(i,j,l)<spval.and.qqg(i,j,l)<spval.and.&
3408 zint(i,j,l)<spval.and.zint(i,j,l+1)<spval.and.&
3409 pmid(i,j,l)<spval.and.t(i,j,l)<spval.and.q(i,j,l)<spval)
THEN
3410 IF(qqh(i,j,l)<spval)
THEN
3411 grid1(i,j)=grid1(i,j) + (qqr(i,j,l) + qqh(i,j,l) + &
3412 qqs(i,j,l) + qqg(i,j,l))* &
3413 (zint(i,j,l)-zint(i,j,l+1))*pmid(i,j,l)/ &
3414 (rd*t(i,j,l)*(q(i,j,l)*d608+1.0))
3416 grid1(i,j)=grid1(i,j) + (qqr(i,j,l) + &
3417 qqs(i,j,l) + qqg(i,j,l))* &
3418 (zint(i,j,l)-zint(i,j,l+1))*pmid(i,j,l)/ &
3419 (rd*t(i,j,l)*(q(i,j,l)*d608+1.0))
3427 if(grib==
"grib2")
then
3429 fld_info(cfld)%ifld=iavblfld(iget(769))
3435 datapd(i,j,cfld) = grid1(ii,jj)
3445 IF (iget(770) > 0)
THEN
3446 IF(modelname ==
'RAPR' .AND. (imp_physics == 8 .or. imp_physics == 28))
THEN
3450 DO l=1,nint(lmh(i,j))
3451 IF (ref_10cm(i,j,l) > -10.0 )
THEN
3452 grid1(i,j) = grid1(i,j) + 0.00344 * &
3453 (10.**(ref_10cm(i,j,l)/10.))**0.57143 * &
3454 (zint(i,j,l)-zint(i,j,l+1))/1000.
3463 DO l=1,nint(lmh(i,j))
3464 grid1(i,j) = grid1(i,j) + 0.00344 * &
3465 (10.**(dbz(i,j,l)/10.))**0.57143 * &
3466 (zint(i,j,l)-zint(i,j,l+1))/1000.
3471 if(grib==
"grib2")
then
3473 fld_info(cfld)%ifld=iavblfld(iget(770))
3479 datapd(i,j,cfld) = grid1(ii,jj)
3489 IF (iget(180)>0)
THEN
3497 q1d(i,j)=q(i,j,llmh)
3498 if(q1d(i,j)<=0.) q1d(i,j)=0.
3499 qw1(i,j)=qqw(i,j,llmh)
3500 qr1(i,j)=qqr(i,j,llmh)
3501 qi1(i,j)=qqi(i,j,llmh)
3502 qs1(i,j)=qqs(i,j,llmh)
3503 qg1(i,j)=qqg(i,j,llmh)
3504 t1d(i,j)=t(i,j,llmh)
3505 p1d(i,j)=pmid(i,j,llmh)
3511 IF(imp_physics/=99)
THEN
3512 IF (cprate(i,j) > 0. .and. cprate(i,j) < spval &
3513 .and. pmid(i,j,lm) < spval .and. qr1(i,j) < spval)
THEN
3515 rainrate=(1-sr(i,j))*cprate(i,j)*rdtphs
3517 term1=(t(i,j,lm)/pmid(i,j,lm))**0.4167
3518 term2=(t1d(i,j)/p1d(i,j))**0.5833
3519 term3=rainrate**0.8333
3521 qr1(i,j)=qr1(i,j)+raincon*term1*term2*term3
3522 IF (sr(i,j) > 0. .and. qs1(i,j) < spval)
THEN
3523 snorate=sr(i,j)*cprate(i,j)*rdtphs
3525 term1=(t(i,j,lm)/pmid(i,j,lm))**0.47
3526 term2=(t1d(i,j)/p1d(i,j))**0.53
3528 qs1(i,j)=qs1(i,j)+snocon*term1*term2*term3
3537 IF (prec(i,j) < spval .and. prec(i,j) > 0. .and. &
3540 rainrate=(1-sr(i,j))*prec(i,j)*rdtphs
3542 term1=(t(i,j,lm)/pmid(i,j,lm))**0.4167
3543 term2=(t1d(i,j)/p1d(i,j))**0.5833
3544 term3=rainrate**0.8333
3546 qr1(i,j)=qr1(i,j)+raincon*term1*term2*term3
3547 IF (sr(i,j) > 0.)
THEN
3548 snorate=sr(i,j)*prec(i,j)*rdtphs
3550 term1=(t(i,j,lm)/pmid(i,j,lm))**0.47
3551 term2=(t1d(i,j)/p1d(i,j))**0.53
3553 qs1(i,j)=qs1(i,j)+snocon*term1*term2*term3
3568 CALL calvis(q1d,qw1,qr1,qi1,qs1,t1d,p1d,vis)
3576 IF(vis(i,j)/=spval.and.abs(vis(i,j))>24135.1)print*,
'bad visbility' &
3577 , i,j,q1d(i,j),qw1(i,j),qr1(i,j),qi1(i,j) &
3578 , qs1(i,j),t1d(i,j),p1d(i,j),vis(i,j)
3583 if(grib==
"grib2")
then
3585 fld_info(cfld)%ifld=iavblfld(iget(180))
3586 fld_info(cfld)%lvl=lvlsxml(1,iget(180))
3587 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
3594 IF (iget(410)>0)
THEN
3595 CALL calvis_gsd(czen,vis)
3601 if(grib==
"grib2")
then
3603 fld_info(cfld)%ifld=iavblfld(iget(410))
3604 fld_info(cfld)%lvl=lvlsxml(1,iget(410))
3605 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
3611 IF (iget(748) > 0)
THEN
3616 IF(modelname ==
'RAPR' .AND. (imp_physics == 8 .or. imp_physics == 28))
THEN
3621 grid1(i,j) = ref1km_10cm(i,j)
3624 CALL bound(grid1,dbzmin,dbzmax)
3629 grid1(i,j) = refl1km(i,j)
3635 if(grib==
"grib2")
then
3637 fld_info(cfld)%ifld=iavblfld(iget(748))
3638 fld_info(cfld)%lvl=lvlsxml(1,iget(748))
3639 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
3646 IF (iget(757) > 0)
THEN
3651 IF(modelname ==
'RAPR' .AND. (imp_physics == 8 .or. imp_physics == 28))
THEN
3655 grid1(i,j) = ref4km_10cm(i,j)
3658 CALL bound(grid1,dbzmin,dbzmax)
3663 grid1(i,j) = refl4km(i,j)
3669 if(grib==
"grib2")
then
3671 fld_info(cfld)%ifld=iavblfld(iget(757))
3672 fld_info(cfld)%lvl=lvlsxml(1,iget(757))
3673 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
3678 IF (iget(912)>0)
THEN
3683 if (slp(i,j) < spval)
then
3684 zm10c(i,j)=zmid(i,j,nint(lmh(i,j)))
3685 DO l=nint(lmh(i,j)),1,-1
3686 IF (t(i,j,l) <= 263.15)
THEN
3702 IF(imp_physics==8 .or. imp_physics==28)
THEN
3708 if (slp(i,j) < spval)
then
3709 grid1(i,j)=ref_10cm(i,j,zm10c(i,j))
3719 if (slp(i,j) < spval)
then
3720 grid1(i,j)=dbz(i,j,zm10c(i,j))
3726 CALL bound(grid1,dbzmin,dbzmax)
3728 if(grib==
"grib2" )
then
3730 fld_info(cfld)%ifld=iavblfld(iget(912))
3731 fld_info(cfld)%lvl=lvlsxml(l,iget(912))
3732 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
3739 IF ( (iget(111)>0) .OR. (iget(146)>0) .OR. &
3740 (iget(147)>0) )
THEN
3743 CALL clmax(el0(1,jsta),egrid2(1,jsta),egrid3(1,jsta),egrid4(1,jsta),egrid5(1,jsta))
3746 IF (iget(147)>0)
THEN
3750 grid1(i,j) = el0(i,j)
3753 if(grib==
"grib2")
then
3755 fld_info(cfld)%ifld=iavblfld(iget(147))
3756 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
3763 IF ( (iget(111)>0) .OR. (iget(146)>0) )
THEN
3775 IF(modelname ==
'NCAR'.OR.modelname==
'RSM'.OR. modelname ==
'RAPR')
THEN
3777 ELSE IF(modelname ==
'NMM')
THEN
3781 el(i,j,l)=el_pbl(i,j,l)
3789 IF ( (iget(111)>0) )
CALL calrch(el,richno)
3796 IF (iget(146)>0)
THEN
3799 IF (lvls(l,iget(146))>0)
THEN
3804 grid1(i,j) = el(i,j,ll)
3807 if(grib==
"grib2")
then
3809 fld_info(cfld)%ifld=iavblfld(iget(146))
3810 fld_info(cfld)%lvl=lvlsxml(l,iget(146))
3816 datapd(i,j,cfld) = grid1(ii,jj)
3826 IF (iget(111)>0)
THEN
3827 IF (lvls(l,iget(111))>0)
THEN
3832 grid1(i,j) = richno(i,j,ll)
3835 if(grib==
"grib2")
then
3837 fld_info(cfld)%ifld=iavblfld(iget(111))
3838 fld_info(cfld)%lvl=lvlsxml(l,iget(111))
3844 datapd(i,j,cfld) = grid1(ii,jj)
3860 IF ( (iget(289)>0) .OR. (iget(389)>0) .OR. (iget(454)>0) &
3861 .OR. (iget(245)>0) .or. iget(464)>0 .or. iget(467)>0 &
3862 .or. iget(470)>0 .or. iget(476)>0)
THEN
3866 IF(modelname ==
'GFS')
THEN
3873 IF (iget(289) > 0)
THEN
3877 grid1(i,j) = pblri(i,j)
3881 if(grib==
"grib2")
then
3883 fld_info(cfld)%ifld=iavblfld(iget(289))
3889 datapd(i,j,cfld) = grid1(ii,jj)
3899 IF ( (iget(389) > 0) .OR. (iget(454) > 0) )
THEN
3903 IF(pblri(i,j)<spval.and.zint(i,j,lm+1)<spval)
THEN
3904 egrid3(i,j) = pblri(i,j) + zint(i,j,lm+1)
3911 CALL h2u(egrid3(ista_2l:iend_2u,jsta_2l:jend_2u),egrid4)
3919 vert_loopu:
DO l=lm,1,-1
3920 CALL h2u(zmid(ista_2l:iend_2u,jsta_2l:jend_2u,l), egrid5)
3921 CALL h2u(pint(ista_2l:iend_2u,jsta_2l:jend_2u,l+1),egrid6)
3922 CALL h2u(pint(ista_2l:iend_2u,jsta_2l:jend_2u,l), egrid7)
3926 if (egrid4(i,j)<spval.and.egrid5(i,j)<spval.and.&
3927 egrid6(i,j)<spval.and.egrid7(i,j)<spval.and.&
3928 uh(i,j,1)<spval)
THEN
3929 if (egrid5(i,j) <= egrid4(i,j))
then
3931 dp = egrid6(i,j) - egrid7(i,j)
3932 egrid1(i,j) = egrid1(i,j) + uh(i,j,l)*dp
3933 egrid2(i,j) = egrid2(i,j) + dp
3940 if(hcount < 1 )
exit vert_loopu
3945 IF(egrid2(i,j) > 0.)
THEN
3946 grid1(i,j) = egrid1(i,j)/egrid2(i,j)
3948 grid1(i,j) = u10(i,j)
3950 ustore(i,j) = grid1(i,j)
3954 CALL h2v(egrid3(ista_2l:iend_2u,jsta_2l:jend_2u),egrid4)
3965 vert_loopv:
DO l=lm,1,-1
3966 CALL h2v(zmid(ista_2l:iend_2u,jsta_2l:jend_2u,l), egrid5)
3967 CALL h2v(pint(ista_2l:iend_2u,jsta_2l:jend_2u,l+1),egrid6)
3968 CALL h2v(pint(ista_2l:iend_2u,jsta_2l:jend_2u,l), egrid7)
3972 if (egrid4(i,j)<spval.and.egrid5(i,j)<spval.and.&
3973 egrid6(i,j)<spval.and.egrid7(i,j)<spval.and.&
3974 vh(i,j,1)<spval)
THEN
3975 if (egrid5(i,j) <= egrid4(i,j))
then
3977 dp = egrid6(i,j) - egrid7(i,j)
3978 egrid1(i,j) = egrid1(i,j) + vh(i,j,l)*dp
3979 egrid2(i,j) = egrid2(i,j) + dp
3986 if(hcount<1)
exit vert_loopv
3991 IF(egrid2(i,j) > 0.)
THEN
3992 grid2(i,j) = egrid1(i,j)/egrid2(i,j)
3994 grid2(i,j) = v10(i,j)
3996 vstore(i,j) = grid2(i,j)
4001 CALL u2h(ustore,egrid1)
4002 CALL v2h(vstore,egrid2)
4009 IF (egrid1(i,j)<spval .and. egrid2(i,j)<spval)
THEN
4010 egrid3(i,j) = sqrt((egrid1(i,j)*egrid1(i,j)+egrid2(i,j)*egrid2(i,j)))
4017 IF(iget(389) > 0)
THEN
4018 if(grib==
'grib2')
then
4020 fld_info(cfld)%ifld=iavblfld(iget(389))
4026 datapd(i,j,cfld) = grid1(ii,jj)
4030 fld_info(cfld)%ifld=iavblfld(iget(390))
4036 datapd(i,j,cfld) = grid2(ii,jj)
4048 IF ( (iget(454) > 0) )
THEN
4054 IF (pblri(i,j) /= spval .and. egrid3(i,j)/=spval)
then
4055 grid1(i,j) = egrid3(i,j)*pblri(i,j)
4063 if(grib==
'grib2')
then
4065 fld_info(cfld)%ifld=iavblfld(iget(454))
4071 datapd(i,j,cfld) = grid1(ii,jj)
4080 IF (iget(245)>0 .or. iget(464)>0 .or. iget(467)>0.or. iget(470)>0 .or. iget(476)>0)
THEN
4081 IF (modelname==
'RAPR')
THEN
4083 if(maptype == 6)
then
4084 if(grib==
'grib2')
then
4085 dxm = (dxval / 360.)*(erad*2.*pi)/1.d6
4090 if(grib ==
'grib2')
then
4094 nsmooth = nint(5.*(13500./dxm))
4095 do j = jsta_2l, jend_2u
4096 do i = ista_2l, iend_2u
4097 grid1(i,j)=pblhgust(i,j)
4100 call allgetherv(grid1)
4102 CALL smooth(grid1,sdummy,im,jm,0.5)
4104 do j = jsta_2l, jend_2u
4105 do i = ista_2l, iend_2u
4106 pblhgust(i,j)=grid1(i,j)
4115 if(zint(i,j,nint(lmh(i,j))+1) <spval)
then
4117 zsfc=zint(i,j,nint(lmh(i,j))+1)
4118 loopl:
DO l=nint(lmh(i,j)),1,-1
4119 IF (modelname==
'RAPR' .OR. modelname==
'FV3R')
THEN
4121 pblhold=pblhgust(i,j)
4122 IF(pblhold == spval)
THEN
4130 IF(hgt > pblhold+zsfc)
THEN
4132 IF(lpbl(i,j)>=lp1) lpbl(i,j) = lm
4140 if(lpbl(i,j)<1)print*,
'zero lpbl',i,j,pblri(i,j),lpbl(i,j)
4143 IF (modelname==
'RAPR' .OR. modelname==
'FV3R')
THEN
4144 CALL calgust(lpbl,pblhgust,gust)
4148 IF (iget(245)>0)
THEN
4154 grid1(i,j) = gust(i,j)
4157 if(grib==
'grib2')
then
4159 fld_info(cfld)%ifld=iavblfld(iget(245))
4165 datapd(i,j,cfld) = grid1(ii,jj)
4175 IF (iget(344)>0)
THEN
4176 allocate(pblregime(ista_2l:iend_2u,jsta_2l:jend_2u))
4181 grid1(i,j) = pblregime(i,j)
4184 if(grib==
"grib2")
then
4186 fld_info(cfld)%ifld=iavblfld(iget(344))
4192 datapd(i,j,cfld) = grid1(ii,jj)
4196 deallocate(pblregime)
4208 IF(imp_physics == 8.)
then
4209 DO l=1,nint(lmh(i,j))
4210 IF(ref_10cm(i,j,l) > 18.3)
then
4211 grid1(i,j) = zmid(i,j,l)
4216 DO l=1,nint(lmh(i,j))
4217 IF(dbz(i,j,l) > 18.3)
then
4218 grid1(i,j) = zmid(i,j,l)
4228 if(grib==
"grib2")
then
4230 fld_info(cfld)%ifld=iavblfld(iget(400))
4236 datapd(i,j,cfld) = grid1(ii,jj)
4244 IF(gtg_on .and. (iget(464) > 0 .or. iget(467) > 0 .or. iget(470) > 0))
then
4252 call gtg_algo(im,jm,lm,jsta,jend,jsta_2l,jend_2u,&
4253 uh(ista:iend,:,:),vh(ista:iend,:,:),wh(ista:iend,:,:),&
4254 zmid(ista:iend,:,:),pmid(ista:iend,:,:),t(ista:iend,:,:),&
4255 q(ista:iend,:,:),qqw(ista:iend,:,:),qqr(ista:iend,:,:),&
4256 qqs(ista:iend,:,:),qqg(ista:iend,:,:),qqi(ista:iend,:,:),&
4258 zint(ista:iend,:,lp1),pblh(ista:iend,:),sfcshx(ista:iend,:),&
4259 sfclhx(ista:iend,:),ustar(ista:iend,:),&
4260 z0(ista:iend,:),gdlat(ista:iend,:),gdlon(ista:iend,:),&
4261 dx(ista:iend,:),dy(ista:iend,:),u10(ista:iend,:),v10(ista:iend,:),&
4262 gust(ista:iend,:),avgprec(ista:iend,:),sm(ista:iend,:),sice(ista:iend,:),&
4263 catedr(ista:iend,:,:),mwt(ista:iend,:,:),cit(ista:iend,:,:),&
4264 richno(ista:iend,:,:),gtg(ista:iend,:,:),item)
4274 IF (iget(470)>0)
THEN
4276 IF (lvls(l,iget(470))>0)
THEN
4280 grid1(i,j)=gtg(i,j,ll)
4283 if(grib==
"grib2")
then
4285 fld_info(cfld)%ifld=iavblfld(iget(470))
4286 fld_info(cfld)%lvl=lvlsxml(l,iget(470))
4292 datapd(i,j,cfld) = grid1(ii,jj)
4300 grid1(i,j)=catedr(i,j,ll)
4303 if(grib==
"grib2")
then
4305 fld_info(cfld)%ifld=iavblfld(iget(471))
4306 fld_info(cfld)%lvl=lvlsxml(l,iget(471))
4312 datapd(i,j,cfld) = grid1(ii,jj)
4319 grid1(i,j)=mwt(i,j,ll)
4322 if(grib==
"grib2")
then
4324 fld_info(cfld)%ifld=iavblfld(iget(472))
4325 fld_info(cfld)%lvl=lvlsxml(l,iget(472))
4331 datapd(i,j,cfld) = grid1(ii,jj)
4341 IF(iget(450)>0 .or. iget(480)>0 .or. iget(479)>0 .or. iget(481)>0)
THEN
4348 CALL calcape(itype,dpbnd,dummy,dummy,dummy,idummy,cape,cin, &
4355 if(debugprint .and. i==50 .and. j==jsta .and. me == 0)
then
4356 print*,
'sending input to FIP ',i,j,lm,gdlat(i,j),gdlon(i,j), &
4357 zint(i,j,lp1),cprate(i,j),prec(i,j),avgcprate(i,j),cape(i,j),cin(i,j)
4359 if(debugprint)print*,
'l,P,T,RH,CWM,QQW,QQI,QQR,QQS,QQG,OMEG',&
4360 l,pmid(i,j,l),t(i,j,l),rh3d(i,j,l),cwm(i,j,l), &
4361 q(i,j,l),qqw(i,j,l),qqi(i,j,l), &
4362 qqr(i,j,l),qqs(i,j,l),qqg(i,j,l),&
4363 rh3d(i,j,l),zmid(i,j,l),cwm(i,j,l),omga(i,j,l)
4366 CALL icing_algo(i,j,pmid(i,j,1:lm),t(i,j,1:lm),rh3d(i,j,1:lm) &
4367 ,zmid(i,j,1:lm),omga(i,j,1:lm),wh(i,j,1:lm) &
4368 ,q(i,j,1:lm),cwm(i,j,1:lm),qqw(i,j,1:lm),qqi(i,j,1:lm) &
4369 ,qqr(i,j,1:lm),qqs(i,j,1:lm),qqg(i,j,1:lm) &
4370 ,lm,gdlat(i,j),gdlon(i,j),zint(i,j,lp1) &
4371 ,prec(i,j),cprate(i,j),cape(i,j),cin(i,j) &
4372 ,icing_gfip(i,j,1:lm),icing_gfis(i,j,1:lm))
4398 DEALLOCATE(el, richno, pblri)
4399 if (
allocated(rh3d))
deallocate(rh3d)