41 use vrbls4d,
only: dust, salt, suso, soot, waso, pp25, pp10
42 use vrbls3d,
only: t, q, uh, vh,wh,pmid,pint,alpint, dpres,zint,zmid,o3, &
43 qqr, qqs, cwm, qqi, qqw, omga, rhomid, q2, cfr, rlwtt, rswtt, tcucn, &
44 tcucns, train, el_pbl, exch_h, vdifftt, vdiffmois, dconvmois, nradtt, &
45 o3vdiff, o3prod, o3tndy, mwpv, qqg, vdiffzacce, zgdrag,cnvctummixing, &
46 vdiffmacce, mgdrag, cnvctvmmixing, ncnvctcfrac, cnvctumflx, cnvctdmflx, &
47 cnvctzgdrag, sconvmois, cnvctmgdrag, cnvctdetmflx, duwt, duem, dusd, dudp, &
48 dusv,ssem,sssd,ssdp,sswt,sssv,bcem,bcsd,bcdp,bcwt,bcsv,ocem,ocsd,ocdp, &
50 use vrbls2d,
only: f, pd, fis, pblh, ustar, z0, ths, qs, twbs, qwbs, avgcprate, &
51 cprate, avgprec, prec, lspa, sno, si, cldefi, th10, q10, tshltr, pshltr, &
52 tshltr, albase, avgalbedo, avgtcdc, czen, czmean, mxsnal, radot, sigt4, &
53 cfrach, cfracl, cfracm, avgcfrach, qshltr, avgcfracl, avgcfracm, cnvcfr, &
54 islope, cmc, grnflx, vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, &
55 bgroff, rlwin, rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, rswinc, &
56 rswout, aswin, auvbin, auvbinc, aswout, aswtoa, sfcshx, sfclhx, subshx, &
57 snopcx, sfcux, sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, smstav, &
58 smstot, ivgtyp, isltyp, sfcevp, sfcexc, acsnow, acsnom, sst, thz0, qz0, &
59 uz0, vz0, ptop, htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, pbotm, ttopm, &
60 ptoph, pboth, pblcfr, ttoph, runoff, maxtshltr, mintshltr, maxrhshltr, &
61 minrhshltr, dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, htops, hbots, &
62 cuppt, dusmass, ducmass, dusmass25, ducmass25, aswintoa, &
63 maxqshltr, minqshltr, acond, sr, u10h, v10h, &
64 avgedir,avgecan,avgetrans,avgesnow,avgprec_cont,avgcprate_cont, &
65 avisbeamswin,avisdiffswin,airbeamswin,airdiffswin, &
66 alwoutc,alwtoac,aswoutc,aswtoac,alwinc,aswinc,avgpotevp,snoavg, &
67 dustcb,bccb,occb,sulfcb,sscb,dustallcb,ssallcb,dustpm,dustpm10,sspm,pp25cb, &
69 use soil,
only: sldpth, sh2o, smc, stc
70 use masks,
only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice
73 use physcons_post,
only: grav => con_g, fv => con_fvirt, rgas => con_rd, &
74 eps => con_eps, epsm1 => con_epsm1
75 use params_mod,
only: erad, dtr, tfrz, h1, d608, rd, p1000, capa
76 use lookup_mod,
only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, qs0, sqs, sthe, &
77 ttblq, rdpq, rdtheq, stheq, the0q, the0
78 use ctlblk_mod,
only: me, mpi_comm_comp, icnt, idsp, jsta, jend, ihrst, idat, sdat, ifhr, &
79 ifmin, filename, tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, td3d, restrt, sdat, &
80 jend_m, imin, imp_physics, dt, spval, pdtop, pt, qmin, nbin_du, nphs, dtq2, ardlw,&
81 ardsw, asrfc, avrain, avcnvc, theat, gdsdegr, spl, lsm, alsl, im, jm, im_jm, lm, &
82 jsta_2l, jend_2u, nsoil, lp1, icu_physics, ivegsrc, novegtype, nbin_ss, nbin_bc, &
83 nbin_oc, nbin_su, gocart_on, gccpp_on, pt_tbl, hyb_sigp, filenameflux, filenameaer, &
84 isf_surface_physics, d2d_chem
85 use gridspec_mod,
only: maptype, gridtype, latstart, latlast, lonstart, lonlast, cenlon, &
86 dxval, dyval, truelat2, truelat1, psmapf, cenlat
88 use upp_physics,
only: fpvsnew, caldiv, calgradps
92 type(nemsio_gfile) :: nfile,ffile,rfile
111 real,
parameter :: gravi = 1.0/grav
112 integer,
intent(in) :: iostatusAER
113 character(len=20) :: VarName, VcoordName
114 integer :: Status, fldsize, fldst, recn
115 integer :: recn_vvel,recn_delz,recn_dpres
116 character startdate*19,SysDepInfo*80,cgar*1
117 character startdate2(19)*4,lprecip_accu*3
124 LOGICAL RUNB,SINGLRST,SUBPOST,NEST,HYDRO,IOOMG,IOALL
125 logical,
parameter :: debugprint = .false., zerout = .false.
127 logical :: reduce_grid = .true.
129 CHARACTER*40 CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV,FILCLD,FILRAD,FILSFC
131 CHARACTER FNAME*255,ENVAR*50
132 INTEGER IDATE(8),JDATE(8),JPDS(200),JGDS(200),KPDS(200),KGDS(200)
146 real,
allocatable :: fi(:,:,:)
148 integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus, &
149 i,j,l,ll,k,kf,irtn,igdout,n,index,nframe, &
150 impf,jmpf,nframed2,iunitd3d,ierr,idum,iret,nrec,idrt
151 real TSTART,TLMH,TSPH,ES,FACT,soilayert,soilayerb,zhour,dum, &
152 tvll,pmll,tv, tx1, tx2
154 character*16,
allocatable :: recname(:)
155 character*16,
allocatable :: reclevtyp(:)
156 character*6 :: modelname_nemsio
157 integer,
allocatable :: reclev(:), kmsk(:,:)
158 real,
allocatable :: glat1d(:), glon1d(:), qstl(:)
159 real,
allocatable :: wrk1(:,:), wrk2(:,:)
160 real,
allocatable :: p2d(:,:), t2d(:,:), q2d(:,:), &
161 qs2d(:,:), cw2d(:,:), cfr2d(:,:)
162 real(kind=4),allocatable :: vcoord4(:,:,:)
163 real,
dimension(lm+1) :: ak5, bk5
164 real*8,
allocatable :: pm2d(:,:), pi2d(:,:)
165 real,
allocatable :: tmp(:)
166 real :: buf(im,jsta_2l:jend_2u)
167 integer :: lonsperlat(jm/2), numi(jm)
173 integer isa, jsa, latghf, jtem, idvc, idsl, nvcoord, ip1, nn, npass
180 integer,
parameter :: npass2=5, npass3=30
181 real,
parameter :: third=1.0/3.0
182 INTEGER,
DIMENSION(2) :: ij4min, ij4max
183 REAL :: omgmin, omgmax
184 real,
allocatable :: d2d(:,:), u2d(:,:), v2d(:,:), omga2d(:,:)
185 REAL,
ALLOCATABLE :: ps2d(:,:),psx2d(:,:),psy2d(:,:)
186 real,
allocatable :: div3d(:,:,:)
187 real(kind=4),allocatable :: vcrd(:,:)
188 real :: omg1(im), omg2(im+2)
193 WRITE(6,*)
'INITPOST: ENTER INITPOST_GFS_NEMS_MPIIO'
194 WRITE(6,*)
'me=',me,
'LMV=',
size(lmv,1),
size(lmv,2),
'LMH=', &
195 size(lmh,1),
size(lmh,2),
'jsta_2l=',jsta_2l,
'jend_2u=', &
199 jsa = (jsta+jend) / 2
202 do j = jsta_2l, jend_2u
210 call nemsio_open(nfile,trim(filename),
'read',mpi_comm_comp,iret=status)
211 if ( status /= 0 )
then
212 print*,
'error opening ',filename,
' Status = ', status ; stop
214 call nemsio_getfilehead(nfile,iret=status,nrec=nrec,idrt=idrt)
217 call nemsio_open(ffile,trim(filenameflux),
'read',mpi_comm_comp &
219 if ( status /= 0 )
then
220 print*,
'error opening ',filenameflux,
' Status = ', status
229 do j = jsta_2l, jend_2u
240 do j = jsta_2l, jend_2u
249 allocate(recname(nrec),reclevtyp(nrec),reclev(nrec))
250 allocate(glat1d(im*jm),glon1d(im*jm))
251 allocate(vcoord4(lm+1,3,2))
253 call nemsio_getfilehead(nfile,iret=iret &
254 ,idate=idate(1:7),nfhour=nfhour,recname=recname &
255 ,reclevtyp=reclevtyp,reclev=reclev,lat=glat1d &
256 ,lon=glon1d,nframe=nframe,vcoord=vcoord4,idrt=maptype &
257 ,modelname=modelname_nemsio)
258 if(iret/=0)print*,
'error getting idate,nfhour'
259 print *,
'latstar1=',glat1d(1),glat1d(im*jm)
262 print*,
'modelname = ',modelname_nemsio
263 if(trim(modelname_nemsio)==
'FV3GFS')reduce_grid=.false.
269 open (201,file=
'lonsperlat.dat',status=
'old',form=
'formatted', &
270 action=
'read',iostat=iret)
272 read (201,*,iostat=iret) latghf,(lonsperlat(i),i=1,latghf)
274 print*,
'finished reading lonsperlat'
276 if (jm /= latghf+latghf)
then
277 write(0,*)
' wrong reduced grid - execution skipped'
281 numi(j) = lonsperlat(j)
284 numi(j) = lonsperlat(jm+1-j)
299 if (me == 0) print *,
'maptype and gridtype is ', &
305 print *,
'recname,reclevtyp,reclev=',trim(recname(i)),
' ', &
306 trim(reclevtyp(i)),reclev(i)
315 gdlat(i,j) = glat1d(js+i)
316 gdlon(i,j) = glon1d(js+i)
322 ak5(l) = vcoord4(l,1,1)
323 bk5(l) = vcoord4(l,2,1)
328 if ( minval(ak5) <0 .or. minval(bk5) <0 )
then
329 open (202,file=
'global_hyblev.txt',status=
'old',form=
'formatted', &
330 action=
'read',iostat=iret)
334 read (202,*,iostat=iret) ak5(l),bk5(l)
340 vcoord4(l,1,1)=ak5(l)
341 vcoord4(l,2,1)=bk5(l)
344 print *,
'ak5 and bk5 not found, stop !'
355 deallocate(glat1d,glon1d)
357 print*,
'idate = ',(idate(i),i=1,7)
358 print*,
'idate after broadcast = ',(idate(i),i=1,4)
359 print*,
'nfhour = ',nfhour
365 print *,me,
'max(gdlat)=', maxval(gdlat), &
366 'max(gdlon)=', maxval(gdlon)
369 print *,
'after call EXCH,me=',me
375 if (ip1 > im) ip1 = ip1 - im
376 dx(i,j) = erad*cos(gdlat(i,j)*dtr) *(gdlon(ip1,j)-gdlon(i,j))*dtr
377 dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr
387 f(i,j) = 1.454441e-4*sin(gdlat(i,j)*dtr)
393 print*,
'impf,jmpf,nframe= ',impf,jmpf,nframe
403 print*,
'start yr mo day hr min =',iyear,imn,iday,ihrst,imin
404 print*,
'processing yr mo day hr min=' &
405 ,idat(3),idat(1),idat(2),idat(4),idat(5)
421 print *,
' idate=',idate
422 print *,
' jdate=',jdate
424 CALL w3difdat(jdate,idate,0,rinc)
426 print *,
' rinc=',rinc
427 ifhr = nint(rinc(2)+rinc(1)*24.)
428 print *,
' ifhr=',ifhr
429 ifmin = nint(rinc(3))
431 print*,
' in INITPOST ifhr ifmin fileName=',ifhr,ifmin,filename
435 print*,
'tstart= ',tstart
441 IF(tstart > 1.0e-2)
THEN
442 ifhr = ifhr+nint(tstart)
446 call w3movdat(rinc,jdate,idate)
451 print*,
'new forecast hours for restrt run= ',ifhr
452 print*,
'new start yr mo day hr min =',sdat(3),sdat(1) &
456 varname=
'imp_physics'
457 call nemsio_getheadvar(ffile,trim(varname),imp_physics,iret)
459 if(me==0)print*,varname, &
460 " not found in file-Assigned 99 for Zhao"
464 if(me==0)print*,
'MP_PHYSICS= ',imp_physics
466 varname=
'sf_surface_physi'
467 call nemsio_getheadvar(ffile,trim(varname),imp_physics,iret)
469 if(me==0)print*,varname, &
470 " not found in file-Assigned 2 for NOAH"
471 isf_surface_physics=2
474 if(me==0)print*,
'SF_SURFACE_PHYSICS= ',isf_surface_physics
478 call nemsio_getheadvar(ffile,trim(varname),fhzero,iret)
480 if(me==0)print*,varname, &
481 " not found in file-Assign 6 or 12 hours precip bucket"
483 if(ifhr>240)tprec=12.
510 print*,
'tprec, tclod, trdlw = ',tprec,tclod,trdlw
514 if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)
then
515 CALL microinit(imp_physics)
526 fldsize = (jend-jsta+1)*im
527 allocate(tmp(fldsize*nrec))
528 print*,
'allocate tmp successfully'
530 call nemsio_denseread(nfile,1,im,jsta,jend,tmp,iret=iret)
532 print*,
"fail to read sigma file using mpi io read, stopping"
539 print*,
'performing reduced grid'
541 allocate (kmsk(im,jtem))
544 fldst = (recn-1)*fldsize
546 js = fldst + (j-jsta)*im
551 call gg2rg(im,jtem,numi(jsta),buf(1,jsta))
552 call uninterpred(2,kmsk,numi(jsta),im,jtem,buf(1,jsta),tmp(fldst+1))
561 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
563 fldst = (recn-1)*fldsize
566 js = fldst + (j-jsta)*im
572 if(me == 0) print*,
'fail to read ', varname,vcoordname,l
583 if (fis(i,j) /= spval)
then
584 zint(i,j,lp1) = fis(i,j)
585 fis(i,j) = fis(i,j) * grav
589 if(debugprint) print*,
'sample ',varname,
' = ',fis(isa,jsa)
596 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
597 ,l,nrec,fldsize,spval,tmp &
598 ,recname,reclevtyp,reclev,varname,vcoordname &
599 ,pint(1,jsta_2l,lp1))
601 if(debugprint)print*,
'sample surface pressure = ',pint(isa,jsa,lp1)
606 vcoordname =
'mid layer'
613 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
615 fldst = (recn-1)*fldsize
618 js = fldst + (j-jsta)*im
620 t(i,j,ll) = tmp(i+js)
624 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
628 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,t(isa,jsa,ll)
632 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
634 fldst = (recn-1)*fldsize
637 js = fldst + (j-jsta)*im
639 q(i,j,ll) = tmp(i+js)
643 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
647 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,q(isa,jsa,ll)
651 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
653 fldst = (recn-1)*fldsize
656 js = fldst + (j-jsta)*im
658 uh(i,j,ll) = tmp(i+js)
662 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
666 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,uh(isa,jsa,ll)
670 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
672 fldst = (recn-1)*fldsize
675 js = fldst + (j-jsta)*im
677 vh(i,j,ll) = tmp(i+js)
681 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
685 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,vh(isa,jsa,ll)
713 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
715 fldst = (recn-1)*fldsize
718 js = fldst + (j-jsta)*im
720 dpres(i,j,ll) = tmp(i+js)
725 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll, &
726 'will derive pressure using ak bk later'
730 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
732 fldst = (recn-1)*fldsize
735 js = fldst + (j-jsta)*im
737 o3(i,j,ll) = tmp(i+js)
741 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
746 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,o3(isa,jsa,ll)
762 if(imp_physics==99 .or. imp_physics==98)
then
764 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
766 fldst = (recn-1)*fldsize
769 js = fldst + (j-jsta)*im
771 cwm(i,j,ll) = tmp(i+js)
775 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
779 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,cwm(isa,jsa,ll)
784 if(t(i,j,ll) < (tfrz-15.) )
then
785 qqi(i,j,ll) = cwm(i,j,ll)
787 qqw(i,j,ll) = cwm(i,j,ll)
791 else if(imp_physics==11 .or. imp_physics==8)
then
793 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
795 fldst = (recn-1)*fldsize
798 js = fldst + (j-jsta)*im
800 qqw(i,j,ll) = tmp(i+js)
804 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
807 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqw(isa,jsa,ll)
810 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
812 fldst = (recn-1)*fldsize
815 js = fldst + (j-jsta)*im
817 qqi(i,j,ll) = tmp(i+js)
821 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
824 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqi(isa,jsa,ll)
827 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
829 fldst = (recn-1)*fldsize
832 js = fldst + (j-jsta)*im
834 qqr(i,j,ll) = tmp(i+js)
838 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
841 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqr(isa,jsa,ll)
844 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
846 fldst = (recn-1)*fldsize
849 js = fldst + (j-jsta)*im
851 qqs(i,j,ll) = tmp(i+js)
855 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
858 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqs(isa,jsa,ll)
861 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
863 fldst = (recn-1)*fldsize
866 js = fldst + (j-jsta)*im
868 qqg(i,j,ll) = tmp(i+js)
872 print*,
'fail to read ', varname,
' at lev ',ll,
'stopping'
875 if(debugprint)print*,
'sample ',ll,varname,
' = ',ll,qqg(isa,jsa,ll)
879 cwm(i,j,ll)=qqg(i,j,ll)+qqs(i,j,ll)+qqr(i,j,ll)+qqi(i,j,ll)+qqw(i,j,ll)
888 if(trim(modelname_nemsio)==
'FV3GFS')
then
891 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
893 fldst = (recn-1)*fldsize
896 js = fldst + (j-jsta)*im
898 wh(i,j,ll) = tmp(i+js)
901 if(debugprint)print*,
'sample l ',varname,
' = ',ll,wh(isa,jsa,ll)
903 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll
907 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
909 fldst = (recn-1)*fldsize
912 js = fldst + (j-jsta)*im
914 omga(i,j,ll) = tmp(i+js)
917 if(debugprint)print*,
'sample l ',varname,
' = ',ll,omga(isa,jsa,ll)
920 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll, &
921 'will derive omega later'
927 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
929 fldst = (recn-1)*fldsize
933 js = fldst + (j-jsta)*im
935 zint(i,j,ll)=zint(i,j,ll+1)+abs(tmp(i+js))
936 if(recn_dpres /= -9999)pmid(i,j,ll)=rgas*dpres(i,j,ll)* &
937 t(i,j,ll)*(q(i,j,ll)*fv+1.0)/grav/abs(tmp(i+js))
940 if(debugprint)print*,
'sample l ',varname,
' = ',ll, &
942 if(trim(modelname_nemsio)==
'FV3GFS' .and. &
943 recn_dpres /= -9999)
then
945 js = fldst + (j-jsta)*im
947 omga(i,j,ll)=(-1.)*wh(i,j,ll)*dpres(i,j,ll)/abs(tmp(i+js))
950 if(debugprint)print*,
'sample l omga for FV3',ll, &
955 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll, &
956 'will derive height later'
961 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
963 fldst = (recn-1)*fldsize
966 js = fldst + (j-jsta)*im
968 cfr(i,j,ll)=tmp(i+js)
975 if(imp_physics == 99)
then
976 allocate(p2d(im,lm),t2d(im,lm),q2d(im,lm),cw2d(im,lm), &
977 qs2d(im,lm),cfr2d(im,lm))
981 p2d(i,k) = pmid(i,j,ll)*0.01
984 cw2d(i,k) = cwm(i,j,ll)
985 es = min(fpvsnew(t(i,j,ll)),pmid(i,j,ll))
986 qs2d(i,k) = eps*es/(pmid(i,j,ll)+epsm1*es)
992 ( p2d,t2d,q2d,qs2d,cw2d,im,lm,0, &
999 cfr(i,j,k) = cfr2d(i,k)
1003 deallocate(p2d,t2d,q2d,qs2d,cw2d,cfr2d)
1009 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
1011 fldst = (recn-1)*fldsize
1014 js = fldst + (j-jsta)*im
1016 q2(i,j,ll) = tmp(i+js)
1020 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll
1028 if(debugprint)print*,
'sample l ',varname,
' = ',ll,q2(isa,jsa,ll)
1033 call getrecn(recname,reclevtyp,reclev,nrec,varname,vcoordname,l,recn)
1037 js = fldst + (j-jsta)*im
1039 ref_10cm(i,j,ll) = tmp(i+js)
1046 ref_10cm(i,j,ll) = spval
1049 if(me==0)print*,
'fail to read ', varname,
' at lev ',ll
1051 if(debugprint)print*,
'sample l ',varname,
' = ',ll,ref_10cm(isa,jsa,ll)
1068 if (recn_dpres == -9999)
then
1073 pint(i,j,l) = ak5(lm+2-l) + bk5(lm+2-l)*pint(i,j,lp1)
1074 if(recn_delz == -9999)pmid(i,j,l) = 0.5*(pint(i,j,l)+ &
1078 if (me == 0) print*,
'sample pint,pmid' ,ii,jj,l,pint(ii,jj,l),pmid(ii,jj,l)
1095 pint(i,j,1)=ak5(lp1)
1102 pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1)
1105 if (me == 0) print*,
'sample model pint,pmid' ,ii,jj,l &
1115 if (recn_vvel == -9999)
then
1116 allocate(ps2d(im,jsta_2l:jend_2u), psx2d(im,jsta_2l:jend_2u), &
1117 psy2d(im,jsta_2l:jend_2u))
1118 allocate(div3d(im,jsta:jend,lm))
1123 ps2d(i,j) = log(pint(i,j,lm+1))
1126 call calgradps(ps2d,psx2d,psy2d)
1128 call caldiv(uh, vh, div3d)
1131 allocate (vcrd(lm+1,2), d2d(im,lm), u2d(im,lm), v2d(im,lm), &
1132 pi2d(im,lm+1), pm2d(im,lm), omga2d(im,lm))
1138 vcrd(l,1) = vcoord4(l,1,1)
1139 vcrd(l,2) = vcoord4(l,2,1)
1147 if (j > jm-jtem+1)
then
1148 npass = npass + nint(0.5*(j-jm+jtem-1))
1149 elseif (j < jtem)
then
1150 npass = npass + nint(0.5*(jtem-j))
1157 u2d(i,l) = uh(i,j,ll)
1158 v2d(i,l) = vh(i,j,ll)
1159 d2d(i,l) = div3d(i,j,ll)
1163 call modstuff2(im, im, lm, idvc, idsl, nvcoord, &
1164 vcrd, pint(1,j,lp1), psx2d(1,j), psy2d(1,j), &
1165 d2d, u2d, v2d, pi2d, pm2d, omga2d, me)
1169 if (npass <= 0 )
then
1174 omga(i,j,l) = omga2d(i,ll)
1184 omg1(i) = omga2d(i,ll)
1190 omg2(1) = omg2(im+1)
1191 omg2(im+2) = omg2(2)
1193 omg1(i-1) = third * (omg2(i-1) + omg2(i) + omg2(i+1))
1198 omga(i,j,l) = omg1(i)
1207 if (j ==1 .or. j == jm)
then
1214 tx2 = tx2 + omga(i,j,l)
1225 deallocate (vcrd,d2d,u2d,v2d,pi2d,pm2d,omga2d)
1226 deallocate (ps2d,psx2d,psy2d,div3d)
1228 deallocate (vcoord4)
1233 allocate(wrk1(im,jsta:jend),wrk2(im,jsta:jend))
1234 allocate(fi(im,jsta:jend,2))
1246 alpint(i,j,l)=log(pint(i,j,l))
1251 if (recn_delz == -9999)
then
1254 wrk1(i,j) = log(pmid(i,j,lm))
1255 wrk2(i,j) = t(i,j,lm)*(q(i,j,lm)*fv+1.0)
1256 fi(i,j,1) = fis(i,j) &
1257 + wrk2(i,j)*rgas*(alpint(i,j,lp1)-wrk1(i,j))
1258 zmid(i,j,lm) = fi(i,j,1) * gravi
1266 tvll = t(i,j,ll)*(q(i,j,ll)*fv+1.0)
1267 pmll = log(pmid(i,j,ll))
1269 fi(i,j,2) = fi(i,j,1) + (0.5*rgas)*(wrk2(i,j)+tvll) &
1271 zmid(i,j,ll) = fi(i,j,2) * gravi
1273 fact = (alpint(i,j,l)-wrk1(i,j)) / (pmll-wrk1(i,j))
1274 zint(i,j,l) = zmid(i,j,l) +(zmid(i,j,ll)-zmid(i,j,l))*fact
1275 fi(i,j,1) = fi(i,j,2)
1281 if (me == 0) print*,
'L ZINT= ',l,zint(ii,jj,l), &
1282 'alpint=',alpint(ii,jj,l),
'pmid=',log(pmid(ii,jj,l)), &
1283 'pmid(l-1)=',log(pmid(ii,jj,l-1)),
'zmd=',zmid(ii,jj,l), &
1284 'zmid(l-1)=',zmid(ii,jj,l-1)
1286 deallocate(wrk1,wrk2,fi)
1291 zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* &
1292 (log(pmid(i,j,l))-alpint(i,j,l+1))/ &
1293 (alpint(i,j,l)-alpint(i,j,l+1))
1342 print *,
'gocart_on=',gocart_on
1343 print *,
'gccpp_on=',gccpp_on
1344 if (gocart_on .or. gccpp_on)
then
1352 vcoordname=
'mid layer'
1355 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1356 ,l,nrec,fldsize,spval,tmp &
1357 ,recname,reclevtyp,reclev,varname,vcoordname &
1358 ,dust(1:im,jsta_2l:jend_2u,ll,1))
1365 vcoordname=
'mid layer'
1368 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1369 ,l,nrec,fldsize,spval,tmp &
1370 ,recname,reclevtyp,reclev,varname,vcoordname &
1371 ,dust(1:im,jsta_2l:jend_2u,ll,2))
1373 dustcb(1:im,jsta_2l:jend_2u)=dustcb(1:im,jsta_2l:jend_2u)+ &
1374 (dust(1:im,jsta_2l:jend_2u,ll,1)+0.38*dust(1:im,jsta_2l:jend_2u,ll,2))* &
1375 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1382 vcoordname=
'mid layer'
1385 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1386 ,l,nrec,fldsize,spval,tmp &
1387 ,recname,reclevtyp,reclev,varname,vcoordname &
1388 ,dust(1:im,jsta_2l:jend_2u,ll,3))
1394 vcoordname=
'mid layer'
1397 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1398 ,l,nrec,fldsize,spval,tmp &
1399 ,recname,reclevtyp,reclev,varname,vcoordname &
1400 ,dust(1:im,jsta_2l:jend_2u,ll,4))
1407 vcoordname=
'mid layer'
1410 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1411 ,l,nrec,fldsize,spval,tmp &
1412 ,recname,reclevtyp,reclev,varname,vcoordname &
1413 ,dust(1:im,jsta_2l:jend_2u,ll,5))
1415 dustallcb(1:im,jsta_2l:jend_2u)=dustallcb(1:im,jsta_2l:jend_2u)+ &
1416 (dust(1:im,jsta_2l:jend_2u,ll,1)+dust(1:im,jsta_2l:jend_2u,ll,2)+ &
1417 dust(1:im,jsta_2l:jend_2u,ll,3)+0.74*dust(1:im,jsta_2l:jend_2u,ll,4))* &
1418 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1429 vcoordname=
'mid layer'
1432 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1433 ,l,nrec,fldsize,spval,tmp &
1434 ,recname,reclevtyp,reclev,varname,vcoordname &
1435 ,salt(1:im,jsta_2l:jend_2u,ll,1))
1442 vcoordname=
'mid layer'
1445 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1446 ,l,nrec,fldsize,spval,tmp &
1447 ,recname,reclevtyp,reclev,varname,vcoordname &
1448 ,salt(1:im,jsta_2l:jend_2u,ll,2))
1455 vcoordname=
'mid layer'
1458 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1459 ,l,nrec,fldsize,spval,tmp &
1460 ,recname,reclevtyp,reclev,varname,vcoordname &
1461 ,salt(1:im,jsta_2l:jend_2u,ll,3))
1463 sscb(1:im,jsta_2l:jend_2u)=sscb(1:im,jsta_2l:jend_2u)+ &
1464 (salt(1:im,jsta_2l:jend_2u,ll,1)+ &
1465 salt(1:im,jsta_2l:jend_2u,ll,2)+0.83*salt(1:im,jsta_2l:jend_2u,ll,3))* &
1466 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1473 vcoordname=
'mid layer'
1476 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1477 ,l,nrec,fldsize,spval,tmp &
1478 ,recname,reclevtyp,reclev,varname,vcoordname &
1479 ,salt(1:im,jsta_2l:jend_2u,ll,4))
1485 vcoordname=
'mid layer'
1488 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1489 ,l,nrec,fldsize,spval,tmp &
1490 ,recname,reclevtyp,reclev,varname,vcoordname &
1491 ,salt(1:im,jsta_2l:jend_2u,ll,5))
1493 ssallcb(1:im,jsta_2l:jend_2u)=ssallcb(1:im,jsta_2l:jend_2u)+ &
1494 (salt(1:im,jsta_2l:jend_2u,ll,1)+salt(1:im,jsta_2l:jend_2u,ll,2)+ &
1495 salt(1:im,jsta_2l:jend_2u,ll,3)+ &
1496 salt(1:im,jsta_2l:jend_2u,ll,4))* &
1497 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1507 vcoordname=
'mid layer'
1510 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1511 ,l,nrec,fldsize,spval,tmp &
1512 ,recname,reclevtyp,reclev,varname,vcoordname &
1513 ,soot(1:im,jsta_2l:jend_2u,ll,1))
1520 vcoordname=
'mid layer'
1523 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1524 ,l,nrec,fldsize,spval,tmp &
1525 ,recname,reclevtyp,reclev,varname,vcoordname &
1526 ,soot(1:im,jsta_2l:jend_2u,ll,2))
1528 bccb(1:im,jsta_2l:jend_2u)=bccb(1:im,jsta_2l:jend_2u)+ &
1529 (soot(1:im,jsta_2l:jend_2u,ll,1)+soot(1:im,jsta_2l:jend_2u,ll,2))* &
1530 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1540 vcoordname=
'mid layer'
1543 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1544 ,l,nrec,fldsize,spval,tmp &
1545 ,recname,reclevtyp,reclev,varname,vcoordname &
1546 ,waso(1:im,jsta_2l:jend_2u,ll,1))
1553 vcoordname=
'mid layer'
1556 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1557 ,l,nrec,fldsize,spval,tmp &
1558 ,recname,reclevtyp,reclev,varname,vcoordname &
1559 ,waso(1:im,jsta_2l:jend_2u,ll,2))
1561 occb(1:im,jsta_2l:jend_2u)=occb(1:im,jsta_2l:jend_2u)+ &
1562 (waso(1:im,jsta_2l:jend_2u,ll,1)+waso(1:im,jsta_2l:jend_2u,ll,2)) * &
1563 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1573 vcoordname=
'mid layer'
1576 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1577 ,l,nrec,fldsize,spval,tmp &
1578 ,recname,reclevtyp,reclev,varname,vcoordname &
1579 ,suso(1:im,jsta_2l:jend_2u,ll,1))
1581 sulfcb(1:im,jsta_2l:jend_2u)=sulfcb(1:im,jsta_2l:jend_2u)+ &
1582 suso(1:im,jsta_2l:jend_2u,ll,1)* &
1583 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1593 vcoordname=
'mid layer'
1596 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1597 ,l,nrec,fldsize,spval,tmp &
1598 ,recname,reclevtyp,reclev,varname,vcoordname &
1599 ,pp25(1:im,jsta_2l:jend_2u,ll,1))
1600 pp25cb(1:im,jsta_2l:jend_2u)=pp25cb(1:im,jsta_2l:jend_2u)+ &
1601 pp25(1:im,jsta_2l:jend_2u,ll,1)* &
1602 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1611 vcoordname=
'mid layer'
1614 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1615 ,l,nrec,fldsize,spval,tmp &
1616 ,recname,reclevtyp,reclev,varname,vcoordname &
1617 ,pp10(1:im,jsta_2l:jend_2u,ll,1))
1618 pp10cb(1:im,jsta_2l:jend_2u)=pp10cb(1:im,jsta_2l:jend_2u)+ &
1619 pp10(1:im,jsta_2l:jend_2u,ll,1)* &
1620 dpres(1:im,jsta_2l:jend_2u,ll)/grav
1631 tv = t(i,j,l) * (h1+d608*max(q(i,j,l),qmin))
1632 rhomid(i,j,l) = pmid(i,j,l) / (rd*tv)
1634 IF ( dust(i,j,l,n) < spval)
THEN
1635 dust(i,j,l,n) = max(dust(i,j,l,n), 0.0)
1639 IF ( salt(i,j,l,n) < spval)
THEN
1640 salt(i,j,l,n) = max(salt(i,j,l,n), 0.0)
1644 IF ( waso(i,j,l,n) < spval)
THEN
1645 waso(i,j,l,n) = max(waso(i,j,l,n), 0.0)
1649 IF ( soot(i,j,l,n) < spval)
THEN
1650 soot(i,j,l,n) = max(soot(i,j,l,n), 0.0)
1654 IF ( suso(i,j,l,n) < spval)
THEN
1655 suso(i,j,l,n) = max(suso(i,j,l,n), 0.0)
1666 dustcb(i,j) = max(dustcb(i,j), 0.0)
1667 dustallcb(i,j) = max(dustallcb(i,j), 0.0)
1668 sscb(i,j) = max(sscb(i,j), 0.0)
1669 ssallcb(i,j) = max(ssallcb(i,j), 0.0)
1670 bccb(i,j) = max(bccb(i,j), 0.0)
1671 occb(i,j) = max(occb(i,j), 0.0)
1672 sulfcb(i,j) = max(sulfcb(i,j), 0.0)
1673 pp25cb(i,j) = max(pp25cb(i,j), 0.0)
1674 pp10cb(i,j) = max(pp10cb(i,j), 0.0)
1676 dusmass(i,j)=(dust(i,j,l,1)+dust(i,j,l,2)+dust(i,j,l,3)+ &
1677 0.74*dust(i,j,l,4)+salt(i,j,l,1)+salt(i,j,l,2)+salt(i,j,l,3)+ &
1678 salt(i,j,l,4) + soot(i,j,l,1)+soot(i,j,l,2)+waso(i,j,l,1)+ &
1679 waso(i,j,l,2) +suso(i,j,l,1)+pp25(i,j,l,1)+pp10(i,j,l,1)) &
1682 dustpm(i,j)=(dust(i,j,l,1)+0.38*dust(i,j,l,2))*rhomid(i,j,l)
1683 dustpm10(i,j)=(dust(i,j,l,1)+dust(i,j,l,2)+dust(i,j,l,3)+ &
1684 0.74*dust(i,j,l,4))*rhomid(i,j,l)
1685 sspm(i,j)=(salt(i,j,l,1)+salt(i,j,l,2)+ &
1686 0.83*salt(i,j,l,3))*rhomid(i,j,l)
1688 dusmass25(i,j)=(dust(i,j,l,1)+0.38*dust(i,j,l,2)+ &
1689 salt(i,j,l,1)+salt(i,j,l,2)+0.83*salt(i,j,l,3) + &
1690 soot(i,j,l,1)+soot(i,j,l,2)+waso(i,j,l,1)+ &
1691 waso(i,j,l,2) +suso(i,j,l,1)+pp25(i,j,l,1))*rhomid(i,j,l)
1693 ducmass(i,j)=dustallcb(i,j)+ssallcb(i,j)+bccb(i,j)+ &
1694 occb(i,j)+sulfcb(i,j)+pp25cb(i,j)+pp10cb(i,j)
1696 ducmass25(i,j)=dustcb(i,j)+sscb(i,j)+bccb(i,j)+occb(i,j) &
1697 +sulfcb(i,j)+pp25cb(i,j)
1703 call nemsio_close(nfile,iret=status)
1704 deallocate(tmp,recname,reclevtyp,reclev)
1714 call nemsio_getfilehead(ffile,iret=status,nrec=nrec)
1715 print*,
'nrec for flux file=',nrec
1716 allocate(recname(nrec),reclevtyp(nrec),reclev(nrec))
1717 call nemsio_getfilehead(ffile,iret=iret &
1718 ,recname=recname ,reclevtyp=reclevtyp,reclev=reclev)
1722 print *,
'recname,reclevtyp,reclev=',trim(recname(i)),
' ', &
1723 trim(reclevtyp(i)),reclev(i)
1730 call nemsio_getheadvar(ffile,trim(varname),ivegsrc,iret)
1732 print*,varname,
' not found in file-use 1 for IGBP as default'
1735 if (me == 0) print*,
'IVEGSRC= ',ivegsrc
1740 else if(ivegsrc==1)
then
1742 else if(ivegsrc==0)
then
1745 if (me == 0) print*,
'novegtype= ',novegtype
1747 varname=
'CU_PHYSICS'
1748 call nemsio_getheadvar(ffile,trim(varname),icu_physics,iret)
1750 print*,varname,
" not found in file-Assigned 4 for SAS as default"
1753 if (me == 0) print*,
'CU_PHYSICS= ',icu_physics
1756 call nemsio_getheadvar(ffile,trim(varname),dtp,iret)
1758 print*,varname,
" not found in file-Assigned 225. for dtp as default"
1761 if (me == 0) print*,
'dtp= ',dtp
1794 fldsize = (jend-jsta+1)*im
1795 allocate(tmp(fldsize*nrec))
1796 print*,
'allocate tmp successfully'
1798 call nemsio_denseread(ffile,1,im,jsta,jend,tmp,iret=iret)
1808 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1809 ,l,nrec,fldsize,spval,tmp &
1810 ,recname,reclevtyp,reclev,varname,vcoordname,sm)
1811 if(debugprint)print*,
'sample ',varname,
' =',sm(im/2,(jsta+jend)/2)
1816 if (sm(i,j) /= spval) sm(i,j) = 1.0 - sm(i,j)
1825 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1826 ,l,nrec,fldsize,spval,tmp &
1827 ,recname,reclevtyp,reclev,varname,vcoordname,sice)
1829 if(debugprint)print*,
'sample ',varname,
' = ',sice(isa,jsa)
1842 if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0
1851 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1852 ,l,nrec,fldsize,spval,tmp &
1853 ,recname,reclevtyp,reclev,varname,vcoordname &
1855 if(debugprint)print*,
'sample ',varname,
' = ',pblh(isa,jsa)
1861 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1862 ,l,nrec,fldsize,spval,tmp &
1863 ,recname,reclevtyp,reclev,varname,vcoordname &
1871 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1872 ,l,nrec,fldsize,spval,tmp &
1873 ,recname,reclevtyp,reclev,varname,vcoordname &
1881 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1882 ,l,nrec,fldsize,spval,tmp &
1883 ,recname,reclevtyp,reclev,varname,vcoordname &
1890 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1891 ,l,nrec,fldsize,spval,tmp &
1892 ,recname,reclevtyp,reclev,varname,vcoordname &
1899 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1900 ,l,nrec,fldsize,spval,tmp &
1901 ,recname,reclevtyp,reclev,varname,vcoordname &
1909 if (ths(i,j) /= spval)
then
1911 ths(i,j) = ths(i,j) * (p1000/pint(i,j,lp1))**capa
1917 if (sm(i,j) /= 0.0)
then
1918 if (sice(i,j) >= 0.15)
then
1921 sst(i,j) = ths(i,j) * (pint(i,j,lp1)/p1000)**capa
1942 varname=
'cpratb_ave'
1945 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1946 ,l,nrec,fldsize,spval,tmp &
1947 ,recname,reclevtyp,reclev,varname,vcoordname &
1953 if (avgcprate(i,j) /= spval) avgcprate(i,j) = avgcprate(i,j) * (dtq2*0.001)
1961 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1962 ,l,nrec,fldsize,spval,tmp &
1963 ,recname,reclevtyp,reclev,varname,vcoordname &
1968 if (avgcprate_cont(i,j) /= spval) avgcprate_cont(i,j) = &
1969 avgcprate_cont(i,j) * (dtq2*0.001)
1978 varname=
'prateb_ave'
1981 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
1982 ,l,nrec,fldsize,spval,tmp &
1983 ,recname,reclevtyp,reclev,varname,vcoordname &
1989 if (avgprec(i,j) /= spval) avgprec(i,j) = avgprec(i,j) * (dtq2*0.001)
1999 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2000 ,l,nrec,fldsize,spval,tmp &
2001 ,recname,reclevtyp,reclev,varname,vcoordname &
2007 if (avgprec_cont(i,j) /= spval) avgprec_cont(i,j) = avgprec_cont(i,j) &
2018 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2019 ,l,nrec,fldsize,spval,tmp &
2020 ,recname,reclevtyp,reclev,varname,vcoordname &
2027 if (prec(i,j) /= spval) prec(i,j) = prec(i,j) * (dtq2*0.001) &
2036 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2037 ,l,nrec,fldsize,spval,tmp &
2038 ,recname,reclevtyp,reclev,varname,vcoordname &
2043 if (cprate(i,j) /= spval)
then
2044 cprate(i,j) = max(0.,cprate(i,j)) * (dtq2*0.001) * 1000. / dtp
2050 if(debugprint)print*,
'sample ',varname,
' = ',cprate(isa,jsa)
2059 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2060 ,l,nrec,fldsize,spval,tmp &
2061 ,recname,reclevtyp,reclev,varname,vcoordname &
2067 if (sm(i,j) == 1.0 .and. sice(i,j)==0.) sno(i,j) = spval
2076 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2077 ,l,nrec,fldsize,spval,tmp &
2078 ,recname,reclevtyp,reclev,varname,vcoordname &
2083 if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j)=spval
2084 if(snoavg(i,j)/=spval)snoavg(i,j)=snoavg(i,j)/100.
2092 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2093 ,l,nrec,fldsize,spval,tmp &
2094 ,recname,reclevtyp,reclev,varname,vcoordname &
2100 if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval
2101 if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0
2115 vcoordname=
'2 m above gnd'
2117 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2118 ,l,nrec,fldsize,spval,tmp &
2119 ,recname,reclevtyp,reclev,varname,vcoordname &
2126 pshltr(i,j)=pint(i,j,lm+1)*exp(-0.068283/tshltr(i,j))
2127 tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(i,j))**capa
2136 vcoordname=
'2 m above gnd'
2138 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2139 ,l,nrec,fldsize,spval,tmp &
2140 ,recname,reclevtyp,reclev,varname,vcoordname &
2148 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2149 ,l,nrec,fldsize,spval,tmp &
2150 ,recname,reclevtyp,reclev,varname,vcoordname &
2156 if (avgalbedo(i,j) /= spval) avgalbedo(i,j) = avgalbedo(i,j) * 0.01
2163 vcoordname=
'atmos col'
2165 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2166 ,l,nrec,fldsize,spval,tmp &
2167 ,recname,reclevtyp,reclev,varname,vcoordname &
2173 if (avgtcdc(i,j) /= spval) avgtcdc(i,j) = avgtcdc(i,j) * 0.01
2180 do j=jsta_2l,jend_2u
2191 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2192 ,l,nrec,fldsize,spval,tmp &
2193 ,recname,reclevtyp,reclev,varname,vcoordname &
2199 if (mxsnal(i,j) /= spval) mxsnal(i,j) = mxsnal(i,j) * 0.01
2205 do j=jsta_2l,jend_2u
2215 tlmh = t(i,j,lm) * t(i,j,lm)
2216 sigt4(i,j) = 5.67e-8 * tlmh * tlmh
2224 do j=jsta_2l,jend_2u
2234 vcoordname=
'high cld lay'
2236 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2237 ,l,nrec,fldsize,spval,tmp &
2238 ,recname,reclevtyp,reclev,varname,vcoordname &
2244 if (avgcfrach(i,j) /= spval) avgcfrach(i,j) = avgcfrach(i,j) * 0.01
2251 vcoordname=
'low cld lay'
2253 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2254 ,l,nrec,fldsize,spval,tmp &
2255 ,recname,reclevtyp,reclev,varname,vcoordname &
2261 if (avgcfracl(i,j) /= spval) avgcfracl(i,j) = avgcfracl(i,j) * 0.01
2268 vcoordname=
'mid cld lay'
2270 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2271 ,l,nrec,fldsize,spval,tmp &
2272 ,recname,reclevtyp,reclev,varname,vcoordname &
2278 if (avgcfracm(i,j) /= spval) avgcfracm(i,j) = avgcfracm(i,j) * 0.01
2285 vcoordname=
'convect-cld laye'
2287 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2288 ,l,nrec,fldsize,spval,tmp &
2289 ,recname,reclevtyp,reclev,varname,vcoordname &
2295 if (cnvcfr(i,j) /= spval) cnvcfr(i,j)= cnvcfr(i,j) * 0.01
2304 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2305 ,l,nrec,fldsize,spval,tmp &
2306 ,recname,reclevtyp,reclev,varname,vcoordname &
2310 do j = jsta_2l, jend_2u
2312 if (buf(i,j) < spval)
then
2313 islope(i,j) = nint(buf(i,j))
2325 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2326 ,l,nrec,fldsize,spval,tmp &
2327 ,recname,reclevtyp,reclev,varname,vcoordname &
2333 if (cmc(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001
2334 if (sm(i,j) /= 0.0) cmc(i,j) = spval
2340 do j=jsta_2l,jend_2u
2350 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2351 ,l,nrec,fldsize,spval,tmp &
2352 ,recname,reclevtyp,reclev,varname,vcoordname &
2357 if(sr(i,j) /= spval)
then
2359 sr(i,j)=min(1.,max(0.,sr(i,j)))
2368 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2369 ,l,nrec,fldsize,spval,tmp &
2370 ,recname,reclevtyp,reclev,varname,vcoordname &
2375 if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval
2383 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2384 ,l,nrec,fldsize,spval,tmp &
2385 ,recname,reclevtyp,reclev,varname,vcoordname &
2390 if (vegfrc(i,j) /= spval)
then
2391 vegfrc(i,j) = vegfrc(i,j) * 0.01
2401 if (sm(i,j) /= 0.0) vegfrc(i,j) = spval
2415 vcoordname=
'0-10 cm down'
2417 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2418 ,l,nrec,fldsize,spval,tmp &
2419 ,recname,reclevtyp,reclev,varname,vcoordname &
2425 if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval
2431 vcoordname=
'10-40 cm down'
2433 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2434 ,l,nrec,fldsize,spval,tmp &
2435 ,recname,reclevtyp,reclev,varname,vcoordname &
2441 if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval
2447 vcoordname=
'40-100 cm down'
2449 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2450 ,l,nrec,fldsize,spval,tmp &
2451 ,recname,reclevtyp,reclev,varname,vcoordname &
2457 if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval
2463 vcoordname=
'100-200 cm down'
2465 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2466 ,l,nrec,fldsize,spval,tmp &
2467 ,recname,reclevtyp,reclev,varname,vcoordname &
2473 if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval
2480 vcoordname=
'0-10 cm down'
2483 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2484 ,l,nrec,fldsize,spval,tmp &
2485 ,recname,reclevtyp,reclev,varname,vcoordname &
2491 if (sm(i,j) /= 0.0) smc(i,j,1) = spval
2497 vcoordname=
'10-40 cm down'
2499 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2500 ,l,nrec,fldsize,spval,tmp &
2501 ,recname,reclevtyp,reclev,varname,vcoordname &
2507 if (sm(i,j) /= 0.0) smc(i,j,2) = spval
2513 vcoordname=
'40-100 cm down'
2515 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2516 ,l,nrec,fldsize,spval,tmp &
2517 ,recname,reclevtyp,reclev,varname,vcoordname &
2523 if (sm(i,j) /= 0.0) smc(i,j,3) = spval
2529 vcoordname=
'100-200 cm down'
2531 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2532 ,l,nrec,fldsize,spval,tmp &
2533 ,recname,reclevtyp,reclev,varname,vcoordname &
2539 if (sm(i,j) /= 0.0) smc(i,j,4) = spval
2546 vcoordname=
'0-10 cm down'
2548 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2549 ,l,nrec,fldsize,spval,tmp &
2550 ,recname,reclevtyp,reclev,varname,vcoordname &
2556 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval
2563 vcoordname=
'10-40 cm down'
2565 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2566 ,l,nrec,fldsize,spval,tmp &
2567 ,recname,reclevtyp,reclev,varname,vcoordname &
2573 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval
2580 vcoordname=
'40-100 cm down'
2582 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2583 ,l,nrec,fldsize,spval,tmp &
2584 ,recname,reclevtyp,reclev,varname,vcoordname &
2590 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval
2597 vcoordname=
'100-200 cm down'
2599 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2600 ,l,nrec,fldsize,spval,tmp &
2601 ,recname,reclevtyp,reclev,varname,vcoordname &
2607 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval
2633 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2634 ,l,nrec,fldsize,spval,tmp &
2635 ,recname,reclevtyp,reclev,varname,vcoordname &
2642 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2643 ,l,nrec,fldsize,spval,tmp &
2644 ,recname,reclevtyp,reclev,varname,vcoordname &
2651 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2652 ,l,nrec,fldsize,spval,tmp &
2653 ,recname,reclevtyp,reclev,varname,vcoordname &
2659 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2660 ,l,nrec,fldsize,spval,tmp &
2661 ,recname,reclevtyp,reclev,varname,vcoordname &
2668 if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j)
2675 vcoordname=
'nom. top'
2677 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2678 ,l,nrec,fldsize,spval,tmp &
2679 ,recname,reclevtyp,reclev,varname,vcoordname &
2684 do j=jsta_2l,jend_2u
2700 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2701 ,l,nrec,fldsize,spval,tmp &
2702 ,recname,reclevtyp,reclev,varname,vcoordname &
2710 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2711 ,l,nrec,fldsize,spval,tmp &
2712 ,recname,reclevtyp,reclev,varname,vcoordname &
2719 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2720 ,l,nrec,fldsize,spval,tmp &
2721 ,recname,reclevtyp,reclev,varname,vcoordname &
2729 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2730 ,l,nrec,fldsize,spval,tmp &
2731 ,recname,reclevtyp,reclev,varname,vcoordname &
2739 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2740 ,l,nrec,fldsize,spval,tmp &
2741 ,recname,reclevtyp,reclev,varname,vcoordname &
2747 if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j)
2756 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2757 ,l,nrec,fldsize,spval,tmp &
2758 ,recname,reclevtyp,reclev,varname,vcoordname &
2763 vcoordname=
'nom. top'
2765 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2766 ,l,nrec,fldsize,spval,tmp &
2767 ,recname,reclevtyp,reclev,varname,vcoordname &
2774 vcoordname=
'nom. top'
2776 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2777 ,l,nrec,fldsize,spval,tmp &
2778 ,recname,reclevtyp,reclev,varname,vcoordname &
2787 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2788 ,l,nrec,fldsize,spval,tmp &
2789 ,recname,reclevtyp,reclev,varname,vcoordname &
2795 if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j)
2804 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2805 ,l,nrec,fldsize,spval,tmp &
2806 ,recname,reclevtyp,reclev,varname,vcoordname &
2811 if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j)
2824 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2825 ,l,nrec,fldsize,spval,tmp &
2826 ,recname,reclevtyp,reclev,varname,vcoordname &
2832 if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j)
2841 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2842 ,l,nrec,fldsize,spval,tmp &
2843 ,recname,reclevtyp,reclev,varname,vcoordname &
2849 if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j)
2857 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2858 ,l,nrec,fldsize,spval,tmp &
2859 ,recname,reclevtyp,reclev,varname,vcoordname &
2865 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval
2874 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2875 ,l,nrec,fldsize,spval,tmp &
2876 ,recname,reclevtyp,reclev,varname,vcoordname &
2882 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval
2889 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2890 ,l,nrec,fldsize,spval,tmp &
2891 ,recname,reclevtyp,reclev,varname,vcoordname &
2899 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2900 ,l,nrec,fldsize,spval,tmp &
2901 ,recname,reclevtyp,reclev,varname,vcoordname &
2906 do j=jsta_2l,jend_2u
2917 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2918 ,l,nrec,fldsize,spval,tmp &
2919 ,recname,reclevtyp,reclev,varname,vcoordname &
2928 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2929 ,l,nrec,fldsize,spval,tmp &
2930 ,recname,reclevtyp,reclev,varname,vcoordname &
2938 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2939 ,l,nrec,fldsize,spval,tmp &
2940 ,recname,reclevtyp,reclev,varname,vcoordname &
2946 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval
2955 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2956 ,l,nrec,fldsize,spval,tmp &
2957 ,recname,reclevtyp,reclev,varname,vcoordname &
2963 if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval
2969 do j=jsta_2l,jend_2u
2972 rlwtt(i,j,l) = spval
2974 rswtt(i,j,l) = spval
2976 tcucn(i,j,l) = spval
2977 tcucns(i,j,l) = spval
2979 train(i,j,l) = spval
2991 vcoordname=
'10 m above gnd'
2993 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
2994 ,l,nrec,fldsize,spval,tmp &
2995 ,recname,reclevtyp,reclev,varname,vcoordname &
3007 vcoordname=
'10 m above gnd'
3009 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3010 ,l,nrec,fldsize,spval,tmp &
3011 ,recname,reclevtyp,reclev,varname,vcoordname &
3027 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3028 ,l,nrec,fldsize,spval,tmp &
3029 ,recname,reclevtyp,reclev,varname,vcoordname &
3037 do j = jsta_2l, jend_2u
3039 if (buf(i,j) < spval)
then
3040 ivgtyp(i,j) = nint(buf(i,j))
3052 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3053 ,l,nrec,fldsize,spval,tmp &
3054 ,recname,reclevtyp,reclev,varname,vcoordname &
3062 do j = jsta_2l, jend_2u
3064 if (buf(i,j) < spval)
then
3065 isltyp(i,j) = nint(buf(i,j))
3074 do j=jsta_2l,jend_2u
3082 thz0(i,j) = ths(i,j)
3090 do j=jsta_2l,jend_2u
3092 el_pbl(i,j,l) = spval
3093 exch_h(i,j,l) = spval
3102 vcoordname=
'convect-cld top'
3104 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3105 ,l,nrec,fldsize,spval,tmp &
3106 ,recname,reclevtyp,reclev,varname,vcoordname &
3114 if(ptop(i,j) <= 0.0) ptop(i,j) = spval
3119 if(ptop(i,j) < spval)
then
3121 if(ptop(i,j) <= pmid(i,j,l))
then
3135 vcoordname=
'convect-cld bot'
3137 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3138 ,l,nrec,fldsize,spval,tmp &
3139 ,recname,reclevtyp,reclev,varname,vcoordname &
3147 if(pbot(i,j) <= 0.0) pbot(i,j) = spval
3154 if(pbot(i,j) < spval)
then
3156 if(pbot(i,j) >= pmid(i,j,l))
then
3169 vcoordname=
'low cld top'
3171 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3172 ,l,nrec,fldsize,spval,tmp &
3173 ,recname,reclevtyp,reclev,varname,vcoordname &
3179 vcoordname=
'low cld bot'
3181 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3182 ,l,nrec,fldsize,spval,tmp &
3183 ,recname,reclevtyp,reclev,varname,vcoordname &
3189 vcoordname=
'low cld top'
3191 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3192 ,l,nrec,fldsize,spval,tmp &
3193 ,recname,reclevtyp,reclev,varname,vcoordname &
3199 vcoordname=
'mid cld top'
3201 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3202 ,l,nrec,fldsize,spval,tmp &
3203 ,recname,reclevtyp,reclev,varname,vcoordname &
3209 vcoordname=
'mid cld bot'
3211 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3212 ,l,nrec,fldsize,spval,tmp &
3213 ,recname,reclevtyp,reclev,varname,vcoordname &
3219 vcoordname=
'mid cld top'
3221 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3222 ,l,nrec,fldsize,spval,tmp &
3223 ,recname,reclevtyp,reclev,varname,vcoordname &
3229 vcoordname=
'high cld top'
3231 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3232 ,l,nrec,fldsize,spval,tmp &
3233 ,recname,reclevtyp,reclev,varname,vcoordname &
3239 vcoordname=
'high cld bot'
3241 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3242 ,l,nrec,fldsize,spval,tmp &
3243 ,recname,reclevtyp,reclev,varname,vcoordname &
3249 vcoordname=
'high cld top'
3251 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3252 ,l,nrec,fldsize,spval,tmp &
3253 ,recname,reclevtyp,reclev,varname,vcoordname &
3259 vcoordname=
'bndary-layer cld'
3261 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3262 ,l,nrec,fldsize,spval,tmp &
3263 ,recname,reclevtyp,reclev,varname,vcoordname &
3268 do j = jsta_2l, jend_2u
3270 if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01
3276 vcoordname=
'atmos col'
3278 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3279 ,l,nrec,fldsize,spval,tmp &
3280 ,recname,reclevtyp,reclev,varname,vcoordname &
3288 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3289 ,l,nrec,fldsize,spval,tmp &
3290 ,recname,reclevtyp,reclev,varname,vcoordname &
3296 if (sm(i,j) /= 0.0) runoff(i,j) = spval
3303 vcoordname=
'2 m above gnd'
3305 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3306 ,l,nrec,fldsize,spval,tmp &
3307 ,recname,reclevtyp,reclev,varname,vcoordname &
3313 vcoordname=
'2 m above gnd'
3315 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3316 ,l,nrec,fldsize,spval,tmp &
3317 ,recname,reclevtyp,reclev,varname,vcoordname &
3323 do j=jsta_2l,jend_2u
3325 maxrhshltr(i,j) = spval
3326 minrhshltr(i,j) = spval
3334 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3335 ,l,nrec,fldsize,spval,tmp &
3336 ,recname,reclevtyp,reclev,varname,vcoordname &
3344 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3345 ,l,nrec,fldsize,spval,tmp &
3346 ,recname,reclevtyp,reclev,varname,vcoordname &
3352 if (sm(i,j) /= 0.0) smcwlt(i,j) = spval
3361 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3362 ,l,nrec,fldsize,spval,tmp &
3363 ,recname,reclevtyp,reclev,varname,vcoordname &
3371 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3372 ,l,nrec,fldsize,spval,tmp &
3373 ,recname,reclevtyp,reclev,varname,vcoordname &
3379 if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval
3388 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3389 ,l,nrec,fldsize,spval,tmp &
3390 ,recname,reclevtyp,reclev,varname,vcoordname &
3397 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3398 ,l,nrec,fldsize,spval,tmp &
3399 ,recname,reclevtyp,reclev,varname,vcoordname &
3406 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3407 ,l,nrec,fldsize,spval,tmp &
3408 ,recname,reclevtyp,reclev,varname,vcoordname &
3415 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3416 ,l,nrec,fldsize,spval,tmp &
3417 ,recname,reclevtyp,reclev,varname,vcoordname &
3424 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3425 ,l,nrec,fldsize,spval,tmp &
3426 ,recname,reclevtyp,reclev,varname,vcoordname &
3431 vcoordname=
'nom. top'
3433 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3434 ,l,nrec,fldsize,spval,tmp &
3435 ,recname,reclevtyp,reclev,varname,vcoordname &
3442 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3443 ,l,nrec,fldsize,spval,tmp &
3444 ,recname,reclevtyp,reclev,varname,vcoordname &
3449 vcoordname=
'nom. top'
3451 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3452 ,l,nrec,fldsize,spval,tmp &
3453 ,recname,reclevtyp,reclev,varname,vcoordname &
3460 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3461 ,l,nrec,fldsize,spval,tmp &
3462 ,recname,reclevtyp,reclev,varname,vcoordname &
3469 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3470 ,l,nrec,fldsize,spval,tmp &
3471 ,recname,reclevtyp,reclev,varname,vcoordname &
3475 varname=
'spfhmax_max'
3476 vcoordname=
'2 m above gnd'
3478 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3479 ,l,nrec,fldsize,spval,tmp &
3480 ,recname,reclevtyp,reclev,varname,vcoordname &
3486 varname=
'spfhmin_min'
3487 vcoordname=
'2 m above gnd'
3489 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3490 ,l,nrec,fldsize,spval,tmp &
3491 ,recname,reclevtyp,reclev,varname,vcoordname &
3498 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3499 ,l,nrec,fldsize,spval,tmp &
3500 ,recname,reclevtyp,reclev,varname,vcoordname &
3506 if (sm(i,j) /= 0.0) ssroff(i,j) = spval
3514 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3515 ,l,nrec,fldsize,spval,tmp &
3516 ,recname,reclevtyp,reclev,varname,vcoordname &
3522 if (sm(i,j) /= 0.0) avgedir(i,j) = spval
3530 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3531 ,l,nrec,fldsize,spval,tmp &
3532 ,recname,reclevtyp,reclev,varname,vcoordname &
3538 if (sm(i,j) /= 0.0) avgecan(i,j) = spval
3546 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3547 ,l,nrec,fldsize,spval,tmp &
3548 ,recname,reclevtyp,reclev,varname,vcoordname &
3554 if (sm(i,j) /= 0.0) avgetrans(i,j) = spval
3562 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3563 ,l,nrec,fldsize,spval,tmp &
3564 ,recname,reclevtyp,reclev,varname,vcoordname &
3570 if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval
3576 vcoordname=
'0-200 cm down'
3578 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3579 ,l,nrec,fldsize,spval,tmp &
3580 ,recname,reclevtyp,reclev,varname,vcoordname &
3586 if (sm(i,j) /= 0.0) smstot(i,j) = spval
3594 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3595 ,l,nrec,fldsize,spval,tmp &
3596 ,recname,reclevtyp,reclev,varname,vcoordname &
3602 if (sm(i,j) /= 0.0) snopcx(i,j) = spval
3619 if ((gocart_on .or. gccpp_on) .and. d2d_chem )
then
3622 if ( k == 1) varname=
'duem001'
3623 if ( k == 2) varname=
'duem002'
3624 if ( k == 3) varname=
'duem003'
3625 if ( k == 4) varname=
'duem004'
3626 if ( k == 5) varname=
'duem005'
3629 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3630 ,l,nrec,fldsize,spval,tmp &
3631 ,recname,reclevtyp,reclev,varname,vcoordname&
3638 if ( k == 1) varname=
'dust1sd'
3639 if ( k == 2) varname=
'dust2sd'
3640 if ( k == 3) varname=
'dust3sd'
3641 if ( k == 4) varname=
'dust4sd'
3642 if ( k == 5) varname=
'dsut5sd'
3645 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3646 ,l,nrec,fldsize,spval,tmp &
3647 ,recname,reclevtyp,reclev,varname,vcoordname&
3654 if ( k == 1) varname=
'dust1dp'
3655 if ( k == 2) varname=
'dust2dp'
3656 if ( k == 3) varname=
'dust3dp'
3657 if ( k == 4) varname=
'dust4dp'
3658 if ( k == 5) varname=
'dust5dp'
3661 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3662 ,l,nrec,fldsize,spval,tmp &
3663 ,recname,reclevtyp,reclev,varname,vcoordname&
3665 print *,
'dudp,ck=',maxval(dudp(1:im,jsta:jend,k)), &
3666 minval(dudp(1:im,jsta:jend,k))
3672 if ( k == 1) varname=
'dust1wtl'
3673 if ( k == 2) varname=
'dust2wtl'
3674 if ( k == 3) varname=
'dust3wtl'
3675 if ( k == 4) varname=
'dust4wtl'
3676 if ( k == 5) varname=
'dust5wtl'
3679 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3680 ,l,nrec,fldsize,spval,tmp &
3681 ,recname,reclevtyp,reclev,varname,vcoordname&
3686 if ( k == 1) varname=
'dust1wtc'
3687 if ( k == 2) varname=
'dust2wtc'
3688 if ( k == 3) varname=
'dust3wtc'
3689 if ( k == 4) varname=
'dust4wtc'
3690 if ( k == 5) varname=
'dust5wtc'
3693 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3694 ,l,nrec,fldsize,spval,tmp &
3695 ,recname,reclevtyp,reclev,varname,vcoordname&
3701 if ( k == 1) varname=
'ssem001'
3702 if ( k == 2) varname=
'ssem002'
3703 if ( k == 3) varname=
'ssem003'
3704 if ( k == 4) varname=
'ssem004'
3705 if ( k == 5) varname=
'ssem005'
3708 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3709 ,l,nrec,fldsize,spval,tmp &
3710 ,recname,reclevtyp,reclev,varname,vcoordname&
3716 if ( k == 1) varname=
'seas1sd'
3717 if ( k == 2) varname=
'seas2sd'
3718 if ( k == 3) varname=
'seas3sd'
3719 if ( k == 4) varname=
'seas4sd'
3720 if ( k == 5) varname=
'seas5sd'
3723 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3724 ,l,nrec,fldsize,spval,tmp &
3725 ,recname,reclevtyp,reclev,varname,vcoordname&
3732 if ( k == 1) varname=
'seas1dp'
3733 if ( k == 2) varname=
'seas2dp'
3734 if ( k == 3) varname=
'seas3dp'
3735 if ( k == 4) varname=
'seas4dp'
3736 if ( k == 5) varname=
'seas5dp'
3739 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3740 ,l,nrec,fldsize,spval,tmp &
3741 ,recname,reclevtyp,reclev,varname,vcoordname&
3747 if ( k == 1) varname=
'seas1wtl'
3748 if ( k == 2) varname=
'seas2wtl'
3749 if ( k == 3) varname=
'seas3wtl'
3750 if ( k == 4) varname=
'seas4wtl'
3751 if ( k == 5) varname=
'seas5wtl'
3754 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3755 ,l,nrec,fldsize,spval,tmp &
3756 ,recname,reclevtyp,reclev,varname,vcoordname&
3762 if ( k == 1) varname=
'seas1wtc'
3763 if ( k == 2) varname=
'seas1wtc'
3764 if ( k == 3) varname=
'seas1wtc'
3765 if ( k == 4) varname=
'seas1wtc'
3766 if ( k == 5) varname=
'seas1wtc'
3769 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3770 ,l,nrec,fldsize,spval,tmp &
3771 ,recname,reclevtyp,reclev,varname,vcoordname&
3777 if ( k == 1) varname=
'bceman'
3778 if ( k == 2) varname=
'bcembb'
3781 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3782 ,l,nrec,fldsize,spval,tmp &
3783 ,recname,reclevtyp,reclev,varname,vcoordname&
3789 if ( k == 1) varname=
'bc1sd'
3790 if ( k == 2) varname=
'bc2sd'
3793 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3794 ,l,nrec,fldsize,spval,tmp &
3795 ,recname,reclevtyp,reclev,varname,vcoordname&
3801 if ( k == 1) varname=
'bc1dp'
3802 if ( k == 2) varname=
'bc2dp'
3805 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3806 ,l,nrec,fldsize,spval,tmp &
3807 ,recname,reclevtyp,reclev,varname,vcoordname&
3813 if ( k == 1) varname=
'bc1wtl'
3814 if ( k == 2) varname=
'bc2wtl'
3817 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3818 ,l,nrec,fldsize,spval,tmp &
3819 ,recname,reclevtyp,reclev,varname,vcoordname&
3825 if ( k == 1) varname=
'bc1wtc'
3826 if ( k == 2) varname=
'bc2wtc'
3829 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3830 ,l,nrec,fldsize,spval,tmp &
3831 ,recname,reclevtyp,reclev,varname,vcoordname&
3837 if ( k == 1) varname=
'oceman'
3838 if ( k == 2) varname=
'ocembb'
3841 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3842 ,l,nrec,fldsize,spval,tmp &
3843 ,recname,reclevtyp,reclev,varname,vcoordname&
3849 if ( k == 1) varname=
'oc1sd'
3850 if ( k == 2) varname=
'oc2sd'
3853 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3854 ,l,nrec,fldsize,spval,tmp &
3855 ,recname,reclevtyp,reclev,varname,vcoordname&
3861 if ( k == 1) varname=
'oc1dp'
3862 if ( k == 2) varname=
'oc2dp'
3865 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3866 ,l,nrec,fldsize,spval,tmp &
3867 ,recname,reclevtyp,reclev,varname,vcoordname&
3873 if ( k == 1) varname=
'oc1wtl'
3874 if ( k == 2) varname=
'oc2wtl'
3877 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3878 ,l,nrec,fldsize,spval,tmp &
3879 ,recname,reclevtyp,reclev,varname,vcoordname&
3885 if ( k == 1) varname=
'oc1wtc'
3886 if ( k == 2) varname=
'oc2wtc'
3889 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3890 ,l,nrec,fldsize,spval,tmp &
3891 ,recname,reclevtyp,reclev,varname,vcoordname&
3899 call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
3900 ,l,nrec,fldsize,spval,tmp &
3901 ,recname,reclevtyp,reclev,varname,vcoordname&
3906 call nemsio_close(ffile,iret=status)
3907 deallocate(tmp,recname,reclevtyp,reclev)
3912 latstart = nint(dummy(1,1)*gdsdegr)
3913 latlast = nint(dummy(im,jm)*gdsdegr)
3914 print*,
'laststart,latlast B bcast= ',latstart,latlast,
'gdsdegr=',gdsdegr,&
3915 'dummy(1,1)=',dummy(1,1),dummy(im,jm),
'gdlat=',gdlat(1,1)
3917 call mpi_bcast(latstart,1,mpi_integer,0,mpi_comm_comp,irtn)
3918 call mpi_bcast(latlast,1,mpi_integer,0,mpi_comm_comp,irtn)
3919 write(6,*)
'laststart,latlast,me A calling bcast=',latstart,latlast,me
3922 lonstart = nint(dummy(1,1)*gdsdegr)
3923 lonlast = nint(dummy(im,jm)*gdsdegr)
3925 call mpi_bcast(lonstart,1,mpi_integer,0,mpi_comm_comp,irtn)
3926 call mpi_bcast(lonlast, 1,mpi_integer,0,mpi_comm_comp,irtn)
3928 write(6,*)
'lonstart,lonlast A calling bcast=',lonstart,lonlast
3937 CALL table(ptbl,ttbl,pt_tbl, &
3938 rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0)
3940 CALL tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q)
3945 WRITE(6,*)
' SPL (POSTED PRESSURE LEVELS) BELOW: '
3946 WRITE(6,51) (spl(l),l=1,lsm)
3947 50
FORMAT(14(f4.1,1x))
3948 51
FORMAT(8(f8.1,1x))
3953 alsl(l) = log(spl(l))
3958 print*,
'writing out igds'
3962 if(maptype == 1)
THEN
3964 WRITE(6,*)
'igd(1)=',3
3967 WRITE(igdout)latstart
3968 WRITE(igdout)lonstart
3975 WRITE(igdout)truelat2
3976 WRITE(igdout)truelat1
3978 ELSE IF(maptype == 2)
THEN
3982 WRITE(igdout)latstart
3983 WRITE(igdout)lonstart
3990 WRITE(igdout)truelat2
3991 WRITE(igdout)truelat1
3997 if (truelat1 < 0.)
THEN
4003 CALL msfps (lat,truelat1*0.001,psmapf)
4005 ELSE IF(maptype == 3)
THEN
4009 WRITE(igdout)latstart
4010 WRITE(igdout)lonstart
4012 WRITE(igdout)latlast
4013 WRITE(igdout)lonlast
4014 WRITE(igdout)truelat1
4020 ELSE IF(maptype == 0 .OR. maptype == 203)
THEN
4024 WRITE(igdout)latstart
4025 WRITE(igdout)lonstart