Merge branch 'develop' of https://github.com/NOAA-EMC/fv3atm into emc…

…_devemc_update_from_dtc_develop_20191217

atmos_model.F90

@@ -113,7 +113,8 @@ module atmos_model_mod
                               FV3GFS_diag_register, FV3GFS_diag_output,  &
                               DIAG_SIZE
 use fv_iau_mod,         only: iau_external_data_type,getiauforcing,iau_initialize
-use module_fv3_config,  only: output_1st_tstep_rst, first_kdt, nsout
+use module_fv3_config,  only: output_1st_tstep_rst, first_kdt, nsout,    &
+                              frestart, restart_endfcst
 
 !-----------------------------------------------------------------------
 
@@ -221,7 +222,8 @@ module atmos_model_mod
   logical,parameter :: flip_vc = .true.
 #endif
 
-  real(kind=IPD_kind_phys), parameter :: zero=0.0, one=1.0
+  real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, &
+                                         one  = 1.0_IPD_kind_phys
 
 contains
 
@@ -944,17 +946,19 @@ end subroutine update_atmos_model_state
 subroutine atmos_model_end (Atmos)
   type (atmos_data_type), intent(inout) :: Atmos
 !---local variables
-  integer :: idx
+  integer :: idx, seconds
 #ifdef CCPP
   integer :: ierr
 #endif
 
 !-----------------------------------------------------------------------
 !---- termination routine for atmospheric model ----
 
-    call atmosphere_end (Atmos % Time, Atmos%grid)
-    call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, &
-                               IPD_Control, Atmos%domain)
+    call atmosphere_end (Atmos % Time, Atmos%grid, restart_endfcst)
+    if(restart_endfcst) then
+      call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, &
+                                 IPD_Control, Atmos%domain)
+    endif
 
 #ifdef CCPP
 !   Fast physics (from dynamics) are finalized in atmosphere_end above;
@@ -1457,6 +1461,24 @@ subroutine update_atmos_chemistry(state, rc)
         enddo
       enddo
 
+      ! -- zero out accumulated fields
+!$OMP parallel do default (none) &
+!$OMP             shared  (nj, ni, Atm_block, IPD_Control, IPD_Data) &
+!$OMP             private (j, jb, i, ib, nb, ix)
+      do j = 1, nj
+        jb = j + Atm_block%jsc - 1
+        do i = 1, ni
+          ib = i + Atm_block%isc - 1
+          nb = Atm_block%blkno(ib,jb)
+          ix = Atm_block%ixp(ib,jb)
+          IPD_Data(nb)%coupling%rainc_cpl(ix)  = zero
+          if (.not.IPD_Control%cplflx) then
+            IPD_Data(nb)%coupling%rain_cpl(ix) = zero
+            IPD_Data(nb)%coupling%snow_cpl(ix) = zero
+          end if
+        enddo
+      enddo
+
       if (IPD_Control%debug) then
         ! -- diagnostics
         write(6,'("update_atmos: prsi   - min/max/avg",3g16.6)') minval(prsi),   maxval(prsi),   sum(prsi)/size(prsi)

fv3_cap.F90

@@ -30,7 +30,7 @@ module fv3gfs_cap_mod
                                     calendar, calendar_type, cpl,            &
                                     force_date_from_configure,               &
                                     cplprint_flag,output_1st_tstep_rst,      &
-                                    first_kdt                            
+                                    first_kdt,num_restart_interval       
 
   use module_fv3_io_def,      only: num_pes_fcst,write_groups,app_domain,    &
                                     num_files, filename_base,                &
@@ -278,9 +278,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
     CALL ESMF_ConfigLoadFile(config=CF ,filename='model_configure' ,rc=RC)
     if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
 !
-    CALL ESMF_ConfigGetAttribute(config=CF,value=restart_interval, &
-                                 label ='restart_interval:',rc=rc)
+    num_restart_interval = ESMF_ConfigGetLen(config=CF, label ='restart_interval:',rc=rc)
     if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+    if(mype == 0) print *,'af nems config,num_restart_interval=',num_restart_interval
+    if (num_restart_interval<=0) num_restart_interval = 1
+    allocate(restart_interval(num_restart_interval))
+    restart_interval = 0
+    CALL  ESMF_ConfigGetAttribute(CF,valueList=restart_interval,label='restart_interval:', &
+      count=num_restart_interval, rc=RC)
+    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+    if(mype == 0) print *,'af nems config,restart_interval=',restart_interval
 !
     CALL ESMF_ConfigGetAttribute(config=CF,value=calendar, &
                                  label ='calendar:',rc=rc)
@@ -326,9 +333,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
                                    label ='app_domain:',rc=rc)
       if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
 
-      if(mype == 0) print *,'af nems config,restart_interval=',restart_interval, &
-      'quilting=',quilting,'write_groups=',write_groups,wrttasks_per_group,      &
-      'calendar=',trim(calendar),'calendar_type=',calendar_type
+      if(mype == 0) print *,'af nems config,quilting=',quilting,'write_groups=', &
+        write_groups,wrttasks_per_group,'calendar=',trim(calendar),'calendar_type=',calendar_type
 !
       CALL ESMF_ConfigGetAttribute(config=CF,value=num_files, &
                                    label ='num_files:',rc=rc)

gfsphysics/GFS_layer/GFS_physics_driver.F90

@@ -3307,9 +3307,13 @@ subroutine GFS_physics_driver                                 &
         dtdt(1:im,:) = Stateout%gt0(1:im,:)
       endif   ! end if_ldiag3d/cnvgwd
 
-      if (Model%ldiag3d) then
+      if (Model%ldiag3d .or. Model%cplchm) then
         dqdt(1:im,:,1) = Stateout%gq0(1:im,:,1)
-      endif   ! end if_ldiag3d
+      endif   ! end if_ldiag3d/cplchm
+
+      if (Model%cplchm) then
+        Coupling%dqdti(1:im,:) = zero
+      endif   ! end if_cplchm
 !*## CCPP ##
 
 !## CCPP ## Only get_prs_fv3.F90/get_phi_fv3_run is a scheme (GFS_HYDRO is assumed to be undefined)

gfsphysics/GFS_layer/GFS_radiation_driver.F90

@@ -2135,18 +2135,40 @@ subroutine GFS_radiation_driver                             &
               Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt)
               Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb)
               Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop)
+            enddo
+          enddo
 
 !       Anning adds optical depth and emissivity output
-              tem1 = 0.
-              tem2 = 0.
-              do k=ibtc,itop
-                tem1 = tem1 + cldtausw(i,k)      ! approx .55 mu channel
-                tem2 = tem2 + cldtaulw(i,k)      ! approx 10. mu channel
+          if (Model%lsswr .and. (nday > 0)) then
+            do j = 1, 3
+              do i = 1, IM
+                tem0d = raddt * cldsa(i,j)
+                itop  = mtopa(i,j) - kd
+                ibtc  = mbota(i,j) - kd
+                tem1 = 0.
+                do k=ibtc,itop
+                  tem1 = tem1 + cldtausw(i,k)      ! approx .55 um channel
+                enddo
+                Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1
               enddo
-              Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1
-              Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
             enddo
-          enddo
+          endif
+
+          if (Model%lslwr) then
+            do j = 1, 3
+              do i = 1, IM
+                tem0d = raddt * cldsa(i,j)
+                itop  = mtopa(i,j) - kd
+                ibtc  = mbota(i,j) - kd
+                tem2 = 0.
+                do k=ibtc,itop
+                  tem2 = tem2 + cldtaulw(i,k)      ! approx 10. um channel
+                enddo
+                Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
+              enddo
+            enddo
+          endif
+
         endif
 
       endif                                ! end_if_lssav

gfsphysics/physics/sflx.f

@@ -251,6 +251,7 @@ subroutine sflx                                                   &
       runoff2 = 0.0
       runoff3 = 0.0
       snomlt  = 0.0
+      rc      = 0.0
 
 !  --- ...  define local variable ice to achieve:
 !             sea-ice case,          ice =  1

gfsphysics/physics/ugwp_driver_v0.f

@@ -47,8 +47,8 @@ subroutine cires_ugwp_driver_v0(me,  master,
 
        real(kind=kind_phys), intent(in), dimension(im,levs) :: ugrs
      &,        vgrs, tgrs, qgrs, prsl, prslk, phil, del
-       real(kind=kind_phys), intent(in), dimension(im,levs+1) :: 
-     &         phii, prsi
+       real(kind=kind_phys), intent(in), dimension(im,levs+1) :: prsi
+     &,        phii
 
 !      real(kind=kind_phys), intent(in) :: oro_stat(im,nmtvr)
        real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc

io/FV3GFS_io.F90

@@ -157,10 +157,10 @@ subroutine FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, Model, fv_dom
     type(domain2d),              intent(in)    :: fv_domain
     character(len=32), optional, intent(in)    :: timestamp
 
-    !--- read in surface data from chgres 
+    !--- write surface data from chgres 
     call sfc_prop_restart_write (IPD_Data%Sfcprop, Atm_block, Model, fv_domain, timestamp)
 
-    !--- read in physics restart data
+    !--- write physics restart data
     call phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timestamp)
 
   end subroutine FV3GFS_restart_write

io/post_gfs.F90

@@ -12,6 +12,7 @@ module post_gfs
   include 'mpif.h'
 
   integer mype, nbdl
+  logical setvar_atmfile, setvar_sfcfile, read_postcntrl
   public  post_run_gfs, post_getattr_gfs
 
   contains
@@ -28,9 +29,10 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write,      &
 !
       use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, &
                              npset,grib,gocart_on,icount_calmict, jsta,  &
-                             jend,im, nsoil
+                             jend,im, nsoil, filenameflat
       use gridspec_mod, only : maptype, gridtype
       use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl
+      use xml_perl_data,only : paramset
 !
 !-----------------------------------------------------------------------
 !
@@ -53,9 +55,8 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write,      &
       integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil
       integer,allocatable  :: jstagrp(:),jendgrp(:)
       integer,save         :: kpo,kth,kpv
+      logical,save         :: log_postalct=.false.
       real,dimension(komax),save :: po, th, pv
-      logical,save   :: log_postalct=.false.
-      logical,save   :: setvar_atmfile=.false.,setvar_sfcfile=.false.
       logical        :: Log_runpost
       character(255) :: post_fname*255
 
@@ -124,6 +125,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write,      &
 !
         log_postalct = .true.
         first_grbtbl = .true.
+        read_postcntrl = .true.
 !
       ENDIF
 !
@@ -135,6 +137,8 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write,      &
       ifmin = mynfmin
       if (ifhr == 0 ) ifmin = 0
       if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr
+      setvar_atmfile=.false.
+      setvar_sfcfile=.false.
       call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
            setvar_sfcfile)
 
@@ -145,8 +149,28 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write,      &
 ! 20190807 no need to call microinit for GFDLMP
 !        call MICROINIT
 !
-        if(grib=="grib2" .and. first_grbtbl) then
-          call read_xml()
+        if(grib=="grib2" .and. read_postcntrl) then
+          if (ifhr == 0) then
+            filenameflat = 'postxconfig-NT_FH00.txt'
+            call read_xml()
+            if(mype==0) print *,'af read_xml at fh00,name=',trim(filenameflat)
+          else if(ifhr > 0) then
+            filenameflat = 'postxconfig-NT.txt'
+            if(size(paramset)>0) then
+              do i=1,size(paramset)
+                if (size(paramset(i)%param)>0) then
+                  deallocate(paramset(i)%param)
+                  nullify(paramset(i)%param)
+                endif
+              enddo
+              deallocate(paramset)
+              nullify(paramset)
+            endif
+            num_pset = 0
+            call read_xml()
+            if(mype==0) print *,'af read_xml,name=',trim(filenameflat),'ifhr=',ifhr
+            read_postcntrl = .false.
+          endif
         endif
 !
         IEOF  = 0
@@ -181,9 +205,6 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write,      &
           endif
 !
         enddo
-!
-        setvar_atmfile = .false.
-        setvar_sfcfile = .false.
 !
       endif
 
@@ -335,7 +356,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
                              avgetrans, avgesnow, avgprec_cont, avgcprate_cont,&
                              avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, &
                              alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& 
-                             avgpotevp, snoavg, si, cuppt
+                             avgpotevp, snoavg, ti, si, cuppt
       use soil,        only: sldpth, sh2o, smc, stc
       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, &
@@ -477,6 +498,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
           qs(i,j) = SPVAL
           twbs(i,j) = SPVAL
           qwbs(i,j) = SPVAL
+          ths(i,j) = SPVAL
         enddo
       enddo
 
@@ -1122,9 +1144,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
               !$omp parallel do private(i,j)
               do j=jsta,jend
                 do i=ista, iend
-                  sr(i,j) = arrayr42d(i,j)
+                  if (arrayr42d(i,j) /= spval) then
+                  !set range within (0,1)
+                    sr(i,j) = min(1.,max(0.,sr(i,j)))
+                  else
+                    sr(i,j) = spval
+                  endif
+                enddo
+              enddo
+            endif
+
+            ! sea ice skin temperature
+            if(trim(fieldname)=='tisfc') then
+              !$omp parallel do private(i,j)
+              do j=jsta,jend
+                do i=1,im
+                  if (arrayr42d(i,j) /= spval) 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
+!              print *,'in gfs_post, get tisfc=',maxval(ti), minval(ti)
             endif
 
             ! vegetation fraction
@@ -1237,7 +1280,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
               do j=jsta,jend
                 do i=ista, iend
                   stc(i,j,1) = arrayr42d(i,j)
-                  if (sm(i,j) /= 0.0) 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
@@ -1248,7 +1292,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
               do j=jsta,jend
                 do i=ista, iend
                   stc(i,j,2) = arrayr42d(i,j)
-                  if (sm(i,j) /= 0.0) 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
@@ -1259,7 +1304,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
               do j=jsta,jend
                 do i=ista, iend
                   stc(i,j,3) = arrayr42d(i,j)
-                  if (sm(i,j) /= 0.0) 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
@@ -1270,7 +1316,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
               do j=jsta,jend
                 do i=ista, iend
                   stc(i,j,4) = arrayr42d(i,j)
-                  if (sm(i,j) /= 0.0) 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
@@ -2313,6 +2360,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile,   &
 !$omp parallel do private(i,j)
       do j=jsta,jend
         do i=ista, iend
+          !assign sst
+          if (sm(i,j) /= 0.0 .and. ths(i,j) /= spval) then
+             sst(i,j) = ths(i,j)
+          else
+             sst(i,j) = spval
+          endif
           if (ths(i,j) /= spval) then
             ths(i,j)  = ths(i,j)* (p1000/pint(i,j,lp1))**capa
             thz0(i,j) = ths(i,j)