28 use vrbls4d,
only: dust, smoke
29 use vrbls3d,
only: t, u, uh, v, vh, wh, q, pmid, t, omga, pint, alpint, &
30 qqr, qqs, qqi, qqg, qqnw, qqni,qqnr, cwm, qqw, qqi, qqr, qqs, extcof55,&
31 f_ice, f_rain, f_rimef, q2, zint, zmid, ttnd, cfr, cfr_raw, qc_bl, ref_10cm, &
32 qqnwfa,qqnifa,taod5503d,aextc55
33 use vrbls2d,
only: tmax, qrmax, htop, hbot, cuppt, fis, cfrach, cfracl, &
34 sr, cfrach, cfracm, wspd10max, w_up_max, w_dn_max, w_mean, refd_max, &
35 up_heli_max, up_heli_max16, grpl_max, up_heli, up_heli16, &
36 up_heli_min,up_heli_min16,up_heli_max02,up_heli_min02, &
37 up_heli_max03,up_heli_min03,rel_vort_max,rel_vort_max01, &
38 wspd10umax,wspd10vmax,refdm10c_max, &
39 hail_max2d,hail_maxk1,hail_maxhailcast,ltg1_max, &
40 ltg2_max, ltg3_max, nci_ltg, nca_ltg, nci_wq, nca_wq, nci_refd, &
41 u10, v10, th10, q10, tshltr, mrshltr, &
42 nca_refd, qv2m, qshltr, smstav, smstot, ssroff, bgroff, sfcevp, &
43 sfcexc, vegfrc, acsnow, cmc, sst, thz0, qz0, uz0, vz0, qs, qvg, &
44 z0, ustar, akhs, akms, radot, ths, acsnom, cuprec, ancprc, acprec, &
45 rainc_bucket, pcp_bucket, cprate, prec, snownc, snow_bucket, &
46 graup_bucket, swddni, swddif, mean_frp, acgraup, acfrain, &
47 graupelnc, albedo, rswin, rswout, swdnbc, swddnic, &
48 swddifc, swupbc, swupt, czen, czmean, rlwin, lwdnbc, lwupbc, &
49 rainnc_bucket, taod5502d, aerasy2d, aerssa2d, lwp, iwp, &
50 sigt4, rlwtoa, rswinc, aswin, aswout, alwin, alwout, alwtoa, aswtoa, &
51 tg, soiltb, twbs, qwbs,grnflx, sfcshx, sfclhx, subshx, snopcx, &
52 sfcuvx, potevp, ncfrcv, ncfrst, sno, si, pctsno, snonc, tsnow, &
53 ivgtyp, isltyp, islope, pblh, pblhgust, f, &
54 qvl1,refc_10cm,ref1km_10cm,ref4km_10cm, &
55 swradmean,u10mean,v10mean,spduv10mean,swnormmean,snfden,sndepac, &
56 hbotd,hbots,rainc_bucket1,rainnc_bucket1,pcp_bucket1,snow_bucket1, &
57 graup_bucket1, shdmin, shdmax, lai, htopd,htops
58 use soil,
only: smc, sh2o, stc, sldpth, sllevel
59 use masks,
only: lmv, lmh, vtm, sice, gdlat, gdlon, sm, dx, dy, htm
60 use ctlblk_mod,
only: jsta_2l, jend_2u, filename, datahandle, datestr, &
61 ihrst, imin, idat, sdat, ifhr, ifmin, imp_physics, jsta, jend, &
62 spval,gdsdegr, modelname, pt, icu_physics, jsta_m, jend_m, nsoil, &
63 isf_surface_physics, nsoil, ardlw, ardsw, asrfc, me, mpi_comm_comp, &
64 nphs, smflag, spl, lsm, dt, prec_acc_dt, dtq2, tsrfc, trdlw, &
65 trdsw, theat, tclod, tprec, nprec, alsl, im, jm, lm, grib, &
66 prec_acc_dt1, submodelname
67 use params_mod,
only: capa, g, rd, d608, tfrz, ad05, cft0, stbol, &
68 p1000, pi, rtd, lheat, dtr, erad
69 use lookup_mod,
only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, &
70 qs0, sqs, sthe, the0, ttblq, rdpq, rdtheq, stheq, the0q
71 use gridspec_mod,
only: gridtype, dxval, latstart, latlast, lonstart, &
72 lonlast, dyval, cenlat, cenlon, maptype, truelat1, truelat2, &
74 use wrf_io_flags_mod,
only:
86 character(len=31) :: VarName
88 character startdate*19,SysDepInfo*80
96 INTEGER IDATE(8),JDATE(8)
101 REAL DUMMY ( IM, JM )
102 REAL DUMMY2 ( IM, JM )
103 real,
allocatable:: msft(:,:)
104 INTEGER IDUMMY ( IM, JM )
105 REAL,
allocatable :: DUM3D ( :, :, : )
107 real,
allocatable:: pvapor(:,:)
108 real,
allocatable:: pvapor_orig(:,:)
109 REAL,
ALLOCATABLE :: THV(:,:,:)
111 integer js,je,jev,iyear,imn,iday,itmp,ioutcount,istatus, &
112 ii,jj,ll,i,j,l,nrdlw,nrdsw,n,igdout,irtn,idyvald, &
113 idxvald,nsrfc , lflip, k, k1
114 real DZ,TSPH,TMP,QMEAN,PVAPORNEW,DUMCST,TLMH,RHO,ZSF,ZPBLTOP
115 real t2,th2,x2m,p2m,tsk, fact, temp
118 integer jdn, numr, ic, jc, ierr
119 integer,
external :: iw3jdn
120 real sun_zenith,sun_azimuth, ptop_low, ptop_mid, ptop_high
121 real delta_theta4gust
127 ALLOCATE ( thv(im,jsta_2l:jend_2u,lm) )
128 ALLOCATE ( dum3d( im+1, jm+1, lm+1 ) )
129 if (me==0)
WRITE(6,*)
'INITPOST_MPAS: ENTER INITPOST_MPAS'
146 do j = jsta_2l, jend_2u
157 do j = jsta_2l, jend_2u
169 call ext_ncd_ioinit(sysdepinfo,status)
171 call ext_ncd_open_for_read( trim(filename), 0, 0,
" ", &
174 if ( status /= 0 .and. me == 0 )
then
175 print*,
'error opening ',filename,
' Status = ', status ; stop
186 IF (jend_2u==jm)
THEN
194 call ext_ncd_get_dom_ti_char(datahandle,
'SIMULATION_START_DATE', &
197 call ext_ncd_get_dom_ti_char(datahandle,
'START_DATE',startdate, &
200 if (me==0) print*,
'startdate= ',startdate
203 read(startdate,15)iyear,imn,iday,ihrst,imin
204 15
format(i4,1x,i2,1x,i2,1x,i2,1x,i2)
206 print*,
'start yr mo day hr min=',iyear,imn,iday,ihrst,imin
207 print*,
'processing yr mo day hr min=' &
208 ,idat(3),idat(1),idat(2),idat(4),idat(5)
225 CALL w3difdat(jdate,idate,0,rinc)
226 ifhr=nint(rinc(2)+rinc(1)*24.)
228 if (me==0) print*,
' in INITPOST_MPAS ifhr ifmin fileName=',ifhr,ifmin,filename
235 call ext_ncd_get_dom_ti_integer(datahandle,
'MP_PHYSICS' &
236 ,itmp,1,ioutcount,istatus)
238 if (me==0) print*,
'MP_PHYSICS= ',itmp
241 if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)
then
242 CALL microinit(imp_physics)
245 call ext_ncd_get_dom_ti_integer(datahandle,
'CU_PHYSICS' &
246 ,itmp,1,ioutcount,istatus)
248 if (me==0) print*,
'CU_PHYSICS= ',icu_physics
251 if (me==0) print*,
'im,jm,lm= ',im,jm,lm
257 call getvariable(filename,datestr,datahandle,varname,dum3d, &
258 im+1,1,jm+1,lm+1,im,js,je,lm)
260 do j = jsta_2l, jend_2u
262 if(dum3d(i,j,l)<spval)
then
263 t( i, j, l ) = dum3d( i, j, l ) + 300.
279 call getvariable(filename,datestr,datahandle,varname,dum3d, &
280 im+1,1,jm+1,lm+1,im+1,js,je,lm)
282 do j = jsta_2l, jend_2u
284 u( i, j, l ) = dum3d( i, j, l )
288 do j = jsta_2l, jend_2u
290 uh(i,j,l) = (dum3d(i,j,l)+dum3d(i+1,j,l))*0.5
296 call getvariable(filename,datestr,datahandle,varname,dum3d, &
297 im+1,1,jm+1,lm+1,im, js,jev,lm)
301 v( i, j, l ) = dum3d( i, j, l )
305 do j = jsta_2l, jend_2u
307 vh(i,j,l) = (dum3d(i,j,l)+dum3d(i,j+1,l))*0.5
314 call getvariable(filename,datestr,datahandle,varname,dum3d, &
315 im+1,1,jm+1,lm+1,im, js,je,lm+1)
327 wh(i,j,l) = (dum3d(i,j,l)+dum3d(i,j,l+1))*0.5
334 call getvariable(filename,datestr,datahandle,varname,dum3d, &
335 im+1,1,jm+1,lm+1,im,js,je,lm)
337 do j = jsta_2l, jend_2u
342 if(dum3d(i,j,l)<spval)
then
343 q( i, j, l ) = dum3d( i, j, l )/(1.0+dum3d( i, j, l ))
359 call getvariable(filename,datestr,datahandle,varname,dum3d, &
360 im+1,1,jm+1,lm+1,im, js,je,lm)
365 do j = jsta_2l, jend_2u
367 if(dum3d(i,j,l)<spval)
then
369 pmid(i,j,l)=dum3d(i,j,l)
370 thv( i, j, l ) = t(i,j,l)*(q(i,j,l)*0.608+1.)
372 t( i, j, l ) = t(i,j,l)*(pmid(i,j,l)*1.e-5)**capa
374 if(abs(t( i, j, l ))>1.0e-3) &
375 omga(i,j,l) = -wh(i,j,l)*pmid(i,j,l)*g/ &
376 (rd*t(i,j,l)*(1.+d608*q(i,j,l)))
396 do j = jsta_2l, jend_2u
398 if((pmid(i,j,ll-1) - pmid(i,j,ll))>=0.)
then
403 pmid(i,j,ll)=0.5*(pmid(i,j,ll+1)+pmid(i,j,ll-1))
423 do j = jsta_2l, jend_2u
425 if((pmid(i,j,ll-1) - pmid(i,j,ll))>=0.)
then
430 pmid(i,j,ll)=pmid(i,j,ll-1) + &
431 fact*(pmid(i,j,ll-1)-pmid(i,j,ll-2))
445 pint(i,j,l)=(pmid(i,j,l-1)+pmid(i,j,l))*0.5
446 alpint(i,j,l)=alog(pint(i,j,l))
452 do j = jsta_2l, jend_2u
460 do j = jsta_2l, jend_2u
462 tmax(i,j)=max(tmax(i,j),t(i,j,lflip))
484 if(imp_physics/=5 .and. imp_physics/=0)
then
486 call getvariable(filename,datestr,datahandle,varname,dum3d, &
487 im+1,1,jm+1,lm+1,im, js,je,lm)
489 do j = jsta_2l, jend_2u
492 if(imp_physics==3)
then
493 if(t(i,j,l) >= tfrz)
then
494 qqw( i, j, l ) = dum3d( i, j, l )
496 qqi( i, j, l ) = dum3d( i, j, l )
499 qqw( i, j, l ) = dum3d( i, j, l )
511 if(imp_physics/=1 .and. imp_physics/=3 &
512 .and. imp_physics/=5 .and. imp_physics/=0)
then
514 call getvariable(filename,datestr,datahandle,varname,dum3d, &
515 im+1,1,jm+1,lm+1,im, js,je,lm)
517 do j = jsta_2l, jend_2u
519 qqi( i, j, l ) = dum3d( i, j, l )
528 if(imp_physics/=5 .and. imp_physics/=0)
then
530 call getvariable(filename,datestr,datahandle,varname,dum3d, &
531 im+1,1,jm+1,lm+1,im, js,je,lm)
533 do j = jsta_2l, jend_2u
536 if(imp_physics == 3)
then
537 if(t(i,j,l) >= tfrz)
then
538 qqr( i, j, l ) = dum3d( i, j, l )
540 qqs( i, j, l ) = dum3d( i, j, l )
543 qqr( i, j, l ) = dum3d( i, j, l )
545 dummy(i,j)=dum3d(i,j,l)
554 do j = jsta_2l, jend_2u
561 do j = jsta_2l, jend_2u
563 qrmax(i,j)=max(qrmax(i,j),qqr(i,j,l))
571 if(imp_physics/=1 .and. imp_physics/=3 .and. &
572 imp_physics/=5 .and. imp_physics/=0)
then
574 call getvariable(filename,datestr,datahandle,varname,dum3d, &
575 im+1,1,jm+1,lm+1,im, js,je,lm)
577 do j = jsta_2l, jend_2u
579 qqs( i, j, l ) = dum3d( i, j, l )
580 dummy(i,j)=dum3d(i,j,l)
588 if(imp_physics==2 .or. imp_physics==6 .or. &
589 imp_physics==8 .or. imp_physics==9 .or. imp_physics==28)
then
591 call getvariable(filename,datestr,datahandle,varname,dum3d, &
592 im+1,1,jm+1,lm+1,im, js,je,lm)
594 do j = jsta_2l, jend_2u
596 qqg( i, j, l ) = dum3d( i, j, l )
604 if(imp_physics==8 .or. imp_physics==9 .or.imp_physics==28)
then
606 call getvariable(filename,datestr,datahandle,varname,dum3d, &
607 im+1,1,jm+1,lm+1,im, js,je,lm)
609 do j = jsta_2l, jend_2u
611 qqni( i, j, l ) = dum3d( i, j, l )
618 call getvariable(filename,datestr,datahandle,varname,dum3d, &
619 im+1,1,jm+1,lm+1,im, js,je,lm)
621 do j = jsta_2l, jend_2u
623 qqnr( i, j, l ) = dum3d( i, j, l )
632 if(imp_physics==28)
then
634 call getvariable(filename,datestr,datahandle,varname,dum3d, &
635 im+1,1,jm+1,lm+1,im, js,je,lm)
637 do j = jsta_2l, jend_2u
639 qqnw( i, j, l ) = dum3d( i, j, l )
646 call getvariable(filename,datestr,datahandle,varname,dum3d, &
647 im+1,1,jm+1,lm+1,im, js,je,lm)
649 do j = jsta_2l, jend_2u
651 qqnwfa( i, j, l ) = dum3d( i, j, l )
658 call getvariable(filename,datestr,datahandle,varname,dum3d, &
659 im+1,1,jm+1,lm+1,im, js,je,lm)
661 do j = jsta_2l, jend_2u
663 qqnifa( i, j, l ) = dum3d( i, j, l )
684 if(imp_physics/=5)
then
687 do j = jsta_2l, jend_2u
689 IF(qqr(i,j,l)<spval)
THEN
690 cwm(i,j,l)=qqr(i,j,l)
692 IF(qqi(i,j,l)<spval)
THEN
693 cwm(i,j,l)=cwm(i,j,l)+qqi(i,j,l)
695 IF(qqw(i,j,l)<spval)
THEN
696 cwm(i,j,l)=cwm(i,j,l)+qqw(i,j,l)
698 IF(qqs(i,j,l)<spval)
THEN
699 cwm(i,j,l)=cwm(i,j,l)+qqs(i,j,l)
701 IF(qqg(i,j,l)<spval)
THEN
702 cwm(i,j,l)=cwm(i,j,l)+qqg(i,j,l)
710 call getvariable(filename,datestr,datahandle,varname,dum3d, &
711 im+1,1,jm+1,lm+1,im, js,je,lm)
713 do j = jsta_2l, jend_2u
715 cwm( i, j, l ) = dum3d( i, j, l )
721 call getvariable(filename,datestr,datahandle,varname,dum3d, &
722 im+1,1,jm+1,lm+1,im, js,je,lm)
724 do j = jsta_2l, jend_2u
726 f_ice( i, j, l ) = dum3d( i, j, l )
732 call getvariable(filename,datestr,datahandle,varname,dum3d, &
733 im+1,1,jm+1,lm+1,im, js,je,lm)
735 do j = jsta_2l, jend_2u
737 f_rain( i, j, l ) = dum3d( i, j, l )
742 varname=
'F_RIMEF_PHY'
743 call getvariable(filename,datestr,datahandle,varname,dum3d, &
744 im+1,1,jm+1,lm+1,im, js,je,lm)
746 do j = jsta_2l, jend_2u
748 f_rimef( i, j, l ) = dum3d( i, j, l )
756 IF(icu_physics == 3 .or. icu_physics == 5) varname=
'CUTOP'
757 call getvariable(filename,datestr,datahandle,varname,dummy, &
758 im,1,jm,1,im,js,je,1)
759 do j = jsta_2l, jend_2u
761 htop( i, j ) = float(lm)-dummy(i,j)+1.0
765 IF(icu_physics == 3 .or. icu_physics == 5) varname=
'CUBOT'
766 call getvariable(filename,datestr,datahandle,varname,dummy, &
767 im,1,jm,1,im,js,je,1)
768 do j = jsta_2l, jend_2u
770 hbot( i, j ) = float(lm)-dummy(i,j)+1.0
775 call getvariable(filename,datestr,datahandle,varname,dummy, &
776 im,1,jm,1,im,js,je,1)
777 do j = jsta_2l, jend_2u
779 cuppt( i, j ) = dummy( i, j )
784 IF(modelname ==
'RAPR')
THEN
785 call getvariable(filename,datestr,datahandle,
'QKE',dum3d, &
786 im+1,1,jm+1,lm+1,im,js,je,lm)
788 do j = jsta_2l, jend_2u
790 q2( i, j, l ) = dum3d( i, j, l ) / 2.0
795 call getvariable(filename,datestr,datahandle,
'TKE',dum3d, &
796 im+1,1,jm+1,lm+1,im,js,je,lm)
798 do j = jsta_2l, jend_2u
800 q2( i, j, l ) = dum3d( i, j, l )
811 call getvariable(filename,datestr,datahandle,varname,dummy, &
812 im,1,jm,1,im,js,je,1)
814 call getvariable(filename,datestr,datahandle,varname,dummy2, &
815 im,1,jm,1,im,js,je,1)
817 call getvariable(filename,datestr,datahandle,varname,pt, &
822 pint(i,j,lm+1) = dummy(i,j)+dummy2(i,j)+pt
824 alpint(i,j,lm+1)=alog(pint(i,j,lm+1))
825 alpint(i,j,1)=alog(pint(i,j,1))
831 call getvariable(filename,datestr,datahandle,varname,dummy, &
832 im,1,jm,1,im,js,je,1)
833 do j = jsta_2l, jend_2u
835 fis( i, j ) = dummy( i, j ) * g
840 call getvariable(filename,datestr,datahandle,varname,dum3d, &
841 im+1,1,jm+1,lm+1,im,js,je,lm+1)
845 zint(i,j,l)=dum3d(i,j,l)
850 call getvariable(filename,datestr,datahandle,varname,dum3d, &
851 im+1,1,jm+1,lm+1,im,js,je,lm+1)
858 zint(i,j,l)=(zint(i,j,l)+dum3d(i,j,l))/g
863 IF(modelname ==
'RAPR')
THEN
866 call getvariable(filename,datestr,datahandle,varname,dummy, &
867 im,1,jm,1,im,js,je,1)
871 if((pint(i,j,lm) - dummy(i,j))>=0.)
then
874 dummy(i,j)=pmid(i,j,lm)*1.001
877 pint(i,j,lm+1)=dummy(i,j)
878 alpint(i,j,lm+1)=alog(pint(i,j,lm+1))
886 allocate(pvapor(im,jsta_2l:jend_2u))
887 allocate(pvapor_orig(im,jsta_2l:jend_2u))
894 dz=zint(i,j,l)-zint(i,j,l+1)
895 rho=pmid(i,j,l)/(rd*t(i,j,l))
899 qmean=0.5*(q(i,j,l)+q(i,j,l+1))
905 pvapor(i,j)=pvapor(i,j)+g*rho*dz*qmean
912 pvapor_orig(i,j)=pvapor(i,j)
919 call exch(pvapor(1,jsta_2l))
923 pvapornew=ad05*(4.*(pvapor(i-1,j)+pvapor(i+1,j) &
924 +pvapor(i,j-1)+pvapor(i,j+1)) &
925 +pvapor(i-1,j-1)+pvapor(i+1,j-1) &
926 +pvapor(i-1,j+1)+pvapor(i+1,j+1)) &
929 pvapor(i,j)=pvapornew
939 pvapor(i,j)=pvapor_orig(i,j)+(pvapor(i,j+1)-pvapor_orig(i,j+1))
948 pvapor(i,j)=pvapor_orig(i,j)+(pvapor(i,j-1)-pvapor_orig(i,j-1))
955 pvapor(i,j)=pvapor_orig(i,j)+(pvapor(i+1,j)-pvapor_orig(i+1,j))
961 pvapor(i,j)=pvapor_orig(i,j)+(pvapor(i-1,j)-pvapor_orig(i-1,j))
966 pint(i,j,lm+1)=pint(i,j,lm+1)+pvapor(i,j)
969 if((pint(i,j,lm) - pint(i,j,lm+1))>=0. )
then
972 pint(i,j,lm+1) = pint(i,j,lm)*1.001
975 alpint(i,j,lm+1)=alog(pint(i,j,lm+1))
980 deallocate(pvapor_orig)
985 IF(modelname ==
'RAPR')
THEN
989 zint(i,j,lm+1)=fis(i,j)/g
999 dummy2(i,j)=htm(i,j,l)*t(i,j,l)*(q(i,j,l)*d608+1.0)*rd* &
1000 (alpint(i,j,l+1)-alpint(i,j,l))+dummy(i,j)
1002 dum3d(i,j,l)=zint(i,j,l)-dummy2(i,j)/g
1004 zint(i,j,l)=dummy2(i,j)/g
1007 dummy(i,j)=dummy2(i,j)
1022 if (me==0) print*,
'Finished deriving geopotential in RAPR application'
1027 IF(modelname ==
'RAPR')
THEN
1032 fact=(alog(pmid(i,j,l))-alpint(i,j,l))/ &
1033 max(1.e-6,(alpint(i,j,l+1)-alpint(i,j,l)))
1034 zmid(i,j,l)=zint(i,j,l)+(zint(i,j,l+1)-zint(i,j,l))*fact
1035 dummy(i,j)=zmid(i,j,l)
1048 zint(i,j,l+1) =amin1(zint(i,j,l)-2.,zint(i,j,l+1))
1049 zmid(i,j,l)=(zint(i,j,l+1)+zint(i,j,l))*0.5
1051 dummy(i,j)=zmid(i,j,lm)
1061 zmid(i,j,l)=(zint(i,j,l+1)+zint(i,j,l))*0.5
1074 if(imp_physics==28)
then
1075 varname=
'AOD3D_SMOKE'
1076 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1077 im+1,1,jm+1,lm+1,im, js,je,lm)
1079 do j = jsta_2l, jend_2u
1081 taod5503d( i, j, l ) = dum3d( i, j, l )
1082 dz = zint( i, j, l ) - zint( i, j, l+1 )
1083 aextc55( i, j, l ) = taod5503d( i, j, l ) / dz
1085 if( me==0 .and. i==im/2 .and. j==(jsta+jend)/2 )
then
1086 print*,
'sample TAOD5503D= ',i,j,l,taod5503d( i, j, l )
1087 print*,
'sample dz= ',dz
1088 print*,
'sample AEXTC55= ',i,j,l,aextc55( i, j, l )
1097 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1098 im+1,1,jm+1,lm+1,im,js,je,nsoil)
1100 do j = jsta_2l, jend_2u
1106 smc( i, j, l ) = dum3d( i, j, nsoil-l+1)
1112 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1113 im+1,1,jm+1,lm+1,im,js,je,nsoil)
1115 do j = jsta_2l, jend_2u
1117 sh2o( i, j, l ) = dum3d( i, j, nsoil-l+1)
1123 call getvariable(filename,datestr,datahandle,varname,dummy, &
1124 im,1,jm,1,im,js,je,1)
1126 do j = jsta_2l, jend_2u
1128 sice( i, j ) = dummy( i, j )
1133 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1134 im+1,1,jm+1,lm+1,im,js,je,nsoil)
1136 do j = jsta_2l, jend_2u
1139 stc( i, j, l ) = dum3d( i, j, nsoil-l+1)
1145 do j = jsta_2l, jend_2u
1147 cfrach( i, j ) = spval/100.
1148 cfracl ( i, j ) = spval/100.
1149 cfracm ( i, j ) = spval/100.
1154 do j = jsta_2l, jend_2u
1156 cfr( i, j, l ) = spval
1162 call getvariable(filename,datestr,datahandle,varname,dummy, &
1163 im,1,jm,1,im,js,je,1)
1164 do j = jsta_2l, jend_2u
1166 sr( i, j ) = dummy( i, j )
1171 IF(modelname ==
'RAPR')
THEN
1173 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1174 im+1,1,jm+1,lm+1,im,js,je,lm)
1176 do j = jsta_2l, jend_2u
1178 cfr( i, j, l ) = dum3d( i, j, l )
1184 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1185 im+1,1,jm+1,lm+1,im,js,je,lm)
1187 do j = jsta_2l, jend_2u
1189 cfr( i, j, l ) = dum3d( i, j, l )
1196 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1197 im+1,1,jm+1,lm+1,im,js,je,lm)
1201 do j = jsta_2l, jend_2u
1203 qc_bl( i, j, l ) = dum3d( i, j, l )
1209 IF(modelname ==
'NCAR' .OR. modelname ==
'RAPR')
THEN
1210 if(imp_physics/=5 .and. imp_physics/=0)
then
1212 IF(modelname ==
'RAPR')
THEN
1219 do j = jsta_2l, jend_2u
1226 if (pmid(i,j,k) >= ptop_low)
then
1227 cfracl(i,j)=max(cfracl(i,j),cfr(i,j,k))
1228 elseif (pmid(i,j,k) < ptop_low .and. pmid(i,j,k) >= ptop_mid)
then
1229 cfracm(i,j)=max(cfracm(i,j),cfr(i,j,k))
1230 elseif (pmid(i,j,k) < ptop_mid .and. pmid(i,j,k) >= ptop_high)
then
1231 cfrach(i,j)=max(cfrach(i,j),cfr(i,j,k))
1246 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1247 im+1,1,jm+1,lm+1,im,js,je,lm)
1249 do j = jsta_2l, jend_2u
1251 smoke( i, j, l, 1) = dum3d( i, j, l )
1272 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1273 im+1,1,jm+1,lm+1,im,js,je,lm)
1277 do j = jsta_2l, jend_2u
1280 dust( i, j, l, 1) = dum3d( i, j, l )
1286 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1287 im+1,1,jm+1,lm+1,im,js,je,lm)
1291 do j = jsta_2l, jend_2u
1294 dust( i, j, l, 2) = dum3d( i, j, l )
1300 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1301 im+1,1,jm+1,lm+1,im,js,je,lm)
1305 do j = jsta_2l, jend_2u
1308 dust( i, j, l, 3) = dum3d( i, j, l )
1314 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1315 im+1,1,jm+1,lm+1,im,js,je,lm)
1319 do j = jsta_2l, jend_2u
1322 dust( i, j, l, 4) = dum3d( i, j, l )
1328 call getvariable(filename,datestr,datahandle,varname,dum3d, &
1329 im+1,1,jm+1,lm+1,im,js,je,lm)
1333 do j = jsta_2l, jend_2u
1336 dust( i, j, l, 5) = dum3d( i, j, l )
1343 call getvariable(filename,datestr,datahandle,varname,dum3d,&
1344 im+1,1,jm+1,lm+1,im,js,je,lm)
1348 do j = jsta_2l, jend_2u
1350 dust( i, j, l, 6) = dum3d( i, j, l )
1355 call getvariable(filename,datestr,datahandle,varname,dum3d,&
1356 im+1,1,jm+1,lm+1,im,js,je,lm)
1360 do j = jsta_2l, jend_2u
1362 dust( i, j, l, 7) = dum3d( i, j, l )
1368 call getvariable(filename,datestr,datahandle,varname,dum3d,&
1369 im+1,1,jm+1,lm+1,im,js,je,lm)
1373 do j = jsta_2l, jend_2u
1375 dust( i, j, l, 8) = dum3d( i, j, l )
1388 IF(isf_surface_physics==3)
then
1396 sllevel = (/ 0.0, 0.01, 0.04, 0.1, 0.3, 0.6, 1.0, 1.6, 3.0 /)
1398 call getvariable(filename,datestr,datahandle,
'DZS',sldpth, &
1399 nsoil,1,1,1,nsoil,1,1,1)
1400 if (me==0) print*,
'SLDPTH= ',(sldpth(n),n=1,nsoil)
1407 call getvariable(filename,datestr,datahandle,varname,dummy, &
1408 im,1,jm,1,im,js,je,1)
1409 do j = jsta_2l, jend_2u
1411 wspd10max( i, j ) = dummy( i, j )
1416 varname=
'WSPD10UMAX'
1417 call getvariable(filename,datestr,datahandle,varname,dummy, &
1418 im,1,jm,1,im,js,je,1)
1419 do j = jsta_2l, jend_2u
1421 wspd10umax( i, j ) = dummy( i, j )
1426 varname=
'WSPD10VMAX'
1427 call getvariable(filename,datestr,datahandle,varname,dummy, &
1428 im,1,jm,1,im,js,je,1)
1429 do j = jsta_2l, jend_2u
1431 wspd10vmax( i, j ) = dummy( i, j )
1437 call getvariable(filename,datestr,datahandle,varname,dummy, &
1438 im,1,jm,1,im,js,je,1)
1439 do j = jsta_2l, jend_2u
1441 w_up_max( i, j ) = dummy( i, j )
1448 call getvariable(filename,datestr,datahandle,varname,dummy, &
1449 im,1,jm,1,im,js,je,1)
1450 do j = jsta_2l, jend_2u
1452 w_dn_max( i, j ) = dummy( i, j )
1458 call getvariable(filename,datestr,datahandle,varname,dummy, &
1459 im,1,jm,1,im,js,je,1)
1460 do j = jsta_2l, jend_2u
1462 w_mean( i, j ) = dummy( i, j )
1468 call getvariable(filename,datestr,datahandle,varname,dummy, &
1469 im,1,jm,1,im,js,je,1)
1470 do j = jsta_2l, jend_2u
1472 refd_max( i, j ) = dummy( i, j )
1477 varname=
'REFDM10C_MAX'
1478 call getvariable(filename,datestr,datahandle,varname,dummy, &
1479 im,1,jm,1,im,js,je,1)
1480 do j = jsta_2l, jend_2u
1482 refdm10c_max( i, j ) = dummy( i, j )
1488 varname=
'UP_HELI_MAX'
1489 call getvariable(filename,datestr,datahandle,varname,dummy, &
1490 im,1,jm,1,im,js,je,1)
1491 do j = jsta_2l, jend_2u
1493 up_heli_max( i, j ) = dummy( i, j )
1498 varname=
'UP_HELI_MAX16'
1499 call getvariable(filename,datestr,datahandle,varname,dummy, &
1500 im,1,jm,1,im,js,je,1)
1501 do j = jsta_2l, jend_2u
1503 up_heli_max16( i, j ) = dummy( i, j )
1508 varname=
'UP_HELI_MIN'
1509 call getvariable(filename,datestr,datahandle,varname,dummy, &
1510 im,1,jm,1,im,js,je,1)
1511 do j = jsta_2l, jend_2u
1513 up_heli_min( i, j ) = dummy( i, j )
1518 varname=
'UP_HELI_MIN16'
1519 call getvariable(filename,datestr,datahandle,varname,dummy, &
1520 im,1,jm,1,im,js,je,1)
1521 do j = jsta_2l, jend_2u
1523 up_heli_min16( i, j ) = dummy( i, j )
1528 varname=
'UP_HELI_MAX02'
1529 call getvariable(filename,datestr,datahandle,varname,dummy, &
1530 im,1,jm,1,im,js,je,1)
1531 do j = jsta_2l, jend_2u
1533 up_heli_max02( i, j ) = dummy( i, j )
1538 varname=
'UP_HELI_MIN02'
1539 call getvariable(filename,datestr,datahandle,varname,dummy, &
1540 im,1,jm,1,im,js,je,1)
1541 do j = jsta_2l, jend_2u
1543 up_heli_min02( i, j ) = dummy( i, j )
1548 varname=
'UP_HELI_MAX03'
1549 call getvariable(filename,datestr,datahandle,varname,dummy, &
1550 im,1,jm,1,im,js,je,1)
1551 do j = jsta_2l, jend_2u
1553 up_heli_max03( i, j ) = dummy( i, j )
1558 varname=
'UP_HELI_MIN03'
1559 call getvariable(filename,datestr,datahandle,varname,dummy, &
1560 im,1,jm,1,im,js,je,1)
1561 do j = jsta_2l, jend_2u
1563 up_heli_min03( i, j ) = dummy( i, j )
1568 varname=
'REL_VORT_MAX'
1569 call getvariable(filename,datestr,datahandle,varname,dummy, &
1570 im,1,jm,1,im,js,je,1)
1571 do j = jsta_2l, jend_2u
1573 rel_vort_max( i, j ) = dummy( i, j )
1578 varname=
'REL_VORT_MAX01'
1579 call getvariable(filename,datestr,datahandle,varname,dummy, &
1580 im,1,jm,1,im,js,je,1)
1581 do j = jsta_2l, jend_2u
1583 rel_vort_max01( i, j ) = dummy( i, j )
1589 call getvariable(filename,datestr,datahandle,varname,dummy, &
1590 im,1,jm,1,im,js,je,1)
1591 do j = jsta_2l, jend_2u
1593 grpl_max( i, j ) = dummy( i, j )
1599 varname=
'HAIL_MAXK1'
1600 call getvariable(filename,datestr,datahandle,varname,dummy, &
1601 im,1,jm,1,im,js,je,1)
1602 do j = jsta_2l, jend_2u
1604 hail_maxk1( i, j ) = dummy( i, j )
1609 varname=
'HAIL_MAX2D'
1610 call getvariable(filename,datestr,datahandle,varname,dummy, &
1611 im,1,jm,1,im,js,je,1)
1612 do j = jsta_2l, jend_2u
1614 hail_max2d( i, j ) = dummy( i, j )
1619 varname=
'HAILCAST_DIAM_MAX'
1620 call getvariable(filename,datestr,datahandle,varname,dummy, &
1621 im,1,jm,1,im,js,je,1)
1622 do j = jsta_2l, jend_2u
1624 hail_maxhailcast( i, j ) = dummy( i, j )
1630 call getvariable(filename,datestr,datahandle,varname,dummy, &
1631 im,1,jm,1,im,js,je,1)
1632 do j = jsta_2l, jend_2u
1634 up_heli( i, j ) = dummy( i, j )
1640 call getvariable(filename,datestr,datahandle,varname,dummy, &
1641 im,1,jm,1,im,js,je,1)
1642 do j = jsta_2l, jend_2u
1644 up_heli16( i, j ) = dummy( i, j )
1650 call getvariable(filename,datestr,datahandle,varname,dummy, &
1651 im,1,jm,1,im,js,je,1)
1652 do j = jsta_2l, jend_2u
1654 ltg1_max( i, j ) = dummy( i, j )
1660 call getvariable(filename,datestr,datahandle,varname,dummy, &
1661 im,1,jm,1,im,js,je,1)
1662 do j = jsta_2l, jend_2u
1664 ltg2_max( i, j ) = dummy( i, j )
1670 call getvariable(filename,datestr,datahandle,varname,dummy, &
1671 im,1,jm,1,im,js,je,1)
1672 do j = jsta_2l, jend_2u
1674 ltg3_max( i, j ) = dummy( i, j )
1680 call getvariable(filename,datestr,datahandle,varname,dummy, &
1681 im,1,jm,1,im,js,je,1)
1682 do j = jsta_2l, jend_2u
1684 nci_ltg( i, j ) = dummy( i, j )
1690 call getvariable(filename,datestr,datahandle,varname,dummy, &
1691 im,1,jm,1,im,js,je,1)
1692 do j = jsta_2l, jend_2u
1694 nca_ltg( i, j ) = dummy( i, j )
1700 call getvariable(filename,datestr,datahandle,varname,dummy, &
1701 im,1,jm,1,im,js,je,1)
1702 do j = jsta_2l, jend_2u
1704 nci_wq( i, j ) = dummy( i, j )
1710 call getvariable(filename,datestr,datahandle,varname,dummy, &
1711 im,1,jm,1,im,js,je,1)
1712 do j = jsta_2l, jend_2u
1714 nca_wq( i, j ) = dummy( i, j )
1720 call getvariable(filename,datestr,datahandle,varname,dummy, &
1721 im,1,jm,1,im,js,je,1)
1722 do j = jsta_2l, jend_2u
1724 nci_refd( i, j ) = dummy( i, j )
1730 call getvariable(filename,datestr,datahandle,varname,dummy, &
1731 im,1,jm,1,im,js,je,1)
1732 do j = jsta_2l, jend_2u
1734 nca_refd( i, j ) = dummy( i, j )
1743 call getvariable(filename,datestr,datahandle,varname,dum3d,&
1744 im+1,1,jm+1,lm+1,im,js,je,lm)
1746 do j = jsta_2l, jend_2u
1748 ref_10cm( i, j, l) = dum3d( i, j, l )
1754 varname=
'COMPOSITE_REFL_10CM'
1755 call getvariable(filename,datestr,datahandle,varname,dummy, &
1756 im,1,jm,1,im,js,je,1)
1757 do j = jsta_2l, jend_2u
1759 refc_10cm( i, j ) = dummy( i, j )
1763 varname=
'REFL_10CM_1KM'
1764 call getvariable(filename,datestr,datahandle,varname,dummy, &
1765 im,1,jm,1,im,js,je,1)
1766 do j = jsta_2l, jend_2u
1768 ref1km_10cm( i, j ) = dummy( i, j )
1772 varname=
'REFL_10CM_4KM'
1773 call getvariable(filename,datestr,datahandle,varname,dummy, &
1774 im,1,jm,1,im,js,je,1)
1775 do j = jsta_2l, jend_2u
1777 ref4km_10cm( i, j ) = dummy( i, j )
1784 call getvariable(filename,datestr,datahandle,varname,dummy, &
1785 im,1,jm,1,im,js,je,1)
1786 do j = jsta_2l, jend_2u
1788 IF(submodelname ==
'RTMA' .and. modelname ==
'RAPR')
THEN
1789 u10( i, j ) = uh( i, j, lm )
1791 u10( i, j ) = dummy( i, j )
1796 call getvariable(filename,datestr,datahandle,varname,dummy, &
1797 im,1,jm,1,im,js,je,1)
1798 do j = jsta_2l, jend_2u
1800 IF( submodelname ==
'RTMA' .and. modelname ==
'RAPR')then
1801 v10( i, j ) = vh( i, j, lm )
1803 v10( i, j ) = dummy( i, j )
1811 call getvariable(filename,datestr,datahandle,varname,dummy, &
1812 im,1,jm,1,im,js,je,1)
1813 do j = jsta_2l, jend_2u
1815 u10mean( i, j ) = dummy( i, j )
1821 call getvariable(filename,datestr,datahandle,varname,dummy, &
1822 im,1,jm,1,im,js,je,1)
1823 do j = jsta_2l, jend_2u
1825 v10mean( i, j ) = dummy( i, j )
1830 varname=
'SPDUV10MEAN'
1831 call getvariable(filename,datestr,datahandle,varname,dummy, &
1832 im,1,jm,1,im,js,je,1)
1833 do j = jsta_2l, jend_2u
1835 spduv10mean( i, j ) = dummy( i, j )
1841 do j = jsta_2l, jend_2u
1843 th10( i, j ) = spval
1844 q10 ( i, j ) = spval
1850 call getvariable(filename,datestr,datahandle,varname,dummy, &
1851 im,1,jm,1,im,js,je,1)
1852 do j = jsta_2l, jend_2u
1854 tshltr( i, j ) = dummy( i, j )
1860 call getvariable(filename,datestr,datahandle,varname,dummy, &
1861 im,1,jm,1,im,js,je,1)
1862 do j = jsta_2l, jend_2u
1864 mrshltr( i, j ) = dummy(i, j )
1865 IF(modelname ==
'RAPR')
THEN
1870 qv2m( i, j ) = dummy( i, j )
1871 qshltr( i, j ) = dummy( i, j )/(1.0+dummy( i, j ))
1872 qvl1( i, j ) = q( i, j, lm )
1876 qv2m( i, j ) = dummy( i, j )
1877 qshltr( i, j ) = dummy( i, j )/(1.0+dummy( i, j ))
1883 IF(modelname ==
'RAPR')
THEN
1889 call getvariable(filename,datestr,datahandle,varname,dummy, &
1890 im,1,jm,1,im,js,je,1)
1891 do j = jsta_2l, jend_2u
1893 smstav( i, j ) = dummy( i, j )
1908 call getvariable(filename,datestr,datahandle,varname,dummy, &
1909 im,1,jm,1,im,js,je,1)
1910 do j = jsta_2l, jend_2u
1912 ssroff( i, j ) = dummy( i, j )
1916 call getvariable(filename,datestr,datahandle,varname,dummy, &
1917 im,1,jm,1,im,js,je,1)
1918 do j = jsta_2l, jend_2u
1920 bgroff( i, j ) = dummy( i, j )
1944 call getvariable(filename,datestr,datahandle,varname,dummy, &
1945 im,1,jm,1,im,js,je,1)
1946 do j = jsta_2l, jend_2u
1948 vegfrc( i, j ) = dummy( i, j )/100.
1951 if (me==0) print*,
'VEGFRC at ',ii,jj,
' = ',vegfrc(ii,jj)
1954 call getvariable(filename,datestr,datahandle,varname,dummy, &
1955 im,1,jm,1,im,js,je,1)
1956 do j = jsta_2l, jend_2u
1958 shdmin( i, j ) = dummy( i, j )/100.
1961 if (me==0) print*,
'SHDMIN at ',ii,jj,
' = ',shdmin(ii,jj)
1964 call getvariable(filename,datestr,datahandle,varname,dummy, &
1965 im,1,jm,1,im,js,je,1)
1966 do j = jsta_2l, jend_2u
1968 shdmax( i, j ) = dummy( i, j )/100.
1971 if (me==0) print*,
'SHDMAX at ',ii,jj,
' = ',shdmax(ii,jj)
1974 call getvariable(filename,datestr,datahandle,varname,dummy, &
1975 im,1,jm,1,im,js,je,1)
1976 do j = jsta_2l, jend_2u
1978 lai( i, j ) = dummy( i, j )
1981 if (me==0) print*,
'LAI at ',ii,jj,
' = ',lai(ii,jj)
1984 call getvariable(filename,datestr,datahandle,varname,dummy, &
1985 im,1,jm,1,im,js,je,1)
1986 do j = jsta_2l, jend_2u
1988 acsnow( i, j ) = dummy( i, j )
1991 if (me==0) print*,
'maxval ACSNOW: ', maxval(acsnow)
1993 call getvariable(filename,datestr,datahandle,varname,dummy, &
1994 im,1,jm,1,im,js,je,1)
1995 do j = jsta_2l, jend_2u
1997 acsnom( i, j ) = dummy( i, j )
2001 call getvariable(filename,datestr,datahandle,varname,dummy, &
2002 im,1,jm,1,im,js,je,1)
2003 do j = jsta_2l, jend_2u
2005 cmc( i, j ) = dummy( i, j )
2009 call getvariable(filename,datestr,datahandle,varname,dummy, &
2010 im,1,jm,1,im,js,je,1)
2011 do j = jsta_2l, jend_2u
2013 sst( i, j ) = dummy( i, j )
2018 call getvariable(filename,datestr,datahandle,varname,dummy, &
2019 im,1,jm,1,im,js,je,1)
2020 do j = jsta_2l, jend_2u
2022 thz0( i, j ) = dummy( i, j )
2064 IF(modelname ==
'RAPR')
THEN
2066 call getvariable(filename,datestr,datahandle,varname,dummy, &
2067 im,1,jm,1,im,js,je,1)
2068 do j = jsta_2l, jend_2u
2070 z0( i, j ) = dummy( i, j )
2075 call getvariable(filename,datestr,datahandle,varname,dummy, &
2076 im,1,jm,1,im,js,je,1)
2077 do j = jsta_2l, jend_2u
2079 z0( i, j ) = dummy( i, j )
2086 call getvariable(filename,datestr,datahandle,varname,dummy, &
2087 im,1,jm,1,im,js,je,1)
2088 do j = jsta_2l, jend_2u
2090 ustar( i, j ) = dummy( i, j )
2121 call getvariable(filename,datestr,datahandle,varname,dummy, &
2122 im,1,jm,1,im,js,je,1)
2123 do j = jsta_2l, jend_2u
2128 radot( i, j ) = dummy(i,j)**4.0/stbol
2129 ths( i, j ) = dummy( i, j ) &
2130 *(p1000/pint(i,j,nint(lmh(i,j))+1))**capa
2136 IF(modelname ==
'RAPR')
THEN
2138 call getvariable(filename,datestr,datahandle,varname,dummy, &
2139 im,1,jm,1,im,js,je,1)
2140 do j = jsta_2l, jend_2u
2142 radot( i, j ) = radot(i, j) * dummy( i, j )
2153 if (me==0)
write(6,*)
'getting RAINC'
2155 call getvariable(filename,datestr,datahandle,varname,dummy, &
2156 im,1,jm,1,im,js,je,1)
2157 do j = jsta_2l, jend_2u
2159 cuprec( i, j ) = dummy( i, j ) * 0.001
2163 if (me==0)
write(6,*)
'getting RAINNC'
2165 call getvariable(filename,datestr,datahandle,varname,dummy, &
2166 im,1,jm,1,im,js,je,1)
2167 do j = jsta_2l, jend_2u
2169 ancprc( i, j ) = dummy( i, j )* 0.001
2173 if (me==0)
write(6,*)
'past getting RAINNC'
2175 do j = jsta_2l, jend_2u
2177 acprec(i,j)=ancprc(i,j)+cuprec(i,j)
2183 if (me==0)
write(6,*)
'getting PREC_ACC_C, [mm] '
2185 varname=
'PREC_ACC_C'
2186 call getvariable(filename,datestr,datahandle,varname,dummy, &
2187 im,1,jm,1,im,js,je,1)
2188 do j = jsta_2l, jend_2u
2190 rainc_bucket( i, j ) = dummy( i, j )
2196 if (me==0)
write(6,*)
'getting PREC_ACC_C1, [mm] '
2197 varname=
'PREC_ACC_C1'
2198 call getvariable(filename,datestr,datahandle,varname,dummy, &
2199 im,1,jm,1,im,js,je,1)
2200 do j = jsta_2l, jend_2u
2202 rainc_bucket1( i, j ) = dummy( i, j )
2208 if (me==0)
write(6,*)
'getting PREC_ACC_NC, [mm]'
2210 varname=
'PREC_ACC_NC'
2211 call getvariable(filename,datestr,datahandle,varname,dummy, &
2212 im,1,jm,1,im,js,je,1)
2213 do j = jsta_2l, jend_2u
2215 rainnc_bucket( i, j ) = dummy( i, j )
2221 if (me==0)
write(6,*)
'getting PREC_ACC_NC1, [mm]'
2222 varname=
'PREC_ACC_NC1'
2223 call getvariable(filename,datestr,datahandle,varname,dummy, &
2224 im,1,jm,1,im,js,je,1)
2225 do j = jsta_2l, jend_2u
2227 rainnc_bucket1( i, j ) = dummy( i, j )
2231 do j = jsta_2l, jend_2u
2233 pcp_bucket(i,j)=rainc_bucket(i,j)+rainnc_bucket(i,j)
2234 pcp_bucket1(i,j)=rainc_bucket1(i,j)+rainnc_bucket1(i,j)
2240 call getvariable(filename,datestr,datahandle,varname,dummy, &
2241 im,1,jm,1,im,js,je,1)
2242 do j = jsta_2l, jend_2u
2245 cprate( i, j ) = dummy( i, j )* 0.001
2252 call getvariable(filename,datestr,datahandle,varname,dummy2, &
2253 im,1,jm,1,im,js,je,1)
2254 do j = jsta_2l, jend_2u
2257 prec( i, j ) = (dummy( i, j )+dummy2(i,j))* 0.001
2262 call getvariable(filename,datestr,datahandle,varname,dummy, &
2263 im,1,jm,1,im,js,je,1)
2264 do j = jsta_2l, jend_2u
2267 snownc( i, j ) = dummy( i, j ) * 0.001
2273 if (me==0)
write(6,*)
'getting SNOW_ACC_NC, [mm] '
2275 varname=
'SNOW_ACC_NC'
2276 call getvariable(filename,datestr,datahandle,varname,dummy, &
2277 im,1,jm,1,im,js,je,1)
2278 do j = jsta_2l, jend_2u
2280 snow_bucket( i, j ) = dummy( i, j )
2286 if (me==0)
write(6,*)
'getting SNOW_ACC_NC1, [mm] '
2287 varname=
'SNOW_ACC_NC1'
2288 call getvariable(filename,datestr,datahandle,varname,dummy, &
2289 im,1,jm,1,im,js,je,1)
2290 do j = jsta_2l, jend_2u
2292 snow_bucket1( i, j ) = dummy( i, j )
2298 if (me==0)
write(6,*)
'getting GRAUP_ACC_NC, [mm] '
2299 varname=
'GRAUP_ACC_NC'
2300 call getvariable(filename,datestr,datahandle,varname,dummy, &
2301 im,1,jm,1,im,js,je,1)
2302 do j = jsta_2l, jend_2u
2304 graup_bucket( i, j ) = dummy( i, j )
2310 if (me==0)
write(6,*)
'getting GRAUP_ACC_NC1, [mm] '
2311 varname=
'GRAUP_ACC_NC1'
2312 call getvariable(filename,datestr,datahandle,varname,dummy, &
2313 im,1,jm,1,im,js,je,1)
2314 do j = jsta_2l, jend_2u
2316 graup_bucket1( i, j ) = dummy( i, j )
2321 call getvariable(filename,datestr,datahandle,varname,dummy, &
2322 im,1,jm,1,im,js,je,1)
2323 do j = jsta_2l, jend_2u
2325 acgraup( i, j ) = dummy( i, j )
2330 call getvariable(filename,datestr,datahandle,varname,dummy, &
2331 im,1,jm,1,im,js,je,1)
2332 do j = jsta_2l, jend_2u
2334 acfrain( i, j ) = dummy( i, j )
2338 varname=
'GRAUPELNCV'
2339 call getvariable(filename,datestr,datahandle,varname,dummy, &
2340 im,1,jm,1,im,js,je,1)
2341 do j = jsta_2l, jend_2u
2344 graupelnc( i, j ) = dummy( i, j ) * 0.001
2350 call getvariable(filename,datestr,datahandle,varname,dummy, &
2351 im,1,jm,1,im,js,je,1)
2352 do j = jsta_2l, jend_2u
2354 albedo( i, j ) = dummy( i, j )
2372 call getvariable(filename,datestr,datahandle,varname,dummy, &
2373 im,1,jm,1,im,js,je,1)
2374 do j = jsta_2l, jend_2u
2377 rswin( i, j ) = dummy( i, j )
2378 rswout( i, j ) = rswin( i, j ) * albedo( i, j )
2384 call getvariable(filename,datestr,datahandle,varname,dummy, &
2385 im,1,jm,1,im,js,je,1)
2386 do j = jsta_2l, jend_2u
2388 swddni( i, j ) = dummy( i, j )
2394 call getvariable(filename,datestr,datahandle,varname,dummy, &
2395 im,1,jm,1,im,js,je,1)
2396 do j = jsta_2l, jend_2u
2398 swddif( i, j ) = dummy( i, j )
2404 call getvariable(filename,datestr,datahandle,varname,dummy, &
2405 im,1,jm,1,im,js,je,1)
2406 do j = jsta_2l, jend_2u
2408 swdnbc( i, j ) = dummy( i, j )
2414 call getvariable(filename,datestr,datahandle,varname,dummy, &
2415 im,1,jm,1,im,js,je,1)
2416 do j = jsta_2l, jend_2u
2418 swddnic( i, j ) = dummy( i, j )
2424 call getvariable(filename,datestr,datahandle,varname,dummy, &
2425 im,1,jm,1,im,js,je,1)
2426 do j = jsta_2l, jend_2u
2428 swddifc( i, j ) = dummy( i, j )
2434 call getvariable(filename,datestr,datahandle,varname,dummy, &
2435 im,1,jm,1,im,js,je,1)
2436 do j = jsta_2l, jend_2u
2438 swupbc( i, j ) = dummy( i, j )
2444 call getvariable(filename,datestr,datahandle,varname,dummy, &
2445 im,1,jm,1,im,js,je,1)
2446 do j = jsta_2l, jend_2u
2448 swupt( i, j ) = dummy( i, j )
2457 call getvariable(filename,datestr,datahandle,varname,dummy, &
2458 im,1,jm,1,im,js,je,1)
2459 do j = jsta_2l, jend_2u
2461 mean_frp( i, j ) = dummy( i, j )
2467 call getvariable(filename,datestr,datahandle,varname,dummy, &
2468 im,1,jm,1,im,js,je,1)
2469 do j = jsta_2l, jend_2u
2471 taod5502d( i, j ) = dummy( i, j )
2477 call getvariable(filename,datestr,datahandle,varname,dummy, &
2478 im,1,jm,1,im,js,je,1)
2479 do j = jsta_2l, jend_2u
2481 aerasy2d( i, j ) = dummy( i, j )
2487 call getvariable(filename,datestr,datahandle,varname,dummy, &
2488 im,1,jm,1,im,js,je,1)
2489 do j = jsta_2l, jend_2u
2491 aerssa2d( i, j ) = dummy( i, j )
2497 call getvariable(filename,datestr,datahandle,varname,dummy, &
2498 im,1,jm,1,im,js,je,1)
2499 do j = jsta_2l, jend_2u
2501 lwp( i, j ) = dummy( i, j )
2507 call getvariable(filename,datestr,datahandle,varname,dummy, &
2508 im,1,jm,1,im,js,je,1)
2509 do j = jsta_2l, jend_2u
2511 iwp( i, j ) = dummy( i, j )
2517 call getvariable(filename,datestr,datahandle,varname,dummy, &
2518 im,1,jm,1,im,js,je,1)
2519 do j = jsta_2l, jend_2u
2522 swradmean( i, j ) = dummy( i, j )
2525 if (me==0) print*,
'SWRADmean at ',ii,jj,
' = ',swradmean(ii,jj)
2528 varname=
'SWNORMMEAN'
2529 call getvariable(filename,datestr,datahandle,varname,dummy, &
2530 im,1,jm,1,im,js,je,1)
2531 do j = jsta_2l, jend_2u
2534 swnormmean( i, j ) = dummy( i, j )
2537 if (me==0) print*,
'SWNORMmean at ',ii,jj,
' = ',swnormmean(ii,jj)
2541 call getvariable(filename,datestr,datahandle,varname,dummy, &
2542 im,1,jm,1,im,js,je,1)
2543 do j = jsta_2l, jend_2u
2545 rlwin( i, j ) = dummy( i, j )
2549 do j = jsta_2l, jend_2u
2551 tlmh=t(i,j,nint(lmh(i,j)))
2552 sigt4( i, j ) = 5.67e-8*tlmh*tlmh*tlmh*tlmh
2558 call getvariable(filename,datestr,datahandle,varname,dummy, &
2559 im,1,jm,1,im,js,je,1)
2560 do j = jsta_2l, jend_2u
2562 lwdnbc( i, j ) = dummy( i, j )
2568 call getvariable(filename,datestr,datahandle,varname,dummy, &
2569 im,1,jm,1,im,js,je,1)
2570 do j = jsta_2l, jend_2u
2572 lwupbc( i, j ) = dummy( i, j )
2578 call getvariable(filename,datestr,datahandle,varname,dummy, &
2579 im,1,jm,1,im,js,je,1)
2580 do j = jsta_2l, jend_2u
2582 rlwtoa( i, j ) = dummy( i, j )
2588 do j = jsta_2l, jend_2u
2606 call getvariable(filename,datestr,datahandle,varname,dummy, &
2607 im,1,jm,1,im,js,je,1)
2608 do j = jsta_2l, jend_2u
2610 tg( i, j ) = dummy( i, j )
2611 soiltb( i, j ) = dummy( i, j )
2616 call getvariable(filename,datestr,datahandle,varname,dummy, &
2617 im,1,jm,1,im,js,je,1)
2618 do j = jsta_2l, jend_2u
2620 twbs(i,j)= dummy( i, j )
2627 IF(isf_surface_physics/=3)
then
2629 call getvariable(filename,datestr,datahandle,varname,dummy, &
2630 im,1,jm,1,im,js,je,1)
2631 do j = jsta_2l, jend_2u
2633 qwbs(i,j) = dummy( i, j )
2639 call getvariable(filename,datestr,datahandle,varname,dummy, &
2640 im,1,jm,1,im,js,je,1)
2641 do j = jsta_2l, jend_2u
2643 qwbs(i,j) = dummy( i, j ) * lheat
2650 call getvariable(filename,datestr,datahandle,varname,dummy, &
2651 im,1,jm,1,im,js,je,1)
2652 do j = jsta_2l, jend_2u
2654 grnflx(i,j) = dummy( i, j )
2659 do j = jsta_2l, jend_2u
2677 call getvariable(filename,datestr,datahandle,varname,dummy, &
2678 im,1,jm,1,im,js,je,1)
2679 do j = jsta_2l, jend_2u
2681 if( dummy( i, j ) < spval)
then
2682 if( dummy( i, j ) <= 5000.0 .and. dummy( i, j ) >=0.0)
then
2683 sno( i, j ) = dummy( i, j )
2684 elseif( dummy( i, j ) > 5000.0)
then
2685 sno( i, j ) = 5000.0
2687 elseif( dummy( i, j ) < 0.0 )
then
2689 write(*,*)
'negative SNOW=',i,j,dummy( i, j )
2692 write(*,*)
'strange SNOW=',i,j,dummy( i, j )
2699 call getvariable(filename,datestr,datahandle,varname,dummy, &
2700 im,1,jm,1,im,js,je,1)
2701 do j = jsta_2l, jend_2u
2703 if( dummy( i, j ) < spval)
then
2704 if( dummy( i, j ) <= 50.0 .and. dummy( i, j ) >=0.0)
then
2705 si( i, j ) = dummy( i, j ) * 1000.
2706 elseif( dummy( i, j ) > 50.0)
then
2707 si( i, j ) = 50.0 * 1000.
2709 elseif( dummy( i, j ) < 0.0 )
then
2711 write(*,*)
'negative SNOWH=',i,j,dummy( i, j )
2714 write(*,*)
'strange SNOWH=',i,j,dummy( i, j )
2722 call getvariable(filename,datestr,datahandle,varname,dummy, &
2723 im,1,jm,1,im,js,je,1)
2724 do j = jsta_2l, jend_2u
2726 pctsno( i, j ) = dummy( i, j )
2732 call getvariable(filename,datestr,datahandle,varname,dummy, &
2733 im,1,jm,1,im,js,je,1)
2734 do j = jsta_2l, jend_2u
2736 snonc( i, j ) = dummy( i, j )
2742 call getvariable(filename,datestr,datahandle,varname,dummy, &
2743 im,1,jm,1,im,js,je,1)
2744 do j = jsta_2l, jend_2u
2746 snfden( i, j ) = max(0.,dummy( i, j ))
2749 if (me==0) print *,
' MIN/MAX SNFDEN ',minval(snfden),maxval(snfden)
2752 varname=
'SNOWFALLAC'
2753 call getvariable(filename,datestr,datahandle,varname,dummy, &
2754 im,1,jm,1,im,js,je,1)
2755 do j = jsta_2l, jend_2u
2757 sndepac( i, j ) = dummy( i, j )
2760 if (me==0) print *,
' MIN/MAX SNDEPAC ',minval(sndepac),maxval(sndepac)
2764 call getvariable(filename,datestr,datahandle,varname,dummy, &
2765 im,1,jm,1,im,js,je,1)
2766 do j = jsta_2l, jend_2u
2768 tsnow( i, j ) = dummy( i, j )
2774 call getivariablen(filename,datestr,datahandle,
'IVGTYP',idummy, &
2775 im,1,jm,1,im,js,je,1)
2777 do j = jsta_2l, jend_2u
2779 ivgtyp( i, j ) = idummy( i, j )
2784 call getivariablen(filename,datestr,datahandle,varname,idummy, &
2785 im,1,jm,1,im,js,je,1)
2786 do j = jsta_2l, jend_2u
2788 isltyp( i, j ) = idummy( i, j )
2791 if (me==0) print*,
'MAX ISLTYP=', maxval(idummy)
2805 call getvariable(filename,datestr,datahandle,varname,dummy, &
2806 im,1,jm,1,im,js,je,1)
2807 do j = jsta_2l, jend_2u
2809 sm( i, j ) = dummy( i, j ) - 1.0
2815 call getvariable(filename,datestr,datahandle,varname,dummy, &
2816 im,1,jm,1,im,js,je,1)
2817 do j = jsta_2l, jend_2u
2819 pblh( i, j ) = dummy( i, j )
2822 IF(modelname ==
'RAPR')
THEN
2824 delta_theta4gust=0.5
2825 do j = jsta_2l, jend_2u
2828 if (thv(i,j,lm-1) < (thv(i,j,lm) + delta_theta4gust))
then
2829 zsf=zint(i,j,nint(lmh(i,j))+1)
2835 if (thv(i,j,lm-k+1)>(thv(i,j,lm) + delta_theta4gust)) &
2841 zpbltop = zmid(i,j,lm-k1+1) + &
2842 ((thv(i,j,lm)+delta_theta4gust)-thv(i,j,lm-k1+1)) &
2843 * (zmid(i,j,lm-k1+2)-zmid(i,j,lm-k1+1)) &
2844 / (thv(i,j,lm-k1+2) - thv(i,j,lm-k1+1))
2845 pblhgust( i, j ) = zpbltop - zsf
2847 pblhgust( i, j ) = 0.
2854 call getvariable(filename,datestr,datahandle,varname,dummy, &
2855 im,1,jm,1,im,js,je,1)
2856 do j = jsta_2l, jend_2u
2858 gdlat( i, j ) = dummy( i, j )
2860 f(i,j) = 1.454441e-4*sin(gdlat(i,j)*dtr)
2867 call getvariable(filename,datestr,datahandle,varname,dummy, &
2868 im,1,jm,1,im,js,je,1)
2869 do j = jsta_2l, jend_2u
2871 gdlon( i, j ) = dummy( i, j )
2883 latstart=nint(dummy(1,1)*gdsdegr)
2884 latlast=nint(dummy(im,jm)*gdsdegr)
2890 write(6,*)
'laststart,latlast B calling bcast= ',latstart,latlast
2891 call mpi_bcast(latstart,1,mpi_integer,0,mpi_comm_comp,irtn)
2892 call mpi_bcast(latlast,1,mpi_integer,0,mpi_comm_comp,irtn)
2893 write(6,*)
'laststart,latlast A calling bcast= ',latstart,latlast
2896 if(dummy(1,1)<0.0) dummy(1,1)=360.0+dummy(1,1)
2897 if(dummy(im,jm)<0.0) dummy(im,jm)=360.0+dummy(im,jm)
2898 lonstart=nint(dummy(1,1)*gdsdegr)
2899 lonlast=nint(dummy(im,jm)*gdsdegr)
2905 write(6,*)
'lonstart,lonlast B calling bcast=',lonstart,lonlast
2906 call mpi_bcast(lonstart,1,mpi_integer,0,mpi_comm_comp,irtn)
2907 call mpi_bcast(lonlast,1,mpi_integer,0,mpi_comm_comp,irtn)
2908 write(6,*)
'lonstart,lonlast A calling bcast= ',lonstart,lonlast
2914 allocate(msft(im,jsta_2l:jend_2u))
2916 call getvariable(filename,datestr,datahandle,varname,dummy, &
2917 im,1,jm,1,im,js,je,1)
2918 do j = jsta_2l, jend_2u
2920 msft( i, j ) = dummy( i, j )
2926 call getivariablen(filename,datestr,datahandle,varname,nphs, &
2932 IF(modelname /=
'RAPR')
THEN
2933 do j = jsta_2l, jend_2u
2936 czmean( i, j ) = czen( i, j )
2941 jdn=iw3jdn(idat(3),idat(1),idat(2))
2944 call zensun(jdn,float(idat(4)),gdlat(i,j),gdlon(i,j) &
2945 ,pi,sun_zenith,sun_azimuth)
2948 czmean( i, j ) = czen( i, j )
2951 if (me==0) print*,
'sample RAPR zenith angle=',acos(czen(ii,jj))*rtd
2955 write(6,*)
'filename in INITPOST_MPAS=', filename,
' is'
2976 call ext_ncd_get_dom_ti_integer(datahandle,
'MAP_PROJ',itmp, &
2977 1,ioutcount,istatus)
2979 write(6,*)
'maptype is ', maptype
2981 call ext_ncd_get_dom_ti_real(datahandle,
'DX',tmp, &
2982 1,ioutcount,istatus)
2985 write(6,*)
'dxval= ',tmp
2988 write(6,*)
'dxval= ',dxval
2991 call ext_ncd_get_dom_ti_real(datahandle,
'DY',tmp, &
2992 1,ioutcount,istatus)
2995 write(6,*)
'dyval= ',tmp
2998 write(6,*)
'dyval= ',dyval
3001 call ext_ncd_get_dom_ti_real(datahandle,
'CEN_LAT',tmp, &
3002 1,ioutcount,istatus)
3003 cenlat=nint(gdsdegr*tmp)
3004 write(6,*)
'cenlat= ', cenlat
3006 call ext_ncd_get_dom_ti_real(datahandle,
'CEN_LON',tmp, &
3007 1,ioutcount,istatus)
3008 if(tmp < 0) tmp=360.0 + tmp
3009 cenlon=nint(gdsdegr*tmp)
3010 write(6,*)
'cenlon= ', cenlon
3012 call ext_ncd_get_dom_ti_integer(datahandle,
'MAP_PROJ',itmp, &
3013 1,ioutcount,istatus)
3015 write(6,*)
'maptype is ', maptype
3018 call ext_ncd_get_dom_ti_real(datahandle,
'TRUELAT1',tmp, &
3019 1,ioutcount,istatus)
3020 truelat1=nint(gdsdegr*tmp)
3021 write(6,*)
'truelat1= ', truelat1
3024 call ext_ncd_get_dom_ti_real(datahandle,
'TRUELAT2',tmp, &
3025 1,ioutcount,istatus)
3026 truelat2=nint(gdsdegr*tmp)
3027 write(6,*)
'truelat2= ', truelat2
3031 call ext_ncd_get_dom_ti_real(datahandle,
'STAND_LON',tmp, &
3032 1,ioutcount,istatus)
3033 if(tmp < 0) tmp=360.0 + tmp
3034 standlon=nint(gdsdegr*tmp)
3035 write(6,*)
'STANDLON= ', standlon
3038 do j = jsta_2l, jend_2u
3042 dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(i+1,j)-gdlon(i,j))*dtr
3043 dy(i,j) = erad*(gdlat(i,j+1)-gdlat(i,j))*dtr
3046 dx(i,j) = dxval/msft(i,j)
3047 dy(i,j) = dyval/msft(i,j)
3053 if (me==0) print*,
'Sample dx,dy(meters),msft=',dx(ii,jj),dy(ii,jj),msft(ii,jj)
3057 dxval=(dxval * 360.)/(erad*2.*pi)*gdsdegr
3058 dyval=(dyval * 360.)/(erad*2.*pi)*gdsdegr
3060 if (me==0) print*,
'dx and dy for rotated latlon= ', &
3065 IF(modelname ==
'RAPR')
THEN
3103 CALL table(ptbl,ttbl,pt, &
3104 rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0)
3106 CALL tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q)
3111 WRITE(6,*)
' SPL (POSTED PRESSURE LEVELS) BELOW: '
3112 WRITE(6,51) (spl(l),l=1,lsm)
3113 50
FORMAT(14(f4.1,1x))
3114 51
FORMAT(8(f8.1,1x))
3120 call ext_ncd_get_dom_ti_real(datahandle,
'DT',tmp,1,ioutcount,istatus)
3122 if (me==0) print*,
'DT= ',dt
3128 if (me==0) print*,
'PREC_ACC_DT= ',prec_acc_dt
3133 if (me==0) print*,
'PREC_ACC_DT1= ',prec_acc_dt1
3149 tprec=float(nprec)/tsph
3150 IF(nprec==0)tprec=float(ifhr)
3151 if (me==0) print*,
'NPREC,TPREC = ',nprec,tprec
3161 if (me==0) print*,
'TSRFC TRDLW TRDSW= ',tsrfc, trdlw, trdsw
3193 alsl(l) = alog(spl(l))
3218 if ((grib==
"grib2") .and. (maptype/=0))
then