module post_fv3 use mpi use module_fv3_io_def, only : wrttasks_per_group, filename_base, & lon1, lat1, lon2, lat2, dlon, dlat, & cen_lon, cen_lat, dxin=>dx, dyin=>dy, & stdlat1, stdlat2, output_grid use write_internal_state, only : wrt_internal_state implicit none public post_run_fv3 contains subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & itasks,jtasks,mynfhr,mynfmin,mynfsec) ! ! revision history: ! Jul 2019 J. Wang create interface to run inline post for FV3 ! Sep 2020 J. Dong/J. Wang create interface to run inline post for FV3-LAM ! Apr 2021 R. Sun Added variables for Thomspon MP ! Apr 2022 W. Meng 1)unify global and regional inline post interfaces ! 2)add bug fix for dx/dy computation ! 3)add reading pwat from FV3 ! 4)remove some variable initializations ! 5)read max/min 2m T from tmax_max2m/tmin_min2m ! for GFS, and from t02max/min for RRFS ! and HAFS. ! 6)read 3D cloud fraction from cld_amt for GFDL MP, ! and from cldfra for other MPs. ! Jun 2022 J. Meng 2D decomposition ! Jul 2022 W. Meng 1)output lat/lon of four corner point for rotated ! lat-lon grid. ! 2)read instant model top logwave ! !----------------------------------------------------------------------- !*** run post on write grid comp !----------------------------------------------------------------------- ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,jsta, & jend,ista,iend, im, nsoil, filenameflat,numx use gridspec_mod, only : maptype, gridtype,latstart,latlast, & lonstart,lonlast use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl use xml_perl_data,only : paramset ! !----------------------------------------------------------------------- ! implicit none ! !----------------------------------------------------------------------- ! type(wrt_internal_state),intent(inout) :: wrt_int_state integer,intent(in) :: grid_id integer,intent(in) :: mype integer,intent(in) :: mpicomp integer,intent(in) :: lead_write integer,intent(in) :: itasks, jtasks integer,intent(in) :: mynfhr integer,intent(in) :: mynfmin integer,intent(in) :: mynfsec ! !----------------------------------------------------------------------- !*** LOCAL VARIABLES !----------------------------------------------------------------------- ! integer :: n,nwtpg,ierr,i,j,k,its,ite,jts,jte integer,allocatable :: istagrp(:),iendgrp(:),jstagrp(:),jendgrp(:) integer,save :: kpo,kth,kpv logical,save :: first_run=.true. logical,save :: read_postcntrl=.false. real(4),dimension(komax),save :: po, th, pv character(255) :: post_fname integer,save :: iostatusD3D=-1 ! !----------------------------------------------------------------------- !*** set up dimensions !----------------------------------------------------------------------- ! numx = itasks call post_getattr_fv3(wrt_int_state, grid_id) grib = "grib2" gridtype = "A" nsoil = wrt_int_state%nsoil nwtpg = wrt_int_state%petcount jts = wrt_int_state%out_grid_info(grid_id)%j_start !<-- Starting J of this write task's subsection jte = wrt_int_state%out_grid_info(grid_id)%j_end !<-- Ending J of this write task's subsection its = wrt_int_state%out_grid_info(grid_id)%i_start !<-- Starting I of this write task's subsection ite = wrt_int_state%out_grid_info(grid_id)%i_end !<-- Ending I of this write task's subsection if(mype==0) print *,'in post_run, numx=',numx,'its=',its,'ite=',ite,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'wrt_int_state%FBCount=',wrt_int_state%FBCount ! !----------------------------------------------------------------------- !*** set up fields to run post !----------------------------------------------------------------------- ! if (allocated(jstagrp)) deallocate(jstagrp) if (allocated(jendgrp)) deallocate(jendgrp) if (allocated(istagrp)) deallocate(istagrp) if (allocated(iendgrp)) deallocate(iendgrp) allocate(jstagrp(nwtpg),jendgrp(nwtpg)) allocate(istagrp(nwtpg),iendgrp(nwtpg)) ! do n=0,nwtpg-1 jstagrp(n+1) = wrt_int_state%out_grid_info(grid_id)%j_start_wrtgrp(n+1) jendgrp(n+1) = wrt_int_state%out_grid_info(grid_id)%j_end_wrtgrp (n+1) istagrp(n+1) = wrt_int_state%out_grid_info(grid_id)%i_start_wrtgrp(n+1) iendgrp(n+1) = wrt_int_state%out_grid_info(grid_id)%i_end_wrtgrp (n+1) enddo if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp if(mype==0) print *,'in post_run,istagrp=',istagrp,'iendgrp=',iendgrp !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_namelist) ! !----------------------------------------------------------------------- !*** allocate post variables !----------------------------------------------------------------------- ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%out_grid_info(grid_id)%im, & wrt_int_state%out_grid_info(grid_id)%jm, wrt_int_state%out_grid_info(grid_id)%lm,'mype=',mype,'wrttasks_per_group=', & wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & 'jstagrp=',jstagrp,'jendgrp=',jendgrp call post_alctvars(wrt_int_state%out_grid_info(grid_id)%im, & wrt_int_state%out_grid_info(grid_id)%jm, & wrt_int_state%out_grid_info(grid_id)%lm, & mype,wrttasks_per_group,lead_write, & mpicomp,jts,jte,jstagrp,jendgrp,its,ite,istagrp,iendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! first_grbtbl = first_run read_postcntrl = .true. ! !----------------------------------------------------------------------- !*** fill post variables with values from forecast results !----------------------------------------------------------------------- ! ifhr = mynfhr ifmin = mynfmin if (ifhr == 0) ifmin = 0 if (mype == 0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr call set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) if (read_postcntrl) then if (ifhr == 0) then filenameflat = 'postxconfig-NT_FH00.txt' call read_xml() else if(ifhr > 0) then filenameflat = 'postxconfig-NT.txt' if(associated(paramset)) then if(size(paramset)>0) then do i=1,size(paramset) if (associated(paramset(i)%param)) then if (size(paramset(i)%param)>0) then deallocate(paramset(i)%param) nullify(paramset(i)%param) endif endif enddo endif deallocate(paramset) nullify(paramset) endif num_pset = 0 call read_xml() read_postcntrl = .false. endif if(mype==0) print *,'af read_xml,name=',trim(filenameflat),' ifhr=',ifhr,' num_pset=',num_pset endif ! do npset = 1, num_pset call set_outflds(kth,th,kpv,pv) if(allocated(datapd))deallocate(datapd) allocate(datapd(ite-its+1,jte-jts+1,nrecout+100)) !$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,datapd,ista,iend) do k=1,nrecout+100 do j=1,jend+1-jsta do i=1,iend+1-ista datapd(i,j,k) = 0. enddo enddo enddo call get_postfilename(post_fname) if (grid_id > 1) then write(post_fname, '(A,I2.2)') trim(post_fname)//".nest", grid_id endif if (mype==0) print *,'post_fname=',trim(post_fname) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) call mpi_barrier(mpicomp,ierr) call gribit2(post_fname) if(allocated(datapd))deallocate(datapd) if(allocated(fld_info))deallocate(fld_info) enddo if( first_run ) then first_run = .false. endif call post_finalize('grib2') end subroutine post_run_fv3 ! !----------------------------------------------------------------------- ! subroutine post_getattr_fv3(wrt_int_state,grid_id) ! use esmf use ctlblk_mod, only: im, jm, mpi_comm_comp,gdsdegr,spval use gridspec_mod, only: latstart, latlast, lonstart, & lonlast, cenlon, cenlat, dxval, & dyval, truelat2, truelat1,psmapf, & lonstartv, lonlastv, cenlonv, & latstartv, latlastv, cenlatv, & latstart_r,latlast_r,lonstart_r, & lonlast_r, STANDLON, maptype, gridtype, & latse,lonse,latnw,lonnw ! implicit none ! type(wrt_internal_state),intent(inout) :: wrt_int_state integer, intent(in) :: grid_id ! ! local variable integer i,j,k,n,kz, attcount, nfb integer ni,naryi,nr4,nr8,rc integer aklen,varival real(4) varr4val real(8) varr8val character(80) attName, hydrostatics, fldname type(ESMF_TypeKind_Flag) :: typekind real(4), dimension(:), allocatable :: ak4,bk4 real(8), dimension(:), allocatable :: ak8,bk8 type(ESMF_FieldBundle) :: fldbundle character(128) :: wrtFBName ! spval = 9.99e20 ! field bundle do nfb=1, wrt_int_state%FBcount fldbundle = wrt_int_state%wrtFB(nfb) call ESMF_FieldBundleGet(fldbundle, name=wrtFBName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle ! set grid spec: ! if(mype==0) print*,'in post_getattr_lam,output_grid=',trim(output_grid(grid_id)),'nfb=',nfb ! if(mype==0) print*,'in post_getattr_lam, lon1=',lon1,lon2,lat1,lat2,dlon,dlat gdsdegr = 1000000. if(trim(output_grid(grid_id)) == 'regional_latlon' .or. & trim(output_grid(grid_id)) == 'regional_latlon_moving') then MAPTYPE=0 gridtype='A' if( lon1(grid_id)<0 ) then lonstart = nint((lon1(grid_id)+360.)*gdsdegr) else lonstart = nint(lon1(grid_id)*gdsdegr) endif if( lon2(grid_id)<0 ) then lonlast = nint((lon2(grid_id)+360.)*gdsdegr) else lonlast = nint(lon2(grid_id)*gdsdegr) endif latstart = nint(lat1(grid_id)*gdsdegr) latlast = nint(lat2(grid_id)*gdsdegr) dxval = dlon(grid_id)*gdsdegr dyval = dlat(grid_id)*gdsdegr ! if(mype==0) print*,'lonstart,latstart,dyval,dxval', & ! lonstart,lonlast,latstart,latlast,dyval,dxval else if(trim(output_grid(grid_id)) == 'lambert_conformal') then MAPTYPE=1 GRIDTYPE='A' if( cen_lon(grid_id)<0 ) then cenlon = nint((cen_lon(grid_id)+360.)*gdsdegr) else cenlon = nint(cen_lon(grid_id)*gdsdegr) endif cenlat = cen_lat(grid_id)*gdsdegr if( lon1(grid_id)<0 ) then lonstart = nint((lon1(grid_id)+360.)*gdsdegr) else lonstart = nint(lon1(grid_id)*gdsdegr) endif latstart = nint(lat1(grid_id)*gdsdegr) truelat1 = nint(stdlat1(grid_id)*gdsdegr) truelat2 = nint(stdlat2(grid_id)*gdsdegr) if(dxin(grid_id)1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%out_grid_info(grid_id)%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif else if (typekind==ESMF_TYPEKIND_R8) then if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%out_grid_info(grid_id)%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif wrt_int_state%out_grid_info(grid_id)%lm = size(wrt_int_state%ak) - 1 endif endif ! enddo ! enddo !end nfb ! end subroutine post_getattr_fv3 ! !----------------------------------------------------------------------- ! subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) ! ! revision history: ! Jul 2019 J. Wang Initial code ! Apr 2022 W. Meng Unify set_postvars_gfs and ! set_postvars_regional to set_postvars_fv3 ! Apr 2023 W. Meng Sync RRFS and GFS changes from off-line post ! Jun 2023 W. Meng Remove duplicate initialization; ! relocate computation of aerosol fields ! !----------------------------------------------------------------------- !*** set up post fields from nmint_state !----------------------------------------------------------------------- ! use esmf use vrbls4d, only: dust, smoke, fv3dust, coarsepm, SALT, SUSO, SOOT, & WASO,no3,nh4, PP25, PP10 use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & pint, exch_h, ref_10cm, qqni, qqnr, qqnw, qqnwfa, & qqnifa, effri, effrl, effrs, aextc55, taod5503d, & duem, dusd, dudp, duwt, dusv, ssem, sssd, ssdp, & sswt, sssv, bcem, bcsd, bcdp, bcwt, bcsv, ocem, & ocsd, ocdp, ocwt, ocsv, rhomid use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, albase, & avgalbedo, avgtcdc, czen, czmean, mxsnal,landfrac,& radot, cfrach, cfracl, cfracm, avgcfrach, qshltr, & avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & bgroff, rlwin, & rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & rswinc, rswout, aswin, auvbin, auvbinc, aswout, & aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, & smstav, smstot, ivgtyp, isltyp, sfcevp, sfcexc, & acsnow, acsnom, sst, thz0, qz0, uz0, vz0, ptop, & htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, & pbotm, ttopm, ptoph, pboth, pblcfr, ttoph, runoff,& tecan, tetran, tedir, twa, sndepac, & maxtshltr, mintshltr, maxrhshltr, minrhshltr, & dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, & htops, hbots, aswintoa, maxqshltr, minqshltr, & acond, sr, u10h, v10h, avgedir, avgecan,paha,pahi,& avgetrans, avgesnow, avgprec_cont, avgcprate_cont,& avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, & alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& avgpotevp, snoavg, ti, si, cuppt, fdnsst, & w_up_max, w_dn_max, up_heli_max,up_heli_min, & up_heli_max03,up_heli_min03,rel_vort_max01, & rel_vort_max, rel_vort_maxhy1, refd_max, & refdm10c_max, u10max, v10max, wspd10max, sfcuxi, & sfcvxi, t10m, t10avg, psfcavg, akhsavg, akmsavg, & albedo, tg, prate_max, pwat, snow_acm, snow_bkt, & acgraup, graup_bucket, acfrain, frzrn_bucket, & ltg1_max, ltg2_max, ltg3_max, ebb, hwp, & aod550,du_aod550,ss_aod550,su_aod550,oc_aod550, & bc_aod550,maod, & dustpm10, dustcb, bccb, occb, sulfcb, sscb, & dustallcb, ssallcb, dustpm, sspm, pp25cb, pp10cb, & no3cb, nh4cb, dusmass, ducmass, dusmass25,ducmass25, & snownc, graupelnc, qrmax, hail_maxhailcast use soil, only: sldpth, sh2o, smc, stc, sllevel use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & ista, iend, ista_2l, iend_2u, ista_m,iend_m,qmin, & lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & alsl, spl, ihrst, modelname, nsoil, rdaod, gocart_on, & gccpp_on, nasa_on, d2d_chem, nbin_ss, nbin_bc, nbin_oc,& nbin_du,nbin_su, nbin_no3, nbin_nh4 use params_mod, only: erad, dtr, capa, p1000, small,h1, d608, pi, rd use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat, & dxval, dyval, truelat2, truelat1, psmapf, cenlat, & lonstartv, lonlastv, cenlonv, latstartv, latlastv, & cenlatv,latstart_r,latlast_r,lonstart_r,lonlast_r, & maptype, gridtype, STANDLON,latse,lonse,latnw,lonnw use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & qs0, sqs, sthe, ttblq, rdpq, rdtheq, stheq, the0q, the0 use physcons, only: grav => con_g, fv => con_fvirt, rgas => con_rd, & eps => con_eps, epsm1 => con_epsm1 use rqstfld_mod ! ! use write_internal_state, only: wrt_internal_state ! !----------------------------------------------------------------------- ! implicit none ! !----------------------------------------------------------------------- ! type(wrt_internal_state),intent(in) :: wrt_int_state integer,intent(in) :: grid_id integer,intent(in) :: mype integer,intent(in) :: mpicomp ! !----------------------------------------------------------------------- ! integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer i1,i2,j1,j2,k1,k2 integer fieldDimCount,gridDimCount,ncount_field,bundle_grid_id integer jdate(8) logical foundland, foundice, found, mvispresent integer totalLBound3d(3), totalUBound3d(3) real(4) rinc(5), fillvalue real(8) fillvalue8 real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp real, dimension(:),allocatable :: ak5, bk5 real(ESMF_KIND_R4),dimension(:,:),pointer :: arrayr42d real(ESMF_KIND_R8),dimension(:,:),pointer :: arrayr82d real(ESMF_KIND_R4),dimension(:,:,:),pointer :: arrayr43d real(ESMF_KIND_R8),dimension(:,:,:),pointer :: arrayr83d real,dimension(:), allocatable :: slat,qstl real,external::FPVSNEW real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & cw2d, cfr2d, snacc_land, snacc_ice real,dimension(:,:,:),allocatable :: ext550 character(len=80) :: fieldname, wrtFBName, flatlon, & VarName type(ESMF_Grid) :: wrtGrid type(ESMF_Field) :: theField type(ESMF_Field), allocatable :: fcstField(:) type(ESMF_TypeKind_Flag) :: typekind type(ESMF_TypeKind_Flag) :: attTypeKind ! !----------------------------------------------------------------------- !*** INTEGER SCALAR/1D HISTORY VARIABLES !----------------------------------------------------------------------- ! imp_physics = wrt_int_state%imp_physics !set GFS mp physics to 99 for Zhao scheme dtp = wrt_int_state%dtp iSF_SURFACE_PHYSICS = 2 spval = 9.99e20 ! ! nems gfs has zhour defined tprec = float(wrt_int_state%fhzero) tclod = tprec trdlw = tprec trdsw = tprec tsrfc = tprec tmaxmin = tprec td3d = tprec ! if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'tprec=',tprec,'tclod=',tclod, & ! 'dtp=',dtp,'tmaxmin=',tmaxmin,'jsta=',jsta,jend,im,jm ! write(6,*) 'maptype and gridtype is ', maptype,gridtype ! !$omp parallel do default(shared),private(i,j) do j=jsta,jend do i=ista,iend gdlat(i,j) = wrt_int_state%out_grid_info(grid_id)%latPtr(i,j) gdlon(i,j) = wrt_int_state%out_grid_info(grid_id)%lonPtr(i,j) enddo enddo call exch(gdlat) call exch(gdlon) !$omp parallel do default(none),private(i,j,ip1), & !$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy,ista,iend_m,maptype,dxval,dyval,gdsdegr) do j = jsta, jend_m do i = ista, iend_m ip1 = i + 1 !if (ip1 > im) ip1 = ip1 - im if(maptype==207)then dx(i,j)=erad*dxval*dtr/gdsdegr dy(i,j)=erad*dyval*dtr/gdsdegr else dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr dy(i,j) = erad*(gdlat(i,j+1)-gdlat(i,j))*dtr ! like A*DPH endif end do end do ! if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) do i=1,lm+1 ak5(i) = wrt_int_state%ak(i) bk5(i) = wrt_int_state%bk(i) enddo !$omp parallel do default(none) private(i,j) shared(jsta,jend,f,gdlat,ista,iend) do j=jsta,jend do i=ista,iend f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) end do end do ! pt = ak5(1) ! GFS set up DT to compute accumulated fields, set it to one dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs !Allocate for regional models only if(modelname=='FV3R') then allocate(ext550(ista:iend,jsta:jend,lm)) allocate(snacc_ice(ista:iend,jsta:jend)) allocate(snacc_land(ista:iend,jsta:jend)) do j=jsta,jend do i=ista,iend snacc_ice(i,j)=spval snacc_land(i,j)=spval end do end do do l=1,lm do j=jsta,jend do i=ista,iend ext550(i,j,l)=spval end do end do end do endif ! ! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam sldpth(1) = 0.10 sldpth(2) = 0.3 sldpth(3) = 0.6 sldpth(4) = 1.0 ! set ncfrcv to 1, ncfrst to 1 !$omp parallel do default(none),private(i,j),shared(jsta,jend,spval,ista,iend), & !$omp& shared(ncfrcv,ncfrst) do j=jsta,jend do i=ista,iend ncfrcv(i,j) = 1.0 ncfrst(i,j) = 1.0 enddo enddo ! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1 ardlw = 1.0 ! GFS incoming sfc longwave has been averaged, set ARDLW to 1 ardsw = 1.0 ! GFS surface flux has been averaged, set ASRFC to 1 asrfc = 1.0 ! set avrain to 1 avrain = 1.0 avcnvc = 1.0 theat = 6.0 ! just in case GFS decides to output T tendency ! ! get inital date sdat(1) = wrt_int_state%idate(2) !month sdat(2) = wrt_int_state%idate(3) !day sdat(3) = wrt_int_state%idate(1) !year ihrst = wrt_int_state%idate(4) !hour idat(1) = wrt_int_state%fdate(2) idat(2) = wrt_int_state%fdate(3) idat(3) = wrt_int_state%fdate(1) idat(4) = wrt_int_state%fdate(4) idat(5) = wrt_int_state%fdate(5) ! ! if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst ! CALL W3DIFDAT(JDATE,IDATE,0,RINC) ! ! if(mype==0)print *,' rinc=',rinc ! ifhr = nint(rinc(2)+rinc(1)*24.) ! if(mype==0)print *,' ifhr=',ifhr ! ifmin = nint(rinc(3)) ! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop ! if(mype==0)print*,' in INITPOST ifhr ifmin =',ifhr,ifmin ! tstart = 0. ! !----------------------------------------------------------------------------- ! get post fields !----------------------------------------------------------------------------- ! foundland = .false. foundice = .false. get_lsmsk: do ibdl=1, wrt_int_state%FBCount call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), name=wrtFBName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle call ESMF_AttributeGet(wrt_int_state%wrtFB(ibdl), convention="NetCDF", purpose="FV3", & name="grid_id", value=bundle_grid_id, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out if (grid_id /= bundle_grid_id) cycle ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out call ESMF_AttributeGet(theField, convention="NetCDF", purpose="FV3", & name='_FillValue', value=fillvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! print *,'in post_lam, get land field value,fillvalue=',fillvalue !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm,fillValue) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue)>small ) then sm(i,j) = 1.- arrayr42d(i,j) else sm(i,j) = spval endif enddo enddo foundland = .true. endif ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out call ESMF_AttributeGet(theField, convention="NetCDF", purpose="FV3", & name='_FillValue', value=fillvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in post_lam, get icec field value,fillvalue=',fillvalue !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm,fillValue) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) if(abs(arrayr42d(i,j)-fillvalue) small) then ths(i,j) = arrayr42d(i,j) else ths(i,j) = spval endif enddo enddo endif ! foundation temperature if(trim(fieldname)=='tref') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,fdnsst) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then fdnsst(i,j) = arrayr42d(i,j) endif enddo enddo endif ! convective precip in m per physics time step if(trim(fieldname)=='cpratb_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dtq2,arrayr42d,avgcprate,fillValue,spval) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) else avgcprate(i,j) = spval endif enddo enddo endif ! continuous bucket convective precip in m per physics time step if(trim(fieldname)=='cprat_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) else avgcprate_cont(i,j) = spval endif enddo enddo endif ! time averaged bucketed precip rate if(trim(fieldname)=='prateb_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) else avgprec(i,j) = spval endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step if(trim(fieldname)=='prate_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) else avgprec_cont(i,j) = spval endif enddo enddo endif ! precip rate in m per physics time step if(trim(fieldname)=='tprcp') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp else prec(i,j) = spval endif enddo enddo endif ! convective precip rate in m per physics time step if(trim(fieldname)=='cnvprcp') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp else cprate(i,j) = 0. endif enddo enddo endif !Accumulated snowfall if(trim(fieldname)=='tsnowp') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snow_acm,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend snow_acm(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) snow_acm(i,j) = spval enddo enddo endif !Snowfall bucket if(trim(fieldname)=='tsnowpb') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snow_bkt,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend snow_bkt(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) snow_bkt(i,j) = spval enddo enddo endif !Accumulated graupel if(trim(fieldname)=='frozr') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,acgraup,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend acgraup(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) acgraup(i,j) = spval enddo enddo endif !Graupel bucket if(trim(fieldname)=='frozrb') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,graup_bucket,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend graup_bucket(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) graup_bucket(i,j) = spval enddo enddo endif !Accumulated freezing rain if(trim(fieldname)=='frzr') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,acfrain,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend acfrain(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) acfrain(i,j) = spval enddo enddo endif !Freezing rain bucket if(trim(fieldname)=='frzrb') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,frzrn_bucket,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend frzrn_bucket(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) frzrn_bucket(i,j) = spval enddo enddo endif !time step snow (in m) if(trim(fieldname)=='snow') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snownc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend snownc(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) snownc(i,j) = spval enddo enddo endif !time step graupel (in m) if(trim(fieldname)=='graupel') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,graupelnc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend graupelnc(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) graupelnc(i,j) = spval enddo enddo endif ! max hourly surface precipitation rate if(trim(fieldname)=='pratemax') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,prate_max,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend prate_max(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) prate_max(i,j) = spval enddo enddo endif ! max hourly 1-km agl reflectivity if(trim(fieldname)=='refdmax') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,refd_max,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend refd_max(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) refd_max(i,j) = spval enddo enddo endif ! max hourly -10C reflectivity if(trim(fieldname)=='refdmax263k') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,refdm10c_max,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend refdm10c_max(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) refdm10c_max(i,j) = spval enddo enddo endif ! max hourly u comp of 10m agl wind if(trim(fieldname)=='u10max') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,u10max,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend u10max(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) u10max(i,j) = spval enddo enddo endif ! max hourly v comp of 10m agl wind if(trim(fieldname)=='v10max') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,v10max,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend v10max(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) v10max(i,j) = spval enddo enddo endif ! max hourly 10m agl wind speed if(trim(fieldname)=='spd10max') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,wspd10max,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend wspd10max(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) wspd10max(i,j) = spval enddo enddo endif ! inst snow water eqivalent if(trim(fieldname)=='weasd') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval if (abs(arrayr42d(i,j)-fillValue) < small) sno(i,j) = spval enddo enddo endif ! ave snow cover if(trim(fieldname)=='snowc_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval if (abs(arrayr42d(i,j)-fillValue) < small) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm if(trim(fieldname)=='snod') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval if (abs(arrayr42d(i,j)-fillValue) < small) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) if(trim(fieldname)=='tmp2m') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) tshltr(i,j) = spval enddo enddo endif ! surface potential T if(trim(fieldname)=='spfh2m') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) qshltr(i,j) = spval enddo enddo endif ! mid day avg albedo in fraction if(trim(fieldname)=='albdo_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) avgalbedo(i,j) = spval if (avgalbedo(i,j) /= spval) then avgalbedo(i,j) = avgalbedo(i,j) * 0.01 endif enddo enddo endif ! time averaged column cloud fraction if(trim(fieldname)=='tcdc_aveclm') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) avgtcdc(i,j) = spval if (avgtcdc(i,j) /= spval) then avgtcdc(i,j) = avgtcdc(i,j) * 0.01 endif enddo enddo endif ! maximum snow albedo in fraction if(trim(fieldname)=='snoalb') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) mxsnal(i,j) = spval enddo enddo endif ! land fraction if(trim(fieldname)=='lfrac') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,landfrac,arrayr42d,sm) do j=jsta,jend do i=ista, iend landfrac(i,j) = arrayr42d(i,j) if (sm(i,j) /= 0.0) landfrac(i,j) = spval enddo enddo endif ! ave high cloud fraction if(trim(fieldname)=='tcdc_avehcl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) avgcfrach(i,j) = spval if (avgcfrach(i,j) /= spval) then avgcfrach(i,j) = avgcfrach(i,j) * 0.01 endif enddo enddo endif ! ave low cloud fraction if(trim(fieldname)=='tcdc_avelcl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) avgcfracl(i,j) = spval if (avgcfracl(i,j) /= spval) then avgcfracl(i,j) = avgcfracl(i,j) * 0.01 endif enddo enddo endif ! ave middle cloud fraction if(trim(fieldname)=='tcdc_avemcl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) avgcfracm(i,j) = spval if (avgcfracm(i,j) /= spval) then avgcfracm(i,j) = avgcfracm(i,j) * 0.01 endif enddo enddo endif ! inst convective cloud fraction if(trim(fieldname)=='tcdccnvcl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) cnvcfr(i,j) = spval if (cnvcfr(i,j) /= spval) then cnvcfr(i,j) = cnvcfr(i,j) * 0.01 endif enddo enddo endif ! slope type if(trim(fieldname)=='sltyp') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval .and. abs(arrayr42d(i,j)-fillValue) > small) then islope(i,j) = nint(arrayr42d(i,j)) else islope(i,j) = 0 endif if (abs(arrayr42d(i,j)-fillValue) < small) islope(i,j) = 0 enddo enddo endif ! time averaged column cloud fraction if(trim(fieldname)=='cnwat') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) if (abs(arrayr42d(i,j)-fillValue) < small) cmc(i,j) = spval if (cmc(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001 if (sm(i,j) /= 0.0) cmc(i,j) = spval enddo enddo endif ! frozen precip fraction if(trim(fieldname)=='cpofp') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then !set range within (0,1) sr(i,j) = min(1.,max(0.,arrayr42d(i,j))) else sr(i,j) = spval endif enddo enddo endif ! sea ice skin temperature if(trim(fieldname)=='tisfc') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti,fillValue) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then ti(i,j) = arrayr42d(i,j) if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval else ti(i,j) = spval endif enddo enddo endif ! vegetation fraction if(trim(fieldname)=='veg') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) vegfrc(i,j)=spval if (vegfrc(i,j) /= spval) then vegfrc(i,j) = vegfrc(i,j) * 0.01 else vegfrc(i,j) = 0.0 endif if (sm(i,j) /= 0.0) vegfrc(i,j) = spval enddo enddo endif !assign soil depths for RUC LSM, hard wire 9 soil depths here !so they aren't missing. if (nsoil==9) then sllevel(1) = 0.0 sllevel(2) = 0.01 sllevel(3) = 0.04 sllevel(4) = 0.1 sllevel(5) = 0.3 sllevel(6) = 0.6 sllevel(7) = 1.0 sllevel(8) = 1.6 sllevel(9) = 3.0 endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill1') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,1) = spval if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval enddo enddo endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill2') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,2) = spval if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval enddo enddo endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill3') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,3) = spval if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval enddo enddo endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill4') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,4) = spval if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval enddo enddo endif if(nsoil==9) then ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill5') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,5) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,5) = spval if (sm(i,j) /= 0.0) sh2o(i,j,5) = spval enddo enddo endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill6') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,6) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,6) = spval if (sm(i,j) /= 0.0) sh2o(i,j,6) = spval enddo enddo endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill7') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,7) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,7) = spval if (sm(i,j) /= 0.0) sh2o(i,j,7) = spval enddo enddo endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill8') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,8) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,8) = spval if (sm(i,j) /= 0.0) sh2o(i,j,8) = spval enddo enddo endif ! liquid volumetric soil mpisture in fraction if(trim(fieldname)=='soill9') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend sh2o(i,j,9) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,9) = spval if (sm(i,j) /= 0.0) sh2o(i,j,9) = spval enddo enddo endif endif !nsoil ! volumetric soil moisture if(trim(fieldname)=='soilw1') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,1) = spval if (sm(i,j) /= 0.0) smc(i,j,1) = spval enddo enddo endif ! volumetric soil moisture if(trim(fieldname)=='soilw2') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,2) = spval if (sm(i,j) /= 0.0) smc(i,j,2) = spval enddo enddo endif ! volumetric soil moisture if(trim(fieldname)=='soilw3') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,3) = spval if (sm(i,j) /= 0.0) smc(i,j,3) = spval enddo enddo endif ! volumetric soil moisture if(trim(fieldname)=='soilw4') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,4) = spval if (sm(i,j) /= 0.0) smc(i,j,4) = spval enddo enddo endif if(nsoil==9) then ! volumetric soil moisture if(trim(fieldname)=='soilw5') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,5) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,5) = spval if (sm(i,j) /= 0.0) smc(i,j,5) = spval enddo enddo endif if(trim(fieldname)=='soilw6') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,6) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,6) = spval if (sm(i,j) /= 0.0) smc(i,j,6) = spval enddo enddo endif if(trim(fieldname)=='soilw7') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,7) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,7) = spval if (sm(i,j) /= 0.0) smc(i,j,7) = spval enddo enddo endif if(trim(fieldname)=='soilw8') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,8) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,8) = spval if (sm(i,j) /= 0.0) smc(i,j,8) = spval enddo enddo endif if(trim(fieldname)=='soilw9') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) do j=jsta,jend do i=ista, iend smc(i,j,9) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) smc(i,j,9) = spval if (sm(i,j) /= 0.0) smc(i,j,9) = spval enddo enddo endif endif !nsoil ! soil temperature if(trim(fieldname)=='soilt1') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,1) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval enddo enddo endif ! soil temperature if(trim(fieldname)=='soilt2') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,2) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval enddo enddo endif ! soil temperature if(trim(fieldname)=='soilt3') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,3) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval enddo enddo endif ! soil temperature if(trim(fieldname)=='soilt4') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,4) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval enddo enddo endif if(nsoil==9) then ! soil temperature if(trim(fieldname)=='soilt5') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,5) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,5) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,5) = spval enddo enddo endif ! soil temperature if(trim(fieldname)=='soilt6') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,6) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,6) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,6) = spval enddo enddo endif ! soil temperature if(trim(fieldname)=='soilt7') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,7) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,7) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,7) = spval enddo enddo endif ! soil temperature if(trim(fieldname)=='soilt8') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,8) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,8) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,8) = spval enddo enddo endif ! soil temperature if(trim(fieldname)=='soilt9') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend stc(i,j,9) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) stc(i,j,9) = spval !mask open water areas, combine with sea ice tmp if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,9) = spval enddo enddo endif endif !nsoil ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) alwin(i,j) = spval enddo enddo endif ! inst incoming sfc longwave if(trim(fieldname)=='dlwrf') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) rlwin(i,j) = spval enddo enddo endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign if(trim(fieldname)=='ulwrf_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) alwout(i,j) = spval if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j) enddo enddo endif ! inst outgoing sfc longwave if(trim(fieldname)=='ulwrf') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) radot(i,j) = spval enddo enddo endif ! time averaged outgoing model top longwave if(trim(fieldname)=='ulwrf_avetoa') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) alwtoa(i,j) = spval enddo enddo endif ! outgoing model top logwave if(trim(fieldname)=='ulwrf_toa') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwtoa,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend rlwtoa(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue)< small) rlwtoa(i,j) = spval enddo enddo endif ! time averaged incoming sfc shortwave if(trim(fieldname)=='dswrf_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) aswin(i,j) = spval enddo enddo endif ! inst incoming sfc shortwave if(trim(fieldname)=='dswrf') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) rswin(i,j) = spval enddo enddo endif ! time averaged incoming sfc uv-b if(trim(fieldname)=='duvb_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) auvbin(i,j) = spval enddo enddo endif ! time averaged incoming sfc clear sky uv-b if(trim(fieldname)=='cduvb_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) auvbinc(i,j) = spval enddo enddo endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign if(trim(fieldname)=='uswrf_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) aswout(i,j) = spval if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j) enddo enddo endif ! inst outgoing sfc shortwave if(trim(fieldname)=='uswrf') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) rswout(i,j) = spval enddo enddo endif ! time averaged model top incoming shortwave if(trim(fieldname)=='dswrf_avetoa') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) aswintoa(i,j) = spval enddo enddo endif ! ime averaged model top outgoing shortwave if(trim(fieldname)=='uswrf_avetoa') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) aswtoa(i,j) = spval enddo enddo endif ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio if(trim(fieldname)=='shtfl_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sfcshx(i,j) = spval if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j) enddo enddo endif ! inst surface sensible heat flux if(trim(fieldname)=='shtfl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) twbs(i,j) = spval if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j) enddo enddo endif ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio if(trim(fieldname)=='lhtfl_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sfclhx(i,j) = spval if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j) enddo enddo endif ! inst surface latent heat flux if(trim(fieldname)=='lhtfl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) qwbs(i,j) = spval if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j) enddo enddo endif ! time averaged ground heat flux if(trim(fieldname)=='gflux_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) subshx(i,j) = spval if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux if(trim(fieldname)=='gflux') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) grnflx(i,j) = spval if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux if(trim(fieldname)=='uflx_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sfcux(i,j) = spval enddo enddo endif ! time averaged meridional momentum flux if(trim(fieldname)=='vflx_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sfcvx(i,j) = spval enddo enddo endif ! inst zonal momentum flux if(trim(fieldname)=='uflx') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcuxi,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend sfcuxi(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sfcuxi(i,j) = spval enddo enddo endif ! inst meridional momentum flux if(trim(fieldname)=='vflx') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvxi,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend sfcvxi(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) sfcvxi(i,j) = spval enddo enddo endif ! time averaged zonal gravity wave stress if(trim(fieldname)=='u-gwd_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) gtaux(i,j) = spval enddo enddo endif ! time averaged meridional gravity wave stress if(trim(fieldname)=='v-gwd_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) gtauy(i,j) = spval enddo enddo endif ! time averaged accumulated potential evaporation if(trim(fieldname)=='pevpr_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) avgpotevp(i,j) = spval if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation if(trim(fieldname)=='pevpr') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice,fillValue) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) potevp(i,j) = spval if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval enddo enddo endif ! 10 m u if(trim(fieldname)=='ugrd10m') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h,spval,fillValue) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) u10(i,j) = spval u10h(i,j) = u10(i,j) enddo enddo endif ! 10 m v if(trim(fieldname)=='vgrd10m') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h,spval,fillValue) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) if( abs(arrayr42d(i,j)-fillValue) < small) v10(i,j) = spval v10h(i,j) = v10(i,j) enddo enddo endif ! vegetation type if(trim(fieldname)=='vtype') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then ivgtyp(i,j) = nint(arrayr42d(i,j)) if( abs(arrayr42d(i,j)-fillValue) < small) ivgtyp(i,j) = 0 else ivgtyp(i,j) = 0 endif enddo enddo endif ! soil type if(trim(fieldname)=='sotyp') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp,fillValue) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then isltyp(i,j) = nint(arrayr42d(i,j)) if( abs(arrayr42d(i,j)-fillValue) < small) isltyp(i,j) = 0 else isltyp(i,j) = 0 endif enddo enddo endif ! wetness if(trim(fieldname)=='wetness') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,smstav,arrayr42d,fillvalue,spval) do j=jsta,jend do i=ista, iend smstav(i,j) = arrayr42d(i,j) if(abs(arrayr42d(i,j)-fillvalue) gridDimCount) then else if (fieldDimCount ==3) then ! print *,'in post_lam, get field value,n=',n,'fieldname=',trim(fieldname) if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out call ESMF_AttributeGet(fcstField(n), convention="NetCDF", purpose="FV3", & name="_FillValue", typekind=attTypeKind, isPresent=mvispresent, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out if( mvispresent ) then if (attTypeKind==ESMF_TYPEKIND_R4) then call ESMF_AttributeGet(fcstField(n), convention="NetCDF", purpose="FV3", & name="_FillValue", value=fillvalue, isPresent=mvispresent, rc=rc) else call ESMF_AttributeGet(fcstField(n), convention="NetCDF", purpose="FV3", & name="_FillValue", value=fillvalue8, isPresent=mvispresent, rc=rc) fillvalue=fillvalue8 endif endif ! call ESMF_AttributeGet(fcstField(n), convention="NetCDF", purpose="FV3", & ! name='_FillValue', value=fillvalue, rc=rc) ! print *,'in post_lam, get field value,fillvalue=',fillvalue else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! print *,'in post_lam, get field valuer8,n=',n,'fieldname=',trim(fieldname) call ESMF_AttributeGet(fcstField(n), convention="NetCDF", purpose="FV3", & name='_FillValue', value=fillvalue8, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! print *,'in post_lam, get field value,fillvalue8=',fillvalue8 allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. fillvalue = fillvalue8 do k=kstart,kend !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) enddo enddo enddo endif ! model level T if(trim(fieldname)=='tmp') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d,fillvalue,spval) do l=1,lm do j=jsta,jend do i=ista, iend t(i,j,l) = arrayr43d(i,j,l) if(abs(arrayr43d(i,j,l)-fillvalue) < small) t(i,j,l) = spval enddo enddo enddo ! print *,'in post_lam,tmp 3d=',maxval(t(ista:iend,jsta:jend,1)),minval(t(ista:iend,jsta:jend,1)), & ! 'lm=',maxval(t(ista:iend,jsta:jend,lm)),minval(t(ista:iend,jsta:jend,lm)), & ! t(ista,jsta,1),arrayr43d(ista,jsta,1),'fillvlaue=',fillvalue !! sig4 !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4,spval) do j=jsta,jend do i=ista, iend if( t(i,j,lm) /= spval) then tlmh = t(i,j,lm) * t(i,j,lm) sigt4(i,j) = 5.67E-8 * tlmh * tlmh else sigt4(i,j)=spval endif enddo enddo endif ! model level spfh if(trim(fieldname)=='spfh') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d,fillvalue,spval) do l=1,lm do j=jsta,jend do i=ista, iend q(i,j,l) = arrayr43d(i,j,l) if(abs(arrayr43d(i,j,l)-fillvalue)small) zint(i,j,l)=-1.*arrayr43d(i,j,l) enddo enddo enddo ! print *,'in post_lam,zint 3d=',maxval(zint(ista:iend,jsta:jend,1)),minval(zint(ista:iend,jsta:jend,1)), & ! 'lm=',maxval(zint(ista:iend,jsta:jend,lm)),minval(zint(ista:iend,jsta:jend,lm)) endif ! model level w if(trim(fieldname)=='dzdt') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d,fillvalue,spval) do l=1,lm do j=jsta,jend do i=ista, iend wh(i,j,l) = arrayr43d(i,j,l) if(abs(arrayr43d(i,j,l)-fillvalue)