diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 786447c83..f967c71b8 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 786447c8391a6806cd7b869bfa9dca69e3c95a48 +Subproject commit f967c71b8f59c22c86de2ead1074e85e3ccf97b4 diff --git a/ccpp/physics b/ccpp/physics index d4b1cd020..c0bec7173 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d4b1cd020f8347147b86d3a18b56c03cb5c57d67 +Subproject commit c0bec7173d10ca1460986a8dea81681736a26e56 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 401fbbf86..5b67f7faa 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1149,7 +1149,7 @@ subroutine GFS_physics_driver & if (fice(i) < one) then wet(i) = .true. ! Sfcprop%tsfco(i) = tgice - Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + if (.not. Model%cplflx) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) ! Sfcprop%tsfco(i) = max((Sfcprop%tsfc(i) - fice(i)*sfcprop%tisfc(i)) & ! / (one - fice(i)), tgice) endif diff --git a/gfsphysics/GFS_layer/GFS_restart.F90 b/gfsphysics/GFS_layer/GFS_restart.F90 index eafbcb9ba..a24cc0fc6 100644 --- a/gfsphysics/GFS_layer/GFS_restart.F90 +++ b/gfsphysics/GFS_layer/GFS_restart.F90 @@ -117,6 +117,9 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & #endif Restart%num3d = Model%ntot3d + if(Model%lrefres) then + Restart%num3d = Model%ntot3d+1 + endif #ifdef CCPP ! GF if (Model%imfdeepcnv == 3) then @@ -252,7 +255,13 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%data(nb,num)%var3p => Tbd(nb)%phy_f3d(:,:,num) enddo enddo - + if (Model%lrefres) then + num = Model%ntot3d+1 + restart%name3d(num) = 'ref_f3d' + do nb = 1,nblks + Restart%data(nb,num)%var3p => IntDiag(nb)%refl_10cm(:,:) + enddo + endif #ifdef CCPP !--- RAP/HRRR-specific variables, 3D num = Model%ntot3d diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 7f8239a5a..39520b0d4 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -701,6 +701,9 @@ module GFS_typedefs !--- GFDL microphysical paramters logical :: lgfdlmprad !< flag for GFDL mp scheme and radiation consistency + !--- Thompson,GFDL mp parameter + logical :: lrefres !< flag for radar reflectivity in restart file + !--- land/surface model parameters integer :: lsm !< flag for land surface model lsm=1 for noah lsm integer :: lsm_noah=1 !< flag for NOAH land surface model @@ -2740,6 +2743,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- GFDL microphysical parameters logical :: lgfdlmprad = .false. !< flag for GFDLMP radiation interaction + !--- Thompson,GFDL microphysical parameter + logical :: lrefres = .false. !< flag for radar reflectivity in restart file + !--- land/surface model parameters integer :: lsm = 1 !< flag for land surface model to use =0 for osu lsm; =1 for noah lsm; =2 for noah mp lsm; =3 for RUC lsm integer :: lsoil = 4 !< number of soil layers @@ -3023,7 +3029,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & mg_do_graupel, mg_do_hail, mg_nccons, mg_nicons, mg_ngcons, & mg_ncnst, mg_ninst, mg_ngnst, sed_supersat, do_sb_physics, & mg_alf, mg_qcmin, mg_do_ice_gmao, mg_do_liq_liu, & - ltaerosol, lradar, ttendlim, lgfdlmprad, & + ltaerosol, lradar, lrefres, ttendlim, lgfdlmprad, & !--- max hourly avg_max_length, & !--- land/surface model control @@ -3312,6 +3318,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ttendlim = ttendlim !--- gfdl MP parameters Model%lgfdlmprad = lgfdlmprad +!--- Thompson,GFDL MP parameter + Model%lrefres = lrefres !--- land/surface model parameters Model%lsm = lsm @@ -4310,6 +4318,7 @@ subroutine control_print(Model) print *, ' Thompson microphysical parameters' print *, ' ltaerosol : ', Model%ltaerosol print *, ' lradar : ', Model%lradar + print *, ' lrefres : ', Model%lrefres print *, ' ttendlim : ', Model%ttendlim print *, ' ' endif @@ -4327,6 +4336,7 @@ subroutine control_print(Model) if (Model%imp_physics == Model%imp_physics_gfdl) then print *, ' GFDL microphysical parameters' print *, ' GFDL MP radiation inter: ', Model%lgfdlmprad + print *, ' lrefres : ', Model%lrefres print *, ' ' endif diff --git a/gfsphysics/physics/gfdl_cloud_microphys.F90 b/gfsphysics/physics/gfdl_cloud_microphys.F90 index 9a1820465..ba4c814d6 100644 --- a/gfsphysics/physics/gfdl_cloud_microphys.F90 +++ b/gfsphysics/physics/gfdl_cloud_microphys.F90 @@ -4688,7 +4688,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, real :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 real :: alphar = 0.8, alphas = 0.25, alphag = 0.5 real :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 - real :: qmin = 1.0e-12, beta = 1.22 + real :: qmin = 1.0e-12, beta = 1.22, qmin1 = 9.e-6 do k = ks, ke do i = is, ie @@ -4718,7 +4718,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! cloud ice (Heymsfield and Mcfarquhar, 1996) ! ----------------------------------------------------------------------- - if (qmi (i, k) .gt. qmin) then + if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 rei_fac = log (1.0e3 * qmi (i, k) * den (i, k)) if (t (i, k) - tice .lt. - 50) then @@ -4744,7 +4744,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! cloud ice (Wyser, 1998) ! ----------------------------------------------------------------------- - if (qmi (i, k) .gt. qmin) then + if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, tice - t (i, k)) ** 1.5 rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) @@ -4774,7 +4774,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! snow (Lin et al., 1983) ! ----------------------------------------------------------------------- - if (qms (i, k) .gt. qmin) then + if (qms (i, k) .gt. qmin1) then qcs (i, k) = dpg * qms (i, k) * 1.0e3 lambdas = exp (0.25 * log (pi * rhos * n0s / qms (i, k) / den (i, k))) res (i, k) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 diff --git a/gfsphysics/physics/satmedmfvdifq.f b/gfsphysics/physics/satmedmfvdifq.f index 1a8be355e..11c047fd0 100644 --- a/gfsphysics/physics/satmedmfvdifq.f +++ b/gfsphysics/physics/satmedmfvdifq.f @@ -151,7 +151,7 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke, & rlmn, rlmn1, rlmx, elmx, & ttend, utend, vtend, qtend, & zfac, zfmin, vk, spdk2, - & tkmin, xkzinv, xkgdx, + & tkmin, tkminx, xkzinv, xkgdx, & zlup, zldn, bsum, & tem, tem1, tem2, & ptem, ptem0, ptem1, ptem2 @@ -176,11 +176,11 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke, parameter(prmin=0.25,prmax=4.0) parameter(pr0=1.0,prtke=1.0,prscu=0.67) parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) - parameter(tkmin=1.e-9,dspmax=10.0) + parameter(tkmin=1.e-9,tkminx=0.2,dspmax=10.0) parameter(qmin=1.e-8,qlmin=1.e-12,zfmin=1.e-8) parameter(aphi5=5.,aphi16=16.) parameter(elmfac=1.0,elefac=1.0,cql=100.) - parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=25000.) + parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=5000.) parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) parameter(h1=0.33333333) parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) @@ -273,20 +273,20 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke, xkzo(i,k) = 0.0 xkzmo(i,k) = 0.0 if (k < kinver(i)) then -! vertical background diffusivity - ptem = prsi(i,k+1) * tx1(i) - tem1 = 1.0 - ptem - tem2 = tem1 * tem1 * 10.0 - tem2 = min(1.0, exp(-tem2)) - xkzo(i,k) = xkzm_hx(i) * tem2 -! +! minimum turbulent mixing length ptem = prsl(i,k) * tx1(i) tem1 = 1.0 - ptem tem2 = tem1 * tem1 * 2.5 tem2 = min(1.0, exp(-tem2)) rlmnz(i,k)= rlmn * tem2 rlmnz(i,k)= max(rlmnz(i,k), rlmn1) -! vertical background diffusivity for momentum +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 10.0 + tem2 = min(1.0, exp(-tem2)) + xkzo(i,k) = xkzm_hx(i) * tem2 +! vertical background diffusivity for momentum if (ptem >= xkzm_s) then xkzmo(i,k) = xkzm_mx(i) kx1(i) = k + 1 @@ -674,20 +674,20 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke, ! ! background diffusivity decreasing with increasing surface layer stability ! - do i = 1, im - if(.not.sfcflg(i)) then - tem = (1. + 5. * rbsoil(i))**2. -! tem = (1. + 5. * zol(i))**2. - frik(i) = 0.1 + 0.9 / tem - endif - enddo -! - do k = 1,km1 - do i=1,im - xkzo(i,k) = frik(i) * xkzo(i,k) - xkzmo(i,k)= frik(i) * xkzmo(i,k) - enddo - enddo +! do i = 1, im +! if(.not.sfcflg(i)) then +! tem = (1. + 5. * rbsoil(i))**2. +!! tem = (1. + 5. * zol(i))**2. +! frik(i) = 0.1 + 0.9 / tem +! endif +! enddo +! +! do k = 1,km1 +! do i=1,im +! xkzo(i,k) = frik(i) * xkzo(i,k) +! xkzmo(i,k)= frik(i) * xkzmo(i,k) +! enddo +! enddo ! ! The background vertical diffusivities in the inversion layers are limited ! to be less than or equal to xkzminv @@ -867,13 +867,14 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke, do i = 1, im if(k == 1) then tem = ckz(i,1) - tem1 = xkzmo(i,1) + tem1 = 0.5 * xkzmo(i,1) else tem = 0.5 * (ckz(i,k-1) + ckz(i,k)) tem1 = 0.5 * (xkzmo(i,k-1) + xkzmo(i,k)) endif ptem = tem1 / (tem * elm(i,k)) tkmnz(i,k) = ptem * ptem + tkmnz(i,k) = min(tkmnz(i,k), tkminx) tkmnz(i,k) = max(tkmnz(i,k), tkmin) enddo enddo diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 3e7b7d2e7..e7f7dbd57 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1119,15 +1119,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) - if (Sfcprop(nb)%slmsk(ix) < 0.1 .or. Sfcprop(nb)%slmsk(ix) > 1.9) then + if (Sfcprop(nb)%slmsk(ix) > 1.9) then Sfcprop(nb)%landfrac(ix) = 0.0 - if (Sfcprop(nb)%oro_uf(ix) > 0.01) then - Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake - else - Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean - endif else - Sfcprop(nb)%landfrac(ix) = 1.0 ! land + Sfcprop(nb)%landfrac(ix) = Sfcprop(nb)%slmsk(ix) endif enddo enddo diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index d0846be53..405af2841 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -71,6 +71,7 @@ module module_wrt_grid_comp logical,save :: first_init=.false. logical,save :: first_run=.false. logical,save :: first_getlatlon=.true. + logical,save :: change_wrtidate=.false. ! !----------------------------------------------------------------------- ! @@ -173,7 +174,8 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) real(ESMF_KIND_R4) :: valueR4 real(ESMF_KIND_R8) :: valueR8 - integer :: attCount, axeslen, jidx, noutfile + integer :: attCount, axeslen, jidx, idx, noutfile + character(19) :: newdate character(128) :: FBlist_outfilename(100), outfile_name character(128),dimension(:,:), allocatable :: outfilename real(8), dimension(:), allocatable :: slat @@ -183,7 +185,6 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) real(ESMF_KIND_R8) :: geo_lon, geo_lat real(ESMF_KIND_R8) :: lon1_r8, lat1_r8 real(ESMF_KIND_R8) :: x1, y1, x, y - type(ESMF_Time) :: IO_BASETIME_IAU type(ESMF_TimeInterval) :: IAU_offsetTI type(ESMF_DataCopy_Flag) :: copyflag=ESMF_DATACOPY_REFERENCE ! real(8),parameter :: PI=3.14159265358979d0 @@ -469,8 +470,32 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif +! +!----------------------------------------------------------------------- +!*** get write grid component initial time from clock +!----------------------------------------------------------------------- +! + call ESMF_ClockGet(clock =CLOCK & !<-- The ESMF Clock + ,startTime=wrt_int_state%IO_BASETIME & !<-- The Clock's starting time + ,rc =RC) - + call ESMF_TimeGet(time=wrt_int_state%IO_BASETIME,yy=idate(1),mm=idate(2),dd=idate(3),h=idate(4), & + m=idate(5),s=idate(6),rc=rc) +! if (lprnt) write(0,*) 'in wrt initial, io_baseline time=',idate,'rc=',rc + idate(7) = 1 + wrt_int_state%idate = idate + wrt_int_state%fdate = idate +! update IO-BASETIME and idate on write grid comp when IAU is enabled + if(iau_offset > 0 ) then + call ESMF_TimeIntervalSet(IAU_offsetTI, h=iau_offset, rc=rc) + wrt_int_state%IO_BASETIME = wrt_int_state%IO_BASETIME + IAU_offsetTI + call ESMF_TimeGet(time=wrt_int_state%IO_BASETIME,yy=idate(1),mm=idate(2),dd=idate(3),h=idate(4), & + m=idate(5),s=idate(6),rc=rc) + wrt_int_state%idate = idate + change_wrtidate = .true. + if (lprnt) print *,'in wrt initial, with iau, io_baseline time=',idate,'rc=',rc + endif +! ! Create field bundle !------------------------------------------------------------------- ! @@ -867,6 +892,17 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! update the time:units when idate on write grid component is changed + if ( index(trim(attNameList(i)),'time:units')>0) then + if ( change_wrtidate ) then + idx = index(trim(valueS),' since ') + if(lprnt) print *,'in write grid comp, time:unit=',trim(valueS) + write(newdate,'(I4.4,a,I2.2,a,I2.2,a,I2.2,a,I2.2,a,I2.2)') idate(1),'-', & + idate(2),'-',idate(3),' ',idate(4),':',idate(5),':',idate(6) + valueS = valueS(1:idx+6)//newdate + if(lprnt) print *,'in write grid comp, new time:unit=',trim(valueS) + endif + endif call ESMF_AttributeSet(wrtgrid, convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueS, rc=rc) @@ -1036,28 +1072,6 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! !----------------------------------------------------------------------- -!*** SET THE IO_BaseTime TO THE INITIAL CLOCK TIME. -!----------------------------------------------------------------------- -! - call ESMF_ClockGet(clock =CLOCK & !<-- The ESMF Clock - ,startTime=wrt_int_state%IO_BASETIME & !<-- The Clock's starting time - ,rc =RC) - - call ESMF_TimeGet(time=wrt_int_state%IO_BASETIME,yy=idate(1),mm=idate(2),dd=idate(3),h=idate(4), & - m=idate(5),s=idate(6),rc=rc) -! if (lprnt) write(0,*) 'in wrt initial, io_baseline time=',idate,'rc=',rc - idate(7) = 1 - wrt_int_state%idate = idate - wrt_int_state%fdate = idate - if(iau_offset > 0 ) then - call ESMF_TimeIntervalSet(IAU_offsetTI, h=iau_offset, rc=rc) - IO_BASETIME_IAU = wrt_int_state%IO_BASETIME + IAU_offsetTI - call ESMF_TimeGet(time=IO_BASETIME_IAU,yy=idate(1),mm=idate(2),dd=idate(3),h=idate(4), & - m=idate(5),s=idate(6),rc=rc) -! if (lprnt) write(0,*) 'in wrt initial, with iau, io_baseline time=',idate,'rc=',rc - endif -! -!----------------------------------------------------------------------- !*** SET THE FIRST HISTORY FILE'S TIME INDEX. !----------------------------------------------------------------------- ! @@ -1250,10 +1264,9 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! 'nseconds_num=',nseconds_num,nseconds_den,'mype=',mype ! nf_seconds = nf_hours*3600+nf_minuteS*60+nseconds+real(nseconds_num)/real(nseconds_den) - ! shift forecast hour by iau_offset if iau is on. - nf_seconds = nf_seconds - iau_offset*3600 wrt_int_state%nfhour = nf_seconds/3600. nf_hours = int(nf_seconds/3600.) + if(mype == lead_write_task) print *,'in write grid comp, nf_hours=',nf_hours ! if iau_offset > nf_hours, don't write out anything if (nf_hours < 0) return diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 7b5a87026..3ea19c555 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -342,7 +342,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & 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 + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -369,7 +369,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field - integer idate(8), jdate(8) + integer jdate(8) logical foundland, foundice, found real(4) rinc(5) real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp @@ -451,8 +451,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD -! pt = 10000. ! this is for 100 hPa added by Moorthi - pt = 0. + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -642,28 +641,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo ! ! get inital date - idate = 0 - idate(1) = wrt_int_state%idate(1) - idate(2) = wrt_int_state%idate(2) - idate(3) = wrt_int_state%idate(3) - idate(5) = wrt_int_state%idate(4) - idate(6) = wrt_int_state%idate(5) sdat(1) = wrt_int_state%idate(2) !month sdat(2) = wrt_int_state%idate(3) !day sdat(3) = wrt_int_state%idate(1) !year - jdate = 0 - jdate(1) = wrt_int_state%fdate(1) - jdate(2) = wrt_int_state%fdate(2) - jdate(3) = wrt_int_state%fdate(3) !jdate(4): time zone - jdate(5) = wrt_int_state%fdate(4) - jdate(6) = wrt_int_state%fdate(5) - idat(1) = wrt_int_state%idate(2) - idat(2) = wrt_int_state%idate(3) - idat(3) = wrt_int_state%idate(1) - idat(4) = IFHR - idat(5) = IFMIN -! -! if(mype==0) print *,'jdate=',jdate,'idate=',idate,'sdat=',sdat + 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 @@ -701,7 +690,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & 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(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, & @@ -725,7 +714,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & 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(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, & @@ -1296,7 +1285,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname)=='dlwsf') then + if(trim(fieldname)=='dlwrf') then !$omp parallel do private(i,j) do j=jsta,jend do i=ista, iend @@ -1845,6 +1834,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface clear sky outgoing LW if(trim(fieldname)=='csulf') then + !$omp parallel do private(i,j) + do j=jsta,jend + do i=ista, iend + alwoutc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged TOA clear sky outgoing LW + if(trim(fieldname)=='csulftoa') then !$omp parallel do private(i,j) do j=jsta,jend do i=ista, iend @@ -1864,7 +1863,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusf') then + if(trim(fieldname)=='csusftoa') then !$omp parallel do private(i,j) do j=jsta,jend do i=ista, iend @@ -2271,7 +2270,6 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo end do -!??? reset pint(lev=1) !$omp parallel do private(i,j) do j=jsta,jend do i=1,im @@ -2282,7 +2280,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint - do l=lp1,2,-1 + do l=lp1,1,-1 !$omp parallel do private(i,j) do j=jsta,jend do i=1,im @@ -2321,6 +2319,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo +! compute cwm for gfdlmp + if( imp_physics == 11 ) then + do l=1,lm +!$omp parallel do private(i,j) + do j=jsta,jend + do i=ista,iend + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) + enddo + enddo + enddo + endif + ! estimate 2m pres and convert t2m to theta !$omp parallel do private(i,j) do j=jsta,jend