35 use vrbls4d, only: dust, salt, suso, soot, waso, pp25, pp10
36 use vrbls3d, only: t, q, uh, vh,wh,pmid,pint,alpint, dpres,zint,zmid,o3, &
37 qqr, qqs, cwm, qqi, qqw, omga, rhomid, q2, cfr, rlwtt, rswtt, tcucn, &
38 tcucns, train, el_pbl, exch_h, vdifftt, vdiffmois, dconvmois, nradtt, &
39 o3vdiff, o3prod, o3tndy, mwpv, qqg, vdiffzacce, zgdrag,cnvctummixing, &
40 vdiffmacce, mgdrag, cnvctvmmixing, ncnvctcfrac, cnvctumflx, cnvctdmflx, &
41 cnvctzgdrag, sconvmois, cnvctmgdrag, cnvctdetmflx, duwt, duem, dusd, dudp, &
42 dusv,ssem,sssd,ssdp,sswt,sssv,bcem,bcsd,bcdp,bcwt,bcsv,ocem,ocsd,ocdp, &
44 use vrbls2d, only: f, pd, fis, pblh, ustar, z0, ths, qs, twbs, qwbs, avgcprate, &
45 cprate, avgprec, prec, lspa, sno, si, cldefi, th10, q10, tshltr, pshltr, &
46 tshltr, albase, avgalbedo, avgtcdc, czen, czmean, mxsnal, radot, sigt4, &
47 cfrach, cfracl, cfracm, avgcfrach, qshltr, avgcfracl, avgcfracm, cnvcfr, &
48 islope, cmc, grnflx, vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, &
49 bgroff, rlwin, rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, rswinc, &
50 rswout, aswin, auvbin, auvbinc, aswout, aswtoa, sfcshx, sfclhx, subshx, &
51 snopcx, sfcux, sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, smstav, &
52 smstot, ivgtyp, isltyp, sfcevp, sfcexc, acsnow, acsnom, sst, thz0, qz0, &
53 uz0, vz0, ptop, htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, pbotm, ttopm, &
54 ptoph, pboth, pblcfr, ttoph, runoff, maxtshltr, mintshltr, maxrhshltr, &
55 minrhshltr, dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, htops, hbots, &
56 cuppt, dusmass, ducmass, dusmass25, ducmass25, aswintoa, &
57 maxqshltr, minqshltr, acond, sr, u10h, v10h, &
58 avgedir,avgecan,avgetrans,avgesnow,avgprec_cont,avgcprate_cont, &
59 avisbeamswin,avisdiffswin,airbeamswin,airdiffswin, &
60 alwoutc,alwtoac,aswoutc,aswtoac,alwinc,aswinc,avgpotevp,snoavg, &
61 dustcb,bccb,occb,sulfcb,sscb,dustallcb,ssallcb,dustpm,dustpm10,sspm,pp25cb, &
63 use soil, only: sldpth, sh2o, smc, stc
64 use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice
67 use physcons_post, only: grav => con_g, fv => con_fvirt, rgas => con_rd, &
68 eps => con_eps, epsm1 => con_epsm1
69 use params_mod, only: erad, dtr, tfrz, h1, d608, rd, p1000, capa
70 use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, qs0, sqs, sthe, &
71 ttblq, rdpq, rdtheq, stheq, the0q, the0
72 use ctlblk_mod, only: me, mpi_comm_comp, icnt, idsp, jsta, jend, ihrst, idat, sdat, ifhr, &
73 ifmin, filename, tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, td3d, restrt, sdat, &
74 jend_m, imin, imp_physics, dt, spval, pdtop, pt, qmin, nbin_du, nphs, dtq2, ardlw,&
75 ardsw, asrfc, avrain, avcnvc, theat, gdsdegr, spl, lsm, alsl, im, jm, im_jm, lm, &
76 jsta_2l, jend_2u, nsoil, lp1, icu_physics, ivegsrc, novegtype, nbin_ss, nbin_bc, &
77 nbin_oc, nbin_su, gocart_on, gccpp_on, pt_tbl, hyb_sigp, filenameflux, filenameaer, &
78 isf_surface_physics, d2d_chem
79 use gridspec_mod
, only: maptype, gridtype, latstart, latlast, lonstart, lonlast, cenlon, &
80 dxval, dyval, truelat2, truelat1, psmapf, cenlat
86 type(nemsio_gfile
) :: nfile,ffile,rfile
105 real,
parameter :: gravi = 1.0/grav
106 integer,
intent(in) :: iostatusaer
107 character(len=20) :: varname, vcoordname
108 integer :: status, fldsize, fldst, recn
109 integer :: recn_vvel,recn_delz,recn_dpres
110 character startdate*19,sysdepinfo*80,cgar*1
111 character startdate2(19)*4,lprecip_accu*3
118 LOGICAL runb,singlrst,subpost,nest,hydro,ioomg,ioall
119 logical,
parameter :: debugprint = .false., zerout = .false.
121 logical :: reduce_grid = .true.
123 CHARACTER*40 contrl,filall,filmst,filtmp,filtke,filunv,filcld,filrad,filsfc
125 CHARACTER fname*255,envar*50
126 INTEGER idate(8),jdate(8),jpds(200),jgds(200),kpds(200),kgds(200)
140 real,
allocatable :: fi(:,:,:)
142 integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus, &
143 i,j,l,ll,k,kf,irtn,igdout,n,index,nframe, &
144 impf,jmpf,nframed2,iunitd3d,ierr,idum,iret,nrec,idrt
145 real tstart,tlmh,tsph,es,fact,soilayert,soilayerb,zhour,dum, &
146 tvll,pmll,tv, tx1, tx2
148 character*16,
allocatable :: recname(:)
149 character*16,
allocatable :: reclevtyp(:)
150 character*6 :: modelname_nemsio
151 integer,
allocatable :: reclev(:), kmsk(:,:)
152 real,
allocatable :: glat1d(:), glon1d(:), qstl(:)
153 real,
allocatable :: wrk1(:,:), wrk2(:,:)
154 real,
allocatable :: p2d(:,:), t2d(:,:), q2d(:,:), &
155 qs2d(:,:), cw2d(:,:), cfr2d(:,:)
156 real(kind=4),
allocatable :: vcoord4(:,:,:)
157 real,
dimension(lm+1) :: ak5, bk5
158 real*8,
allocatable :: pm2d(:,:), pi2d(:,:)
159 real,
allocatable :: tmp(:)
160 real :: buf(im,jsta_2l:jend_2u)
161 integer :: lonsperlat(jm/2), numi(jm)
167 integer isa, jsa, latghf, jtem, idvc, idsl, nvcoord, ip1, nn, npass
174 integer,
parameter :: npass2=5, npass3=30
175 real,
parameter :: third=1.0/3.0
176 INTEGER,
DIMENSION(2) :: ij4min, ij4max
177 REAL :: omgmin, omgmax
178 real,
allocatable :: d2d(:,:), u2d(:,:), v2d(:,:), omga2d(:,:)
179 REAL,
ALLOCATABLE :: ps2d(:,:),psx2d(:,:),psy2d(:,:)
180 real,
allocatable :: div3d(:,:,:)
181 real(kind=4),
allocatable :: vcrd(:,:)
182 real :: omg1(im), omg2(im+2)
187 WRITE(6,*)
'INITPOST: ENTER INITPOST_GFS_NEMS_MPIIO'
188 WRITE(6,*)
'me=',me,
'LMV=',
size(lmv,1),
size(lmv,2),
'LMH=', &
189 size(lmh,1),
size(lmh,2),
'jsta_2l=',jsta_2l,
'jend_2u=', &
193 jsa = (jsta+jend) / 2
196 do j = jsta_2l, jend_2u
204 call nemsio_open(nfile,trim(filename),
'read',mpi_comm_comp,iret=status)
205 if ( status /= 0 )
then
206 print*,
'error opening ',filename,
' Status = ', status ; stop
208 call nemsio_getfilehead(nfile,iret=status,nrec=nrec,idrt=idrt)
211 call nemsio_open(ffile,trim(filenameflux),
'read',mpi_comm_comp &
213 if ( status /= 0 )
then
214 print*,
'error opening ',filenameflux,
' Status = ', status
223 do j = jsta_2l, jend_2u
234 do j = jsta_2l, jend_2u
243 allocate(recname(nrec),reclevtyp(nrec),reclev(nrec))
244 allocate(glat1d(im*jm),glon1d(im*jm))
245 allocate(vcoord4(lm+1,3,2))
247 call nemsio_getfilehead(nfile,iret=iret &
248 ,idate=idate(1:7),nfhour=nfhour,recname=recname &
249 ,reclevtyp=reclevtyp,reclev=reclev,lat=glat1d &
250 ,lon=glon1d,nframe=nframe,vcoord=vcoord4,idrt=maptype &
251 ,modelname=modelname_nemsio)
252 if(iret/=0)print*,
'error getting idate,nfhour'
253 print *,
'latstar1=',glat1d(1),glat1d(im*jm)
256 print*,
'modelname = ',modelname_nemsio
257 if(trim(modelname_nemsio)==
'FV3GFS')reduce_grid=.false.
263 open (201,file=
'lonsperlat.dat',status=
'old',form=
'formatted', &
264 action=
'read',iostat=iret)
266 read (201,*,iostat=iret) latghf,(lonsperlat(i),i=1,latghf)
268 print*,
'finished reading lonsperlat'
270 if (jm /= latghf+latghf)
then
271 write(0,*)
' wrong reduced grid - execution skipped'
275 numi(j) = lonsperlat(j)
278 numi(j) = lonsperlat(jm+1-j)
293 if (me == 0) print *,
'maptype and gridtype is ', &
299 print *,
'recname,reclevtyp,reclev=',trim(recname(i)),
' ', &
300 trim(reclevtyp(i)),reclev(i)
309 gdlat(i,j) = glat1d(js+i)
310 gdlon(i,j) = glon1d(js+i)
316 ak5(l) = vcoord4(l,1,1)
317 bk5(l) = vcoord4(l,2,1)
322 if ( minval(ak5) <0 .or. minval(bk5) <0 )
then
323 open (202,file=
'global_hyblev.txt',status=
'old',form=
'formatted', &
324 action=
'read',iostat=iret)
328 read (202,*,iostat=iret) ak5(l),bk5(l)
334 vcoord4(l,1,1)=ak5(l)
335 vcoord4(l,2,1)=bk5(l)
338 print *,
'ak5 and bk5 not found, stop !'
349 deallocate(glat1d,glon1d)
351 print*,
'idate = ',(idate(i),i=1,7)
352 print*,
'idate after broadcast = ',(idate(i),i=1,4)
353 print*,
'nfhour = ',nfhour
359 print *,me,
'max(gdlat)=', maxval(gdlat), &
360 'max(gdlon)=', maxval(gdlon)
363 print *,
'after call EXCH,me=',me
369 if (ip1 > im) ip1 = ip1 - im
370 dx(i,j) = erad*cos(gdlat(i,j)*dtr) *(gdlon(ip1,j)-gdlon(i,j))*dtr
371 dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr
381 f(i,j) = 1.454441e-4*sin(gdlat(i,j)*dtr)
387 print*,
'impf,jmpf,nframe= ',impf,jmpf,nframe
397 print*,
'start yr mo day hr min =',iyear,imn,iday,ihrst,imin
398 print*,
'processing yr mo day hr min=' &
399 ,idat(3),idat(1),idat(2),idat(4),idat(5)
415 print *,
' idate=',idate
416 print *,
' jdate=',jdate
418 CALL w3difdat(jdate,idate,0,rinc)
420 print *,
' rinc=',rinc
421 ifhr = nint(rinc(2)+rinc(1)*24.)
422 print *,
' ifhr=',ifhr
423 ifmin = nint(rinc(3))
425 print*,
' in INITPOST ifhr ifmin fileName=',ifhr,ifmin,filename
429 print*,
'tstart= ',tstart
435 IF(tstart > 1.0e-2)
THEN
436 ifhr = ifhr+nint(tstart)
440 call w3movdat(rinc,jdate,idate)
445 print*,
'new forecast hours for restrt run= ',ifhr
446 print*,
'new start yr mo day hr min =',sdat(3),sdat(1) &
450 varname=
'imp_physics'
451 call nemsio_getheadvar(ffile,trim(varname),imp_physics,iret)
453 if(me==0)print*,varname, &
454 " not found in file-Assigned 99 for Zhao"
458 if(me==0)print*,
'MP_PHYSICS= ',imp_physics
460 varname=
'sf_surface_physi'
461 call nemsio_getheadvar(ffile,trim(varname),imp_physics,iret)
463 if(me==0)print*,varname, &
464 " not found in file-Assigned 2 for NOAH"
465 isf_surface_physics=2
468 if(me==0)print*,
'SF_SURFACE_PHYSICS= ',isf_surface_physics
472 call nemsio_getheadvar(ffile,trim(varname),fhzero,iret)
474 if(me==0)print*,varname, &
475 " not found in file-Assign 6 or 12 hours precip bucket"
477 if(ifhr>240)tprec=12.
504 print*,
'tprec, tclod, trdlw = ',tprec,tclod,trdlw
508 if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)
then
509 CALL microinit(imp_physics)
520 fldsize = (jend-jsta+1)*im
521 allocate(tmp(fldsize*nrec))
522 print*,
'allocate tmp successfully'
524 call nemsio_denseread(nfile,1,im,jsta,jend,tmp,iret=iret)
526 print*,
"fail to read sigma file using mpi io read, stopping"
533 print*,
'performing reduced grid'
535 allocate (kmsk(im,jtem))
538 fldst = (recn-1)*fldsize
540 js = fldst + (j-jsta)*im
545 call gg2rg(im,jtem,numi(jsta),buf(1,jsta))
546 call uninterpred(2,kmsk,numi(jsta),im,jtem,buf(1,jsta),tmp(fldst+1))
555 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
557 fldst = (recn-1)*fldsize
560 js = fldst + (j-jsta)*im
566 if(me == 0) print*,
'fail to read ', varname,vcoordname,l
577 if (fis(i,j) /= spval)
then
578 zint(i,j,lp1) = fis(i,j)
579 fis(i,j) = fis(i,j) * grav
583 if(debugprint) print*,
'sample ',varname,
' = ',fis(isa,jsa)
590 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
591 ,l,nrec,fldsize,spval,tmp &
592 ,recname,reclevtyp,reclev,varname,vcoordname &
593 ,pint(1,jsta_2l,lp1))
595 if(debugprint)print*,
'sample surface pressure = ',pint(isa,jsa,lp1)
600 vcoordname =
'mid layer'
607 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
609 fldst = (recn-1)*fldsize
612 js = fldst + (j-jsta)*im
614 t(i,j,ll) = tmp(i+js)
618 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
622 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,t(isa,jsa,ll)
626 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
628 fldst = (recn-1)*fldsize
631 js = fldst + (j-jsta)*im
633 q(i,j,ll) = tmp(i+js)
637 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
641 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,q(isa,jsa,ll)
645 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
647 fldst = (recn-1)*fldsize
650 js = fldst + (j-jsta)*im
652 uh(i,j,ll) = tmp(i+js)
656 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
660 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,uh(isa,jsa,ll)
664 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
666 fldst = (recn-1)*fldsize
669 js = fldst + (j-jsta)*im
671 vh(i,j,ll) = tmp(i+js)
675 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
679 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,vh(isa,jsa,ll)
707 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
709 fldst = (recn-1)*fldsize
712 js = fldst + (j-jsta)*im
714 dpres(i,j,ll) = tmp(i+js)
719 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll, &
720 'will derive pressure using ak bk later'
724 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
726 fldst = (recn-1)*fldsize
729 js = fldst + (j-jsta)*im
731 o3(i,j,ll) = tmp(i+js)
735 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
740 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,o3(isa,jsa,ll)
756 if(imp_physics==99 .or. imp_physics==98)
then
758 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
760 fldst = (recn-1)*fldsize
763 js = fldst + (j-jsta)*im
765 cwm(i,j,ll) = tmp(i+js)
769 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
773 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,cwm(isa,jsa,ll)
778 if(t(i,j,ll) < (tfrz-15.) )
then
779 qqi(i,j,ll) = cwm(i,j,ll)
781 qqw(i,j,ll) = cwm(i,j,ll)
785 else if(imp_physics==11 .or. imp_physics==8)
then
787 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
789 fldst = (recn-1)*fldsize
792 js = fldst + (j-jsta)*im
794 qqw(i,j,ll) = tmp(i+js)
798 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
801 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqw(isa,jsa,ll)
804 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
806 fldst = (recn-1)*fldsize
809 js = fldst + (j-jsta)*im
811 qqi(i,j,ll) = tmp(i+js)
815 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
818 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqi(isa,jsa,ll)
821 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
823 fldst = (recn-1)*fldsize
826 js = fldst + (j-jsta)*im
828 qqr(i,j,ll) = tmp(i+js)
832 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
835 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqr(isa,jsa,ll)
838 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
840 fldst = (recn-1)*fldsize
843 js = fldst + (j-jsta)*im
845 qqs(i,j,ll) = tmp(i+js)
849 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
852 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqs(isa,jsa,ll)
855 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
857 fldst = (recn-1)*fldsize
860 js = fldst + (j-jsta)*im
862 qqg(i,j,ll) = tmp(i+js)
866 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
869 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqg(isa,jsa,ll)
873 cwm(i,j,ll)=qqg(i,j,ll)+qqs(i,j,ll)+qqr(i,j,ll)+qqi(i,j,ll)+qqw(i,j,ll)
882 if(trim(modelname_nemsio)==
'FV3GFS')
then
885 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
887 fldst = (recn-1)*fldsize
890 js = fldst + (j-jsta)*im
892 wh(i,j,ll) = tmp(i+js)
895 if(debugprint)print*,
'sample l ',varname,
' = ',ll,wh(isa,jsa,ll)
897 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll
901 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
903 fldst = (recn-1)*fldsize
906 js = fldst + (j-jsta)*im
908 omga(i,j,ll) = tmp(i+js)
911 if(debugprint)print*,
'sample l ',varname,
' = ',ll,omga(isa,jsa,ll)
914 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll, &
915 'will derive omega later'
921 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
923 fldst = (recn-1)*fldsize
927 js = fldst + (j-jsta)*im
929 zint(i,j,ll)=zint(i,j,ll+1)+abs(tmp(i+js))
930 if(recn_dpres /= -9999)pmid(i,j,ll)=rgas*dpres(i,j,ll)* &
931 t(i,j,ll)*(q(i,j,ll)*fv+1.0)/grav/abs(tmp(i+js))
934 if(debugprint)print*,
'sample l ',varname,
' = ',ll, &
936 if(trim(modelname_nemsio)==
'FV3GFS' .and. &
937 recn_dpres /= -9999)
then
939 js = fldst + (j-jsta)*im
941 omga(i,j,ll)=(-1.)*wh(i,j,ll)*dpres(i,j,ll)/abs(tmp(i+js))
944 if(debugprint)print*,
'sample l omga for FV3',ll, &
949 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll, &
950 'will derive height later'
955 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
957 fldst = (recn-1)*fldsize
960 js = fldst + (j-jsta)*im
962 cfr(i,j,ll)=tmp(i+js)
969 if(imp_physics == 99)
then
970 allocate(p2d(im,lm),t2d(im,lm),q2d(im,lm),cw2d(im,lm), &
971 qs2d(im,lm),cfr2d(im,lm))
975 p2d(i,k) = pmid(i,j,ll)*0.01
978 cw2d(i,k) = cwm(i,j,ll)
979 es = min(
fpvsnew(t(i,j,ll)),pmid(i,j,ll))
980 qs2d(i,k) = eps*es/(pmid(i,j,ll)+epsm1*es)
986 ( p2d,t2d,q2d,qs2d,cw2d,im,lm,0, &
993 cfr(i,j,k) = cfr2d(i,k)
997 deallocate(p2d,t2d,q2d,qs2d,cw2d,cfr2d)
1003 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
1005 fldst = (recn-1)*fldsize
1008 js = fldst + (j-jsta)*im
1010 q2(i,j,ll) = tmp(i+js)
1014 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll
1022 if(debugprint)print*,
'sample l ',varname,
' = ',ll,q2(isa,jsa,ll)
1027 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
1031 js = fldst + (j-jsta)*im
1033 ref_10cm(i,j,ll) = tmp(i+js)
1040 ref_10cm(i,j,ll) = spval
1043 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll
1045 if(debugprint)print*,
'sample l ',varname,
' = ',ll,ref_10cm(isa,jsa,ll)
1062 if (recn_dpres == -9999)
then
1067 pint(i,j,l) = ak5(lm+2-l) + bk5(lm+2-l)*pint(i,j,lp1)
1068 if(recn_delz == -9999)pmid(i,j,l) = 0.5*(pint(i,j,l)+ &
1072 if (me == 0) print*,
'sample pint,pmid' ,ii,jj,l,pint(ii,jj,l),pmid(ii,jj,l)
1089 pint(i,j,1)=ak5(lp1)
1096 pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1)
1099 if (me == 0) print*,
'sample model pint,pmid' ,ii,jj,l &
1109 if (recn_vvel == -9999)
then
1110 allocate(ps2d(im,jsta_2l:jend_2u), psx2d(im,jsta_2l:jend_2u), &
1111 psy2d(im,jsta_2l:jend_2u))
1112 allocate(div3d(im,jsta:jend,lm))
1117 ps2d(i,j) = log(pint(i,j,lm+1))
1122 call
caldiv(uh, vh, div3d)
1125 allocate (vcrd(lm+1,2), d2d(im,lm), u2d(im,lm), v2d(im,lm), &
1126 pi2d(im,lm+1), pm2d(im,lm), omga2d(im,lm))
1132 vcrd(l,1) = vcoord4(l,1,1)
1133 vcrd(l,2) = vcoord4(l,2,1)
1141 if (j > jm-jtem+1)
then
1142 npass = npass + nint(0.5*(j-jm+jtem-1))
1143 elseif (j < jtem)
then
1144 npass = npass + nint(0.5*(jtem-j))
1151 u2d(i,l) = uh(i,j,ll)
1152 v2d(i,l) = vh(i,j,ll)
1153 d2d(i,l) = div3d(i,j,ll)
1157 call
modstuff2(im, im, lm, idvc, idsl, nvcoord, &
1158 vcrd, pint(1,j,lp1), psx2d(1,j), psy2d(1,j), &
1159 d2d, u2d, v2d, pi2d, pm2d, omga2d, me)
1163 if (npass <= 0 )
then
1168 omga(i,j,l) = omga2d(i,ll)
1178 omg1(i) = omga2d(i,ll)
1184 omg2(1) = omg2(im+1)
1185 omg2(im+2) = omg2(2)
1187 omg1(i-1) = third * (omg2(i-1) + omg2(i) + omg2(i+1))
1192 omga(i,j,l) = omg1(i)
1201 if (j ==1 .or. j == jm)
then
1208 tx2 = tx2 + omga(i,j,l)
1219 deallocate (vcrd,d2d,u2d,v2d,pi2d,pm2d,omga2d)
1220 deallocate (ps2d,psx2d,psy2d,div3d)
1222 deallocate (vcoord4)
1227 allocate(wrk1(im,jsta:jend),wrk2(im,jsta:jend))
1228 allocate(fi(im,jsta:jend,2))
1240 alpint(i,j,l)=log(pint(i,j,l))
1245 if (recn_delz == -9999)
then
1248 wrk1(i,j) = log(pmid(i,j,lm))
1249 wrk2(i,j) = t(i,j,lm)*(q(i,j,lm)*fv+1.0)
1250 fi(i,j,1) = fis(i,j) &
1251 + wrk2(i,j)*rgas*(alpint(i,j,lp1)-wrk1(i,j))
1252 zmid(i,j,lm) = fi(i,j,1) * gravi
1260 tvll = t(i,j,ll)*(q(i,j,ll)*fv+1.0)
1261 pmll = log(pmid(i,j,ll))
1263 fi(i,j,2) = fi(i,j,1) + (0.5*rgas)*(wrk2(i,j)+tvll) &
1265 zmid(i,j,ll) = fi(i,j,2) * gravi
1267 fact = (alpint(i,j,l)-wrk1(i,j)) / (pmll-wrk1(i,j))
1268 zint(i,j,l) = zmid(i,j,l) +(zmid(i,j,ll)-zmid(i,j,l))*fact
1269 fi(i,j,1) = fi(i,j,2)
1275 if (me == 0) print*,
'L ZINT= ',l,zint(ii,jj,l), &
1276 'alpint=',alpint(ii,jj,l),
'pmid=',log(pmid(ii,jj,l)), &
1277 'pmid(l-1)=',log(pmid(ii,jj,l-1)),
'zmd=',zmid(ii,jj,l), &
1278 'zmid(l-1)=',zmid(ii,jj,l-1)
1280 deallocate(wrk1,wrk2,fi)
1285 zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* &
1286 (log(pmid(i,j,l))-alpint(i,j,l+1))/ &
1287 (alpint(i,j,l)-alpint(i,j,l+1))
1336 print *,
'gocart_on=',gocart_on
1337 print *,
'gccpp_on=',gccpp_on
1338 if (gocart_on .or. gccpp_on)
then
1346 vcoordname=
'mid layer'
1349 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1350 ,l,nrec,fldsize,spval,tmp &
1351 ,recname,reclevtyp,reclev,varname,vcoordname &
1352 ,dust(1:im,jsta_2l:jend_2u,ll,1))
1359 vcoordname=
'mid layer'
1362 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1363 ,l,nrec,fldsize,spval,tmp &
1364 ,recname,reclevtyp,reclev,varname,vcoordname &
1365 ,dust(1:im,jsta_2l:jend_2u,ll,2))
1367 dustcb(1:im,jsta_2l:jend_2u)=dustcb(1:im,jsta_2l:jend_2u)+ &
1368 (dust(1:im,jsta_2l:jend_2u,ll,1)+0.38*dust(1:im,jsta_2l:jend_2u,ll,2))* &
1369 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1376 vcoordname=
'mid layer'
1379 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1380 ,l,nrec,fldsize,spval,tmp &
1381 ,recname,reclevtyp,reclev,varname,vcoordname &
1382 ,dust(1:im,jsta_2l:jend_2u,ll,3))
1388 vcoordname=
'mid layer'
1391 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1392 ,l,nrec,fldsize,spval,tmp &
1393 ,recname,reclevtyp,reclev,varname,vcoordname &
1394 ,dust(1:im,jsta_2l:jend_2u,ll,4))
1401 vcoordname=
'mid layer'
1404 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1405 ,l,nrec,fldsize,spval,tmp &
1406 ,recname,reclevtyp,reclev,varname,vcoordname &
1407 ,dust(1:im,jsta_2l:jend_2u,ll,5))
1409 dustallcb(1:im,jsta_2l:jend_2u)=dustallcb(1:im,jsta_2l:jend_2u)+ &
1410 (dust(1:im,jsta_2l:jend_2u,ll,1)+dust(1:im,jsta_2l:jend_2u,ll,2)+ &
1411 dust(1:im,jsta_2l:jend_2u,ll,3)+0.74*dust(1:im,jsta_2l:jend_2u,ll,4))* &
1412 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1423 vcoordname=
'mid layer'
1426 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1427 ,l,nrec,fldsize,spval,tmp &
1428 ,recname,reclevtyp,reclev,varname,vcoordname &
1429 ,salt(1:im,jsta_2l:jend_2u,ll,1))
1436 vcoordname=
'mid layer'
1439 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1440 ,l,nrec,fldsize,spval,tmp &
1441 ,recname,reclevtyp,reclev,varname,vcoordname &
1442 ,salt(1:im,jsta_2l:jend_2u,ll,2))
1449 vcoordname=
'mid layer'
1452 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1453 ,l,nrec,fldsize,spval,tmp &
1454 ,recname,reclevtyp,reclev,varname,vcoordname &
1455 ,salt(1:im,jsta_2l:jend_2u,ll,3))
1457 sscb(1:im,jsta_2l:jend_2u)=sscb(1:im,jsta_2l:jend_2u)+ &
1458 (salt(1:im,jsta_2l:jend_2u,ll,1)+ &
1459 salt(1:im,jsta_2l:jend_2u,ll,2)+0.83*salt(1:im,jsta_2l:jend_2u,ll,3))* &
1460 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1467 vcoordname=
'mid layer'
1470 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1471 ,l,nrec,fldsize,spval,tmp &
1472 ,recname,reclevtyp,reclev,varname,vcoordname &
1473 ,salt(1:im,jsta_2l:jend_2u,ll,4))
1479 vcoordname=
'mid layer'
1482 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1483 ,l,nrec,fldsize,spval,tmp &
1484 ,recname,reclevtyp,reclev,varname,vcoordname &
1485 ,salt(1:im,jsta_2l:jend_2u,ll,5))
1487 ssallcb(1:im,jsta_2l:jend_2u)=ssallcb(1:im,jsta_2l:jend_2u)+ &
1488 (salt(1:im,jsta_2l:jend_2u,ll,1)+salt(1:im,jsta_2l:jend_2u,ll,2)+ &
1489 salt(1:im,jsta_2l:jend_2u,ll,3)+ &
1490 salt(1:im,jsta_2l:jend_2u,ll,4))* &
1491 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1501 vcoordname=
'mid layer'
1504 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1505 ,l,nrec,fldsize,spval,tmp &
1506 ,recname,reclevtyp,reclev,varname,vcoordname &
1507 ,soot(1:im,jsta_2l:jend_2u,ll,1))
1514 vcoordname=
'mid layer'
1517 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1518 ,l,nrec,fldsize,spval,tmp &
1519 ,recname,reclevtyp,reclev,varname,vcoordname &
1520 ,soot(1:im,jsta_2l:jend_2u,ll,2))
1522 bccb(1:im,jsta_2l:jend_2u)=bccb(1:im,jsta_2l:jend_2u)+ &
1523 (soot(1:im,jsta_2l:jend_2u,ll,1)+soot(1:im,jsta_2l:jend_2u,ll,2))* &
1524 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1534 vcoordname=
'mid layer'
1537 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1538 ,l,nrec,fldsize,spval,tmp &
1539 ,recname,reclevtyp,reclev,varname,vcoordname &
1540 ,waso(1:im,jsta_2l:jend_2u,ll,1))
1547 vcoordname=
'mid layer'
1550 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1551 ,l,nrec,fldsize,spval,tmp &
1552 ,recname,reclevtyp,reclev,varname,vcoordname &
1553 ,waso(1:im,jsta_2l:jend_2u,ll,2))
1555 occb(1:im,jsta_2l:jend_2u)=occb(1:im,jsta_2l:jend_2u)+ &
1556 (waso(1:im,jsta_2l:jend_2u,ll,1)+waso(1:im,jsta_2l:jend_2u,ll,2)) * &
1557 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1567 vcoordname=
'mid layer'
1570 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1571 ,l,nrec,fldsize,spval,tmp &
1572 ,recname,reclevtyp,reclev,varname,vcoordname &
1573 ,suso(1:im,jsta_2l:jend_2u,ll,1))
1575 sulfcb(1:im,jsta_2l:jend_2u)=sulfcb(1:im,jsta_2l:jend_2u)+ &
1576 suso(1:im,jsta_2l:jend_2u,ll,1)* &
1577 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1587 vcoordname=
'mid layer'
1590 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1591 ,l,nrec,fldsize,spval,tmp &
1592 ,recname,reclevtyp,reclev,varname,vcoordname &
1593 ,pp25(1:im,jsta_2l:jend_2u,ll,1))
1594 pp25cb(1:im,jsta_2l:jend_2u)=pp25cb(1:im,jsta_2l:jend_2u)+ &
1595 pp25(1:im,jsta_2l:jend_2u,ll,1)* &
1596 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1605 vcoordname=
'mid layer'
1608 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1609 ,l,nrec,fldsize,spval,tmp &
1610 ,recname,reclevtyp,reclev,varname,vcoordname &
1611 ,pp10(1:im,jsta_2l:jend_2u,ll,1))
1612 pp10cb(1:im,jsta_2l:jend_2u)=pp10cb(1:im,jsta_2l:jend_2u)+ &
1613 pp10(1:im,jsta_2l:jend_2u,ll,1)* &
1614 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1625 tv = t(i,j,l) * (h1+d608*max(q(i,j,l),qmin))
1626 rhomid(i,j,l) = pmid(i,j,l) / (rd*tv)
1628 IF ( dust(i,j,l,n) < spval)
THEN
1629 dust(i,j,l,n) = max(dust(i,j,l,n), 0.0)
1633 IF ( salt(i,j,l,n) < spval)
THEN
1634 salt(i,j,l,n) = max(salt(i,j,l,n), 0.0)
1638 IF ( waso(i,j,l,n) < spval)
THEN
1639 waso(i,j,l,n) = max(waso(i,j,l,n), 0.0)
1643 IF ( soot(i,j,l,n) < spval)
THEN
1644 soot(i,j,l,n) = max(soot(i,j,l,n), 0.0)
1648 IF ( suso(i,j,l,n) < spval)
THEN
1649 suso(i,j,l,n) = max(suso(i,j,l,n), 0.0)
1660 dustcb(i,j) = max(dustcb(i,j), 0.0)
1661 dustallcb(i,j) = max(dustallcb(i,j), 0.0)
1662 sscb(i,j) = max(sscb(i,j), 0.0)
1663 ssallcb(i,j) = max(ssallcb(i,j), 0.0)
1664 bccb(i,j) = max(bccb(i,j), 0.0)
1665 occb(i,j) = max(occb(i,j), 0.0)
1666 sulfcb(i,j) = max(sulfcb(i,j), 0.0)
1667 pp25cb(i,j) = max(pp25cb(i,j), 0.0)
1668 pp10cb(i,j) = max(pp10cb(i,j), 0.0)
1670 dusmass(i,j)=(dust(i,j,l,1)+dust(i,j,l,2)+dust(i,j,l,3)+ &
1671 0.74*dust(i,j,l,4)+salt(i,j,l,1)+salt(i,j,l,2)+salt(i,j,l,3)+ &
1672 salt(i,j,l,4) + soot(i,j,l,1)+soot(i,j,l,2)+waso(i,j,l,1)+ &
1673 waso(i,j,l,2) +suso(i,j,l,1)+pp25(i,j,l,1)+pp10(i,j,l,1)) &
1676 dustpm(i,j)=(dust(i,j,l,1)+0.38*dust(i,j,l,2))*rhomid(i,j,l)
1677 dustpm10(i,j)=(dust(i,j,l,1)+dust(i,j,l,2)+dust(i,j,l,3)+ &
1678 0.74*dust(i,j,l,4))*rhomid(i,j,l)
1679 sspm(i,j)=(salt(i,j,l,1)+salt(i,j,l,2)+ &
1680 0.83*salt(i,j,l,3))*rhomid(i,j,l)
1682 dusmass25(i,j)=(dust(i,j,l,1)+0.38*dust(i,j,l,2)+ &
1683 salt(i,j,l,1)+salt(i,j,l,2)+0.83*salt(i,j,l,3) + &
1684 soot(i,j,l,1)+soot(i,j,l,2)+waso(i,j,l,1)+ &
1685 waso(i,j,l,2) +suso(i,j,l,1)+pp25(i,j,l,1))*rhomid(i,j,l)
1687 ducmass(i,j)=dustallcb(i,j)+ssallcb(i,j)+bccb(i,j)+ &
1688 occb(i,j)+sulfcb(i,j)+pp25cb(i,j)+pp10cb(i,j)
1690 ducmass25(i,j)=dustcb(i,j)+sscb(i,j)+bccb(i,j)+occb(i,j) &
1691 +sulfcb(i,j)+pp25cb(i,j)
1697 call nemsio_close(nfile,iret=status)
1698 deallocate(tmp,recname,reclevtyp,reclev)
1708 call nemsio_getfilehead(ffile,iret=status,nrec=nrec)
1709 print*,
'nrec for flux file=',nrec
1710 allocate(recname(nrec),reclevtyp(nrec),reclev(nrec))
1711 call nemsio_getfilehead(ffile,iret=iret &
1712 ,recname=recname ,reclevtyp=reclevtyp,reclev=reclev)
1716 print *,
'recname,reclevtyp,reclev=',trim(recname(i)),
' ', &
1717 trim(reclevtyp(i)),reclev(i)
1724 call nemsio_getheadvar(ffile,trim(varname),ivegsrc,iret)
1726 print*,varname,
' not found in file-use 1 for IGBP as default'
1729 if (me == 0) print*,
'IVEGSRC= ',ivegsrc
1734 else if(ivegsrc==1)
then
1736 else if(ivegsrc==0)
then
1739 if (me == 0) print*,
'novegtype= ',novegtype
1741 varname=
'CU_PHYSICS'
1742 call nemsio_getheadvar(ffile,trim(varname),icu_physics,iret)
1744 print*,varname,
" not found in file-Assigned 4 for SAS as default"
1747 if (me == 0) print*,
'CU_PHYSICS= ',icu_physics
1750 call nemsio_getheadvar(ffile,trim(varname),dtp,iret)
1752 print*,varname,
" not found in file-Assigned 225. for dtp as default"
1755 if (me == 0) print*,
'dtp= ',dtp
1788 fldsize = (jend-jsta+1)*im
1789 allocate(tmp(fldsize*nrec))
1790 print*,
'allocate tmp successfully'
1792 call nemsio_denseread(ffile,1,im,jsta,jend,tmp,iret=iret)
1802 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1803 ,l,nrec,fldsize,spval,tmp &
1804 ,recname,reclevtyp,reclev,varname,vcoordname,sm)
1805 if(debugprint)print*,
'sample ',varname,
' =',sm(im/2,(jsta+jend)/2)
1810 if (sm(i,j) /= spval) sm(i,j) = 1.0 - sm(i,j)
1819 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1820 ,l,nrec,fldsize,spval,tmp &
1821 ,recname,reclevtyp,reclev,varname,vcoordname,sice)
1823 if(debugprint)print*,
'sample ',varname,
' = ',sice(isa,jsa)
1836 if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0
1845 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1846 ,l,nrec,fldsize,spval,tmp &
1847 ,recname,reclevtyp,reclev,varname,vcoordname &
1849 if(debugprint)print*,
'sample ',varname,
' = ',pblh(isa,jsa)
1855 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1856 ,l,nrec,fldsize,spval,tmp &
1857 ,recname,reclevtyp,reclev,varname,vcoordname &
1865 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1866 ,l,nrec,fldsize,spval,tmp &
1867 ,recname,reclevtyp,reclev,varname,vcoordname &
1875 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1876 ,l,nrec,fldsize,spval,tmp &
1877 ,recname,reclevtyp,reclev,varname,vcoordname &
1884 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1885 ,l,nrec,fldsize,spval,tmp &
1886 ,recname,reclevtyp,reclev,varname,vcoordname &
1893 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1894 ,l,nrec,fldsize,spval,tmp &
1895 ,recname,reclevtyp,reclev,varname,vcoordname &
1903 if (ths(i,j) /= spval)
then
1905 ths(i,j) = ths(i,j) * (p1000/pint(i,j,lp1))**capa
1911 if (sm(i,j) /= 0.0)
then
1912 if (sice(i,j) >= 0.15)
then
1915 sst(i,j) = ths(i,j) * (pint(i,j,lp1)/p1000)**capa
1936 varname=
'cpratb_ave'
1939 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1940 ,l,nrec,fldsize,spval,tmp &
1941 ,recname,reclevtyp,reclev,varname,vcoordname &
1947 if (avgcprate(i,j) /= spval) avgcprate(i,j) = avgcprate(i,j) * (dtq2*0.001)
1955 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1956 ,l,nrec,fldsize,spval,tmp &
1957 ,recname,reclevtyp,reclev,varname,vcoordname &
1962 if (avgcprate_cont(i,j) /= spval) avgcprate_cont(i,j) = &
1963 avgcprate_cont(i,j) * (dtq2*0.001)
1972 varname=
'prateb_ave'
1975 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1976 ,l,nrec,fldsize,spval,tmp &
1977 ,recname,reclevtyp,reclev,varname,vcoordname &
1983 if (avgprec(i,j) /= spval) avgprec(i,j) = avgprec(i,j) * (dtq2*0.001)
1993 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1994 ,l,nrec,fldsize,spval,tmp &
1995 ,recname,reclevtyp,reclev,varname,vcoordname &
2001 if (avgprec_cont(i,j) /= spval) avgprec_cont(i,j) = avgprec_cont(i,j) &
2012 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2013 ,l,nrec,fldsize,spval,tmp &
2014 ,recname,reclevtyp,reclev,varname,vcoordname &
2021 if (prec(i,j) /= spval) prec(i,j) = prec(i,j) * (dtq2*0.001) &
2030 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2031 ,l,nrec,fldsize,spval,tmp &
2032 ,recname,reclevtyp,reclev,varname,vcoordname &
2037 if (cprate(i,j) /= spval)
then
2038 cprate(i,j) = max(0.,cprate(i,j)) * (dtq2*0.001) * 1000. / dtp
2044 if(debugprint)print*,
'sample ',varname,
' = ',cprate(isa,jsa)
2053 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2054 ,l,nrec,fldsize,spval,tmp &
2055 ,recname,reclevtyp,reclev,varname,vcoordname &
2061 if (sm(i,j) == 1.0 .and. sice(i,j)==0.) sno(i,j) = spval
2070 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2071 ,l,nrec,fldsize,spval,tmp &
2072 ,recname,reclevtyp,reclev,varname,vcoordname &
2077 if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j)=spval
2078 if(snoavg(i,j)/=spval)snoavg(i,j)=snoavg(i,j)/100.
2086 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2087 ,l,nrec,fldsize,spval,tmp &
2088 ,recname,reclevtyp,reclev,varname,vcoordname &
2094 if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval
2095 if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0
2109 vcoordname=
'2 m above gnd'
2111 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2112 ,l,nrec,fldsize,spval,tmp &
2113 ,recname,reclevtyp,reclev,varname,vcoordname &
2120 pshltr(i,j)=pint(i,j,lm+1)*exp(-0.068283/tshltr(i,j))
2121 tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(i,j))**capa
2130 vcoordname=
'2 m above gnd'
2132 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2133 ,l,nrec,fldsize,spval,tmp &
2134 ,recname,reclevtyp,reclev,varname,vcoordname &
2142 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2143 ,l,nrec,fldsize,spval,tmp &
2144 ,recname,reclevtyp,reclev,varname,vcoordname &
2150 if (avgalbedo(i,j) /= spval) avgalbedo(i,j) = avgalbedo(i,j) * 0.01
2157 vcoordname=
'atmos col'
2159 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2160 ,l,nrec,fldsize,spval,tmp &
2161 ,recname,reclevtyp,reclev,varname,vcoordname &
2167 if (avgtcdc(i,j) /= spval) avgtcdc(i,j) = avgtcdc(i,j) * 0.01
2174 do j=jsta_2l,jend_2u
2185 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2186 ,l,nrec,fldsize,spval,tmp &
2187 ,recname,reclevtyp,reclev,varname,vcoordname &
2193 if (mxsnal(i,j) /= spval) mxsnal(i,j) = mxsnal(i,j) * 0.01
2199 do j=jsta_2l,jend_2u
2209 tlmh = t(i,j,lm) * t(i,j,lm)
2210 sigt4(i,j) = 5.67e-8 * tlmh * tlmh
2218 do j=jsta_2l,jend_2u
2228 vcoordname=
'high cld lay'
2230 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2231 ,l,nrec,fldsize,spval,tmp &
2232 ,recname,reclevtyp,reclev,varname,vcoordname &
2238 if (avgcfrach(i,j) /= spval) avgcfrach(i,j) = avgcfrach(i,j) * 0.01
2245 vcoordname=
'low cld lay'
2247 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2248 ,l,nrec,fldsize,spval,tmp &
2249 ,recname,reclevtyp,reclev,varname,vcoordname &
2255 if (avgcfracl(i,j) /= spval) avgcfracl(i,j) = avgcfracl(i,j) * 0.01
2262 vcoordname=
'mid cld lay'
2264 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2265 ,l,nrec,fldsize,spval,tmp &
2266 ,recname,reclevtyp,reclev,varname,vcoordname &
2272 if (avgcfracm(i,j) /= spval) avgcfracm(i,j) = avgcfracm(i,j) * 0.01
2279 vcoordname=
'convect-cld laye'
2281 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2282 ,l,nrec,fldsize,spval,tmp &
2283 ,recname,reclevtyp,reclev,varname,vcoordname &
2289 if (cnvcfr(i,j) /= spval) cnvcfr(i,j)= cnvcfr(i,j) * 0.01
2298 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2299 ,l,nrec,fldsize,spval,tmp &
2300 ,recname,reclevtyp,reclev,varname,vcoordname &
2304 do j = jsta_2l, jend_2u
2306 if (buf(i,j) < spval)
then
2307 islope(i,j) = nint(buf(i,j))
2319 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2320 ,l,nrec,fldsize,spval,tmp &
2321 ,recname,reclevtyp,reclev,varname,vcoordname &
2327 if (cmc(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001
2328 if (sm(i,j) /= 0.0) cmc(i,j) = spval
2334 do j=jsta_2l,jend_2u
2344 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2345 ,l,nrec,fldsize,spval,tmp &
2346 ,recname,reclevtyp,reclev,varname,vcoordname &
2351 if(sr(i,j) /= spval)
then
2353 sr(i,j)=min(1.,max(0.,sr(i,j)))
2362 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2363 ,l,nrec,fldsize,spval,tmp &
2364 ,recname,reclevtyp,reclev,varname,vcoordname &
2369 if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval
2377 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2378 ,l,nrec,fldsize,spval,tmp &
2379 ,recname,reclevtyp,reclev,varname,vcoordname &
2384 if (vegfrc(i,j) /= spval)
then
2385 vegfrc(i,j) = vegfrc(i,j) * 0.01
2395 if (sm(i,j) /= 0.0) vegfrc(i,j) = spval
2409 vcoordname=
'0-10 cm down'
2411 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2412 ,l,nrec,fldsize,spval,tmp &
2413 ,recname,reclevtyp,reclev,varname,vcoordname &
2419 if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval
2425 vcoordname=
'10-40 cm down'
2427 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2428 ,l,nrec,fldsize,spval,tmp &
2429 ,recname,reclevtyp,reclev,varname,vcoordname &
2435 if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval
2441 vcoordname=
'40-100 cm down'
2443 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2444 ,l,nrec,fldsize,spval,tmp &
2445 ,recname,reclevtyp,reclev,varname,vcoordname &
2451 if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval
2457 vcoordname=
'100-200 cm down'
2459 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2460 ,l,nrec,fldsize,spval,tmp &
2461 ,recname,reclevtyp,reclev,varname,vcoordname &
2467 if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval
2474 vcoordname=
'0-10 cm down'
2477 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2478 ,l,nrec,fldsize,spval,tmp &
2479 ,recname,reclevtyp,reclev,varname,vcoordname &
2485 if (sm(i,j) /= 0.0) smc(i,j,1) = spval
2491 vcoordname=
'10-40 cm down'
2493 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2494 ,l,nrec,fldsize,spval,tmp &
2495 ,recname,reclevtyp,reclev,varname,vcoordname &
2501 if (sm(i,j) /= 0.0) smc(i,j,2) = spval
2507 vcoordname=
'40-100 cm down'
2509 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2510 ,l,nrec,fldsize,spval,tmp &
2511 ,recname,reclevtyp,reclev,varname,vcoordname &
2517 if (sm(i,j) /= 0.0) smc(i,j,3) = spval
2523 vcoordname=
'100-200 cm down'
2525 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2526 ,l,nrec,fldsize,spval,tmp &
2527 ,recname,reclevtyp,reclev,varname,vcoordname &
2533 if (sm(i,j) /= 0.0) smc(i,j,4) = spval
2540 vcoordname=
'0-10 cm down'
2542 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2543 ,l,nrec,fldsize,spval,tmp &
2544 ,recname,reclevtyp,reclev,varname,vcoordname &
2550 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval
2557 vcoordname=
'10-40 cm down'
2559 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2560 ,l,nrec,fldsize,spval,tmp &
2561 ,recname,reclevtyp,reclev,varname,vcoordname &
2567 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval
2574 vcoordname=
'40-100 cm down'
2576 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2577 ,l,nrec,fldsize,spval,tmp &
2578 ,recname,reclevtyp,reclev,varname,vcoordname &
2584 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval
2591 vcoordname=
'100-200 cm down'
2593 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2594 ,l,nrec,fldsize,spval,tmp &
2595 ,recname,reclevtyp,reclev,varname,vcoordname &
2601 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval
2627 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2628 ,l,nrec,fldsize,spval,tmp &
2629 ,recname,reclevtyp,reclev,varname,vcoordname &
2636 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2637 ,l,nrec,fldsize,spval,tmp &
2638 ,recname,reclevtyp,reclev,varname,vcoordname &
2645 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2646 ,l,nrec,fldsize,spval,tmp &
2647 ,recname,reclevtyp,reclev,varname,vcoordname &
2653 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2654 ,l,nrec,fldsize,spval,tmp &
2655 ,recname,reclevtyp,reclev,varname,vcoordname &
2662 if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j)
2669 vcoordname=
'nom. top'
2671 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2672 ,l,nrec,fldsize,spval,tmp &
2673 ,recname,reclevtyp,reclev,varname,vcoordname &
2678 do j=jsta_2l,jend_2u
2694 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2695 ,l,nrec,fldsize,spval,tmp &
2696 ,recname,reclevtyp,reclev,varname,vcoordname &
2704 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2705 ,l,nrec,fldsize,spval,tmp &
2706 ,recname,reclevtyp,reclev,varname,vcoordname &
2713 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2714 ,l,nrec,fldsize,spval,tmp &
2715 ,recname,reclevtyp,reclev,varname,vcoordname &
2723 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2724 ,l,nrec,fldsize,spval,tmp &
2725 ,recname,reclevtyp,reclev,varname,vcoordname &
2733 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2734 ,l,nrec,fldsize,spval,tmp &
2735 ,recname,reclevtyp,reclev,varname,vcoordname &
2741 if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j)
2750 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2751 ,l,nrec,fldsize,spval,tmp &
2752 ,recname,reclevtyp,reclev,varname,vcoordname &
2757 vcoordname=
'nom. top'
2759 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2760 ,l,nrec,fldsize,spval,tmp &
2761 ,recname,reclevtyp,reclev,varname,vcoordname &
2768 vcoordname=
'nom. top'
2770 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2771 ,l,nrec,fldsize,spval,tmp &
2772 ,recname,reclevtyp,reclev,varname,vcoordname &
2781 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2782 ,l,nrec,fldsize,spval,tmp &
2783 ,recname,reclevtyp,reclev,varname,vcoordname &
2789 if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j)
2798 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2799 ,l,nrec,fldsize,spval,tmp &
2800 ,recname,reclevtyp,reclev,varname,vcoordname &
2805 if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j)
2818 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2819 ,l,nrec,fldsize,spval,tmp &
2820 ,recname,reclevtyp,reclev,varname,vcoordname &
2826 if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j)
2835 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2836 ,l,nrec,fldsize,spval,tmp &
2837 ,recname,reclevtyp,reclev,varname,vcoordname &
2843 if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j)
2851 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2852 ,l,nrec,fldsize,spval,tmp &
2853 ,recname,reclevtyp,reclev,varname,vcoordname &
2859 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval
2868 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2869 ,l,nrec,fldsize,spval,tmp &
2870 ,recname,reclevtyp,reclev,varname,vcoordname &
2876 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval
2883 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2884 ,l,nrec,fldsize,spval,tmp &
2885 ,recname,reclevtyp,reclev,varname,vcoordname &
2893 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2894 ,l,nrec,fldsize,spval,tmp &
2895 ,recname,reclevtyp,reclev,varname,vcoordname &
2900 do j=jsta_2l,jend_2u
2911 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2912 ,l,nrec,fldsize,spval,tmp &
2913 ,recname,reclevtyp,reclev,varname,vcoordname &
2922 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2923 ,l,nrec,fldsize,spval,tmp &
2924 ,recname,reclevtyp,reclev,varname,vcoordname &
2932 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2933 ,l,nrec,fldsize,spval,tmp &
2934 ,recname,reclevtyp,reclev,varname,vcoordname &
2940 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval
2949 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2950 ,l,nrec,fldsize,spval,tmp &
2951 ,recname,reclevtyp,reclev,varname,vcoordname &
2957 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval
2963 do j=jsta_2l,jend_2u
2966 rlwtt(i,j,l) = spval
2968 rswtt(i,j,l) = spval
2970 tcucn(i,j,l) = spval
2971 tcucns(i,j,l) = spval
2973 train(i,j,l) = spval
2985 vcoordname=
'10 m above gnd'
2987 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2988 ,l,nrec,fldsize,spval,tmp &
2989 ,recname,reclevtyp,reclev,varname,vcoordname &
3001 vcoordname=
'10 m above gnd'
3003 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3004 ,l,nrec,fldsize,spval,tmp &
3005 ,recname,reclevtyp,reclev,varname,vcoordname &
3021 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3022 ,l,nrec,fldsize,spval,tmp &
3023 ,recname,reclevtyp,reclev,varname,vcoordname &
3031 do j = jsta_2l, jend_2u
3033 if (buf(i,j) < spval)
then
3034 ivgtyp(i,j) = nint(buf(i,j))
3046 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3047 ,l,nrec,fldsize,spval,tmp &
3048 ,recname,reclevtyp,reclev,varname,vcoordname &
3056 do j = jsta_2l, jend_2u
3058 if (buf(i,j) < spval)
then
3059 isltyp(i,j) = nint(buf(i,j))
3068 do j=jsta_2l,jend_2u
3076 thz0(i,j) = ths(i,j)
3084 do j=jsta_2l,jend_2u
3086 el_pbl(i,j,l) = spval
3087 exch_h(i,j,l) = spval
3096 vcoordname=
'convect-cld top'
3098 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3099 ,l,nrec,fldsize,spval,tmp &
3100 ,recname,reclevtyp,reclev,varname,vcoordname &
3108 if(ptop(i,j) <= 0.0) ptop(i,j) = spval
3113 if(ptop(i,j) < spval)
then
3115 if(ptop(i,j) <= pmid(i,j,l))
then
3129 vcoordname=
'convect-cld bot'
3131 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3132 ,l,nrec,fldsize,spval,tmp &
3133 ,recname,reclevtyp,reclev,varname,vcoordname &
3141 if(pbot(i,j) <= 0.0) pbot(i,j) = spval
3148 if(pbot(i,j) < spval)
then
3150 if(pbot(i,j) >= pmid(i,j,l))
then
3163 vcoordname=
'low cld top'
3165 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3166 ,l,nrec,fldsize,spval,tmp &
3167 ,recname,reclevtyp,reclev,varname,vcoordname &
3173 vcoordname=
'low cld bot'
3175 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3176 ,l,nrec,fldsize,spval,tmp &
3177 ,recname,reclevtyp,reclev,varname,vcoordname &
3183 vcoordname=
'low cld top'
3185 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3186 ,l,nrec,fldsize,spval,tmp &
3187 ,recname,reclevtyp,reclev,varname,vcoordname &
3193 vcoordname=
'mid cld top'
3195 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3196 ,l,nrec,fldsize,spval,tmp &
3197 ,recname,reclevtyp,reclev,varname,vcoordname &
3203 vcoordname=
'mid cld bot'
3205 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3206 ,l,nrec,fldsize,spval,tmp &
3207 ,recname,reclevtyp,reclev,varname,vcoordname &
3213 vcoordname=
'mid cld top'
3215 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3216 ,l,nrec,fldsize,spval,tmp &
3217 ,recname,reclevtyp,reclev,varname,vcoordname &
3223 vcoordname=
'high cld top'
3225 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3226 ,l,nrec,fldsize,spval,tmp &
3227 ,recname,reclevtyp,reclev,varname,vcoordname &
3233 vcoordname=
'high cld bot'
3235 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3236 ,l,nrec,fldsize,spval,tmp &
3237 ,recname,reclevtyp,reclev,varname,vcoordname &
3243 vcoordname=
'high cld top'
3245 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3246 ,l,nrec,fldsize,spval,tmp &
3247 ,recname,reclevtyp,reclev,varname,vcoordname &
3253 vcoordname=
'bndary-layer cld'
3255 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3256 ,l,nrec,fldsize,spval,tmp &
3257 ,recname,reclevtyp,reclev,varname,vcoordname &
3262 do j = jsta_2l, jend_2u
3264 if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01
3270 vcoordname=
'atmos col'
3272 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3273 ,l,nrec,fldsize,spval,tmp &
3274 ,recname,reclevtyp,reclev,varname,vcoordname &
3282 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3283 ,l,nrec,fldsize,spval,tmp &
3284 ,recname,reclevtyp,reclev,varname,vcoordname &
3290 if (sm(i,j) /= 0.0) runoff(i,j) = spval
3297 vcoordname=
'2 m above gnd'
3299 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3300 ,l,nrec,fldsize,spval,tmp &
3301 ,recname,reclevtyp,reclev,varname,vcoordname &
3307 vcoordname=
'2 m above gnd'
3309 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3310 ,l,nrec,fldsize,spval,tmp &
3311 ,recname,reclevtyp,reclev,varname,vcoordname &
3317 do j=jsta_2l,jend_2u
3319 maxrhshltr(i,j) = spval
3320 minrhshltr(i,j) = spval
3328 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3329 ,l,nrec,fldsize,spval,tmp &
3330 ,recname,reclevtyp,reclev,varname,vcoordname &
3338 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3339 ,l,nrec,fldsize,spval,tmp &
3340 ,recname,reclevtyp,reclev,varname,vcoordname &
3346 if (sm(i,j) /= 0.0) smcwlt(i,j) = spval
3355 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3356 ,l,nrec,fldsize,spval,tmp &
3357 ,recname,reclevtyp,reclev,varname,vcoordname &
3365 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3366 ,l,nrec,fldsize,spval,tmp &
3367 ,recname,reclevtyp,reclev,varname,vcoordname &
3373 if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval
3382 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3383 ,l,nrec,fldsize,spval,tmp &
3384 ,recname,reclevtyp,reclev,varname,vcoordname &
3391 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3392 ,l,nrec,fldsize,spval,tmp &
3393 ,recname,reclevtyp,reclev,varname,vcoordname &
3400 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3401 ,l,nrec,fldsize,spval,tmp &
3402 ,recname,reclevtyp,reclev,varname,vcoordname &
3409 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3410 ,l,nrec,fldsize,spval,tmp &
3411 ,recname,reclevtyp,reclev,varname,vcoordname &
3418 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3419 ,l,nrec,fldsize,spval,tmp &
3420 ,recname,reclevtyp,reclev,varname,vcoordname &
3425 vcoordname=
'nom. top'
3427 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3428 ,l,nrec,fldsize,spval,tmp &
3429 ,recname,reclevtyp,reclev,varname,vcoordname &
3436 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3437 ,l,nrec,fldsize,spval,tmp &
3438 ,recname,reclevtyp,reclev,varname,vcoordname &
3443 vcoordname=
'nom. top'
3445 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3446 ,l,nrec,fldsize,spval,tmp &
3447 ,recname,reclevtyp,reclev,varname,vcoordname &
3454 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3455 ,l,nrec,fldsize,spval,tmp &
3456 ,recname,reclevtyp,reclev,varname,vcoordname &
3463 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3464 ,l,nrec,fldsize,spval,tmp &
3465 ,recname,reclevtyp,reclev,varname,vcoordname &
3469 varname=
'spfhmax_max'
3470 vcoordname=
'2 m above gnd'
3472 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3473 ,l,nrec,fldsize,spval,tmp &
3474 ,recname,reclevtyp,reclev,varname,vcoordname &
3480 varname=
'spfhmin_min'
3481 vcoordname=
'2 m above gnd'
3483 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3484 ,l,nrec,fldsize,spval,tmp &
3485 ,recname,reclevtyp,reclev,varname,vcoordname &
3492 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3493 ,l,nrec,fldsize,spval,tmp &
3494 ,recname,reclevtyp,reclev,varname,vcoordname &
3500 if (sm(i,j) /= 0.0) ssroff(i,j) = spval
3508 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3509 ,l,nrec,fldsize,spval,tmp &
3510 ,recname,reclevtyp,reclev,varname,vcoordname &
3516 if (sm(i,j) /= 0.0) avgedir(i,j) = spval
3524 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3525 ,l,nrec,fldsize,spval,tmp &
3526 ,recname,reclevtyp,reclev,varname,vcoordname &
3532 if (sm(i,j) /= 0.0) avgecan(i,j) = spval
3540 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3541 ,l,nrec,fldsize,spval,tmp &
3542 ,recname,reclevtyp,reclev,varname,vcoordname &
3548 if (sm(i,j) /= 0.0) avgetrans(i,j) = spval
3556 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3557 ,l,nrec,fldsize,spval,tmp &
3558 ,recname,reclevtyp,reclev,varname,vcoordname &
3564 if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval
3570 vcoordname=
'0-200 cm down'
3572 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3573 ,l,nrec,fldsize,spval,tmp &
3574 ,recname,reclevtyp,reclev,varname,vcoordname &
3580 if (sm(i,j) /= 0.0) smstot(i,j) = spval
3588 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3589 ,l,nrec,fldsize,spval,tmp &
3590 ,recname,reclevtyp,reclev,varname,vcoordname &
3596 if (sm(i,j) /= 0.0) snopcx(i,j) = spval
3613 if ((gocart_on .or. gccpp_on) .and. d2d_chem )
then
3616 if ( k == 1) varname=
'duem001'
3617 if ( k == 2) varname=
'duem002'
3618 if ( k == 3) varname=
'duem003'
3619 if ( k == 4) varname=
'duem004'
3620 if ( k == 5) varname=
'duem005'
3623 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3624 ,l,nrec,fldsize,spval,tmp &
3625 ,recname,reclevtyp,reclev,varname,vcoordname&
3632 if ( k == 1) varname=
'dust1sd'
3633 if ( k == 2) varname=
'dust2sd'
3634 if ( k == 3) varname=
'dust3sd'
3635 if ( k == 4) varname=
'dust4sd'
3636 if ( k == 5) varname=
'dsut5sd'
3639 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3640 ,l,nrec,fldsize,spval,tmp &
3641 ,recname,reclevtyp,reclev,varname,vcoordname&
3648 if ( k == 1) varname=
'dust1dp'
3649 if ( k == 2) varname=
'dust2dp'
3650 if ( k == 3) varname=
'dust3dp'
3651 if ( k == 4) varname=
'dust4dp'
3652 if ( k == 5) varname=
'dust5dp'
3655 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3656 ,l,nrec,fldsize,spval,tmp &
3657 ,recname,reclevtyp,reclev,varname,vcoordname&
3659 print *,
'dudp,ck=',maxval(dudp(1:im,jsta:jend,k)), &
3660 minval(dudp(1:im,jsta:jend,k))
3666 if ( k == 1) varname=
'dust1wtl'
3667 if ( k == 2) varname=
'dust2wtl'
3668 if ( k == 3) varname=
'dust3wtl'
3669 if ( k == 4) varname=
'dust4wtl'
3670 if ( k == 5) varname=
'dust5wtl'
3673 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3674 ,l,nrec,fldsize,spval,tmp &
3675 ,recname,reclevtyp,reclev,varname,vcoordname&
3680 if ( k == 1) varname=
'dust1wtc'
3681 if ( k == 2) varname=
'dust2wtc'
3682 if ( k == 3) varname=
'dust3wtc'
3683 if ( k == 4) varname=
'dust4wtc'
3684 if ( k == 5) varname=
'dust5wtc'
3687 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3688 ,l,nrec,fldsize,spval,tmp &
3689 ,recname,reclevtyp,reclev,varname,vcoordname&
3695 if ( k == 1) varname=
'ssem001'
3696 if ( k == 2) varname=
'ssem002'
3697 if ( k == 3) varname=
'ssem003'
3698 if ( k == 4) varname=
'ssem004'
3699 if ( k == 5) varname=
'ssem005'
3702 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3703 ,l,nrec,fldsize,spval,tmp &
3704 ,recname,reclevtyp,reclev,varname,vcoordname&
3710 if ( k == 1) varname=
'seas1sd'
3711 if ( k == 2) varname=
'seas2sd'
3712 if ( k == 3) varname=
'seas3sd'
3713 if ( k == 4) varname=
'seas4sd'
3714 if ( k == 5) varname=
'seas5sd'
3717 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3718 ,l,nrec,fldsize,spval,tmp &
3719 ,recname,reclevtyp,reclev,varname,vcoordname&
3726 if ( k == 1) varname=
'seas1dp'
3727 if ( k == 2) varname=
'seas2dp'
3728 if ( k == 3) varname=
'seas3dp'
3729 if ( k == 4) varname=
'seas4dp'
3730 if ( k == 5) varname=
'seas5dp'
3733 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3734 ,l,nrec,fldsize,spval,tmp &
3735 ,recname,reclevtyp,reclev,varname,vcoordname&
3741 if ( k == 1) varname=
'seas1wtl'
3742 if ( k == 2) varname=
'seas2wtl'
3743 if ( k == 3) varname=
'seas3wtl'
3744 if ( k == 4) varname=
'seas4wtl'
3745 if ( k == 5) varname=
'seas5wtl'
3748 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3749 ,l,nrec,fldsize,spval,tmp &
3750 ,recname,reclevtyp,reclev,varname,vcoordname&
3756 if ( k == 1) varname=
'seas1wtc'
3757 if ( k == 2) varname=
'seas1wtc'
3758 if ( k == 3) varname=
'seas1wtc'
3759 if ( k == 4) varname=
'seas1wtc'
3760 if ( k == 5) varname=
'seas1wtc'
3763 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3764 ,l,nrec,fldsize,spval,tmp &
3765 ,recname,reclevtyp,reclev,varname,vcoordname&
3771 if ( k == 1) varname=
'bceman'
3772 if ( k == 2) varname=
'bcembb'
3775 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3776 ,l,nrec,fldsize,spval,tmp &
3777 ,recname,reclevtyp,reclev,varname,vcoordname&
3783 if ( k == 1) varname=
'bc1sd'
3784 if ( k == 2) varname=
'bc2sd'
3787 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3788 ,l,nrec,fldsize,spval,tmp &
3789 ,recname,reclevtyp,reclev,varname,vcoordname&
3795 if ( k == 1) varname=
'bc1dp'
3796 if ( k == 2) varname=
'bc2dp'
3799 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3800 ,l,nrec,fldsize,spval,tmp &
3801 ,recname,reclevtyp,reclev,varname,vcoordname&
3807 if ( k == 1) varname=
'bc1wtl'
3808 if ( k == 2) varname=
'bc2wtl'
3811 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3812 ,l,nrec,fldsize,spval,tmp &
3813 ,recname,reclevtyp,reclev,varname,vcoordname&
3819 if ( k == 1) varname=
'bc1wtc'
3820 if ( k == 2) varname=
'bc2wtc'
3823 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3824 ,l,nrec,fldsize,spval,tmp &
3825 ,recname,reclevtyp,reclev,varname,vcoordname&
3831 if ( k == 1) varname=
'oceman'
3832 if ( k == 2) varname=
'ocembb'
3835 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3836 ,l,nrec,fldsize,spval,tmp &
3837 ,recname,reclevtyp,reclev,varname,vcoordname&
3843 if ( k == 1) varname=
'oc1sd'
3844 if ( k == 2) varname=
'oc2sd'
3847 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3848 ,l,nrec,fldsize,spval,tmp &
3849 ,recname,reclevtyp,reclev,varname,vcoordname&
3855 if ( k == 1) varname=
'oc1dp'
3856 if ( k == 2) varname=
'oc2dp'
3859 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3860 ,l,nrec,fldsize,spval,tmp &
3861 ,recname,reclevtyp,reclev,varname,vcoordname&
3867 if ( k == 1) varname=
'oc1wtl'
3868 if ( k == 2) varname=
'oc2wtl'
3871 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3872 ,l,nrec,fldsize,spval,tmp &
3873 ,recname,reclevtyp,reclev,varname,vcoordname&
3879 if ( k == 1) varname=
'oc1wtc'
3880 if ( k == 2) varname=
'oc2wtc'
3883 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3884 ,l,nrec,fldsize,spval,tmp &
3885 ,recname,reclevtyp,reclev,varname,vcoordname&
3893 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3894 ,l,nrec,fldsize,spval,tmp &
3895 ,recname,reclevtyp,reclev,varname,vcoordname&
3900 call nemsio_close(ffile,iret=status)
3901 deallocate(tmp,recname,reclevtyp,reclev)
3904 call collect_loc(gdlat,dummy)
3906 latstart = nint(dummy(1,1)*gdsdegr)
3907 latlast = nint(dummy(im,jm)*gdsdegr)
3908 print*,
'laststart,latlast B bcast= ',latstart,latlast,
'gdsdegr=',gdsdegr,&
3909 'dummy(1,1)=',dummy(1,1),dummy(im,jm),
'gdlat=',gdlat(1,1)
3911 call mpi_bcast(latstart,1,mpi_integer,0,mpi_comm_comp,irtn)
3912 call mpi_bcast(latlast,1,mpi_integer,0,mpi_comm_comp,irtn)
3913 write(6,*)
'laststart,latlast,me A calling bcast=',latstart,latlast,me
3914 call collect_loc(gdlon,dummy)
3916 lonstart = nint(dummy(1,1)*gdsdegr)
3917 lonlast = nint(dummy(im,jm)*gdsdegr)
3919 call mpi_bcast(lonstart,1,mpi_integer,0,mpi_comm_comp,irtn)
3920 call mpi_bcast(lonlast, 1,mpi_integer,0,mpi_comm_comp,irtn)
3922 write(6,*)
'lonstart,lonlast A calling bcast=',lonstart,lonlast
3931 CALL table(ptbl,ttbl,pt_tbl, &
3932 rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0)
3934 CALL tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q)
3939 WRITE(6,*)
' SPL (POSTED PRESSURE LEVELS) BELOW: '
3940 WRITE(6,51) (spl(l),l=1,lsm)
3941 50
FORMAT(14(f4.1,1x))
3942 51
FORMAT(8(f8.1,1x))
3947 alsl(l) = log(spl(l))
3952 print*,
'writing out igds'
3956 if(maptype == 1)
THEN
3958 WRITE(6,*)
'igd(1)=',3
3961 WRITE(igdout)latstart
3962 WRITE(igdout)lonstart
3969 WRITE(igdout)truelat2
3970 WRITE(igdout)truelat1
3972 ELSE IF(maptype == 2)
THEN
3976 WRITE(igdout)latstart
3977 WRITE(igdout)lonstart
3984 WRITE(igdout)truelat2
3985 WRITE(igdout)truelat1
3991 if (truelat1 < 0.)
THEN
3997 CALL
msfps(lat,truelat1*0.001,psmapf)
3999 ELSE IF(maptype == 3)
THEN
4003 WRITE(igdout)latstart
4004 WRITE(igdout)lonstart
4006 WRITE(igdout)latlast
4007 WRITE(igdout)lonlast
4008 WRITE(igdout)truelat1
4014 ELSE IF(maptype == 0 .OR. maptype == 203)
THEN
4018 WRITE(igdout)latstart
4019 WRITE(igdout)lonstart
4036 subroutine rg2gg(im,jm,numi,a)
4040 integer,
intent(in):: im,jm,numi(jm)
4041 real,
intent(inout):: a(im,jm)
4045 r =
real(numi(j))/
real(im)
4047 ir = mod(nint((ig-1)*r),numi(j)) + 1
4054 end subroutine rg2gg
4055 subroutine gg2rg(im,jm,numi,a)
4059 integer,
intent(in):: im,jm,numi(jm)
4060 real,
intent(inout):: a(im,jm)
4064 r =
real(numi(j))/
real(im)
4066 ig = nint((ir-1)/r) + 1
4073 end subroutine gg2rg
4075 subroutine uninterpred(iord,kmsk,lonsperlat,lonr,latr,fi,f)
4079 integer,
intent(in) :: iord, lonr, latr
4080 integer,
intent(in) :: kmsk(lonr,latr), lonsperlat(latr)
4081 real,
intent(in) :: fi(lonr,latr)
4082 real,
intent(out) :: f(lonr,latr)
4087 lons = lonsperlat(j)
4088 if(lons /= lonr)
then
4089 call intlon(iord,1,lons,lonr,kmsk(1,j),fi(1,j),f(1,j))
4095 subroutine intlon(iord,imsk,m1,m2,k1,f1,f2)
4097 integer,
intent(in) :: iord,imsk,m1,m2
4098 integer,
intent(in) :: k1(m1)
4099 real,
intent(in) :: f1(m1)
4100 real,
intent(out):: f2(m2)
4103 r =
real(m1)/
real(m2)
4108 if(iord == 2 .and. (imsk == 0 .or. k1(il) == k1(ir)))
then
4109 f2(i2) = f1(il)*(il-x1) + f1(ir)*(x1-il+1)
4111 in = mod(nint(x1),m1) + 1
4115 end subroutine intlon
subroutine, public calgradps(PS, PSX, PSY)
CALGRADPS computes gardients of a scalar field PS or LNPS.
subroutine modstuff2(im, ix, km, idvc, idsl, nvcoord, vcoord, ps, psx, psy, d, u, v, pi, pm, om, me)
modstuff2() computes model coordinate dependent functions.
subroutine, public caldiv(UWND, VWND, DIV)
CALDIV computes divergence.
subroutine msfps(LAT, TRUELAT1, MSF)
msfps() computes the map scale factor for a polar stereographic grid at a give latitude.
elemental real function, public fpvsnew(t)
subroutine initpost_gfs_nems_mpiio(iostatusAER)
This routine initializes constants and variables at the start of GFS model or post processor run...