FV3: this commits #refs 57070 Add nesting support in write component

atmos_cubed_sphere/driver/fvGFS/atmosphere.F90

@@ -736,16 +736,21 @@ end subroutine set_atmosphere_pelist
 !! the "domain2d" variable associated with the coupling grid and the 
 !! decomposition for the current cubed-sphere tile.
 !>@detail Coupling is done using the mass/temperature grid with no halos.
- subroutine atmosphere_domain ( fv_domain, layout, regional )
+ subroutine atmosphere_domain ( fv_domain, layout, regional, nested, pelist )
    type(domain2d), intent(out) :: fv_domain
    integer, intent(out) :: layout(2)
    logical, intent(out) :: regional
+   logical, intent(out) :: nested
+   integer, pointer, intent(out) :: pelist(:)
 !  returns the domain2d variable associated with the coupling grid
 !  note: coupling is done using the mass/temperature grid with no halos
 
    fv_domain = Atm(mytile)%domain_for_coupler
    layout(1:2) =  Atm(mytile)%layout(1:2)
    regional = Atm(mytile)%flagstruct%regional
+   nested = ngrids > 1
+   call set_atmosphere_pelist()
+   pelist => Atm(mytile)%pelist
 
  end subroutine atmosphere_domain
 

atmos_cubed_sphere/driver/fvGFS/fv_nggps_diag.F90

@@ -551,7 +551,7 @@ end subroutine store_data
 
 #ifdef use_WRTCOMP
 
- subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting )
+ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting, rc)
 !
 !-------------------------------------------------------------
 !*** set esmf bundle for dyn output fields
@@ -564,10 +564,11 @@ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting )
    type(ESMF_FieldBundle),intent(inout)        :: dyn_bundle
    type(ESMF_Grid),intent(inout)               :: fcst_grid
    logical,intent(in)                          :: quilting
+   integer,intent(out)                         :: rc
 
 
 !*** local variables
-   integer i, j, k, n, rc
+   integer i, j, k, n
    integer num_axes, id, axis_length, direction, edges
    integer num_attributes, num_field_dyn, axis_typ
    character(255) :: units, long_name, cart_name,axis_direct,edgesS
@@ -577,7 +578,7 @@ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting )
    type(domain1d) :: Domain
    type(domainuG) :: DomainU
    real,dimension(:),allocatable :: axis_data
-   type(diag_atttype),dimension(:),allocatable :: attributes 
+   type(diag_atttype),dimension(:),allocatable :: attributes
    character(2) axis_id
 
    type(ESMF_Field)                            :: field
@@ -589,6 +590,10 @@ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting )
 !   type(ESMF_Field),dimension(:),allocatable    :: fieldlist
 !
 !------------------------------------------------------------
+
+! initialize RC
+   rc = ESMF_SUCCESS
+
 !--- use wrte grid component for output
    use_wrtgridcomp_output = quilting
 

atmos_cubed_sphere/model/fv_arrays.F90

@@ -1176,7 +1176,7 @@ module fv_arrays_mod
      logical :: grid_active = .true. !Always active for now
 
      !This is kept here instead of in neststruct% simply for convenience
-     type(fv_atmos_type), pointer :: parent_grid _NULL
+     type(fv_atmos_type), pointer :: parent_grid => NULL()
 
 !-----------------------------------------------------------------------
 ! Five prognostic state variables for the f-v dynamics

atmos_cubed_sphere/model/fv_dynamics.F90

@@ -241,7 +241,7 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot,  ng, bdt, consv_te, fill,
     type(fv_flags_type), intent(INOUT) :: flagstruct
     type(fv_nest_type),  intent(INOUT) :: neststruct
     type(domain2d),      intent(INOUT) :: domain
-    type(fv_atmos_type), intent(INOUT) :: parent_grid
+    type(fv_atmos_type), pointer, intent(IN) :: parent_grid
     type(fv_diag_type),  intent(IN)    :: idiag
 
 ! Local Arrays

atmos_cubed_sphere/model/fv_tracer2d.F90

@@ -579,7 +579,7 @@ subroutine tracer_2d_nested(q, dp1, mfx, mfy, cx, cy, gridstruct, bd, domain, np
       real   , intent(INOUT) ::  cy(bd%isd:bd%ied,bd%js :bd%je +1,npz)  !< Courant Number Y-Dir
       type(fv_grid_type), intent(IN), target :: gridstruct
       type(fv_nest_type), intent(INOUT) :: neststruct
-      type(fv_atmos_type), intent(INOUT) :: parent_grid
+      type(fv_atmos_type), pointer, intent(IN) :: parent_grid
       type(domain2d), intent(INOUT) :: domain
 
 ! Local Arrays

atmos_cubed_sphere/tools/fv_diagnostics.F90

@@ -2676,7 +2676,6 @@ subroutine fv_diag(Atm, zvir, Time, print_freq)
 
           deallocate(a3)
        endif
-       if( allocated(wz) ) deallocate (wz)
 
 
 !-------------------------------------------------------

atmos_model.F90

@@ -123,6 +123,7 @@ module atmos_model_mod
      integer, pointer              :: pelist(:) =>null() ! pelist where atmosphere is running.
      integer                       :: layout(2)          ! computer task laytout
      logical                       :: regional           ! true if domain is regional
+     logical                       :: nested             ! true if there is a nest
      integer                       :: mlon, mlat
      logical                       :: pe                 ! current pe.
      real(kind=8),             pointer, dimension(:)     :: ak, bk
@@ -411,7 +412,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
    call atmosphere_resolution (nlon, nlat, global=.false.)
    call atmosphere_resolution (mlon, mlat, global=.true.)
    call alloc_atmos_data_type (nlon, nlat, Atmos)
-   call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional)
+   call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%pelist)
    call atmosphere_diag_axes (Atmos%axes)
    call atmosphere_etalvls (Atmos%ak, Atmos%bk, flip=flip_vc)
    call atmosphere_grid_bdry (Atmos%lon_bnd, Atmos%lat_bnd, global=.false.)

fv3_cap.F90

@@ -696,7 +696,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
           call ESMF_StateGet(wrtState(i), &
              itemName="mirror_"//trim(fcstItemNameList(j)), &
              fieldbundle=wrtFB(j,i), rc=rc)
-      if(mype==0) print *,'af get wrtfb=',"mirror_"//trim(fcstItemNameList(j)),'rc=',rc
+          if(mype==0) print *,'af get wrtfb=',"mirror_"//trim(fcstItemNameList(j)),'rc=',rc
           if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
             line=__LINE__, file=__FILE__)) return  ! bail out
 
@@ -729,9 +729,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
             isrctermprocessing = 1
             call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,i), &
               regridMethod=regridmethod, routehandle=routehandle(j,i),  &
-              srcTermProcessing=isrctermprocessing, rc=rc)
-
-           if(mype==0) print *,'after regrid store, group i=',i,' fb=',j,' time=',mpi_wtime()-timewri
+              srcTermProcessing=isrctermprocessing, &
+              rc=rc)
+            !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+            !  line=__LINE__, &
+            !  file=__FILE__)) &
+            !  return  ! bail out
+            if (rc /= ESMF_SUCCESS) then
+              write(0,*)'fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore'
+              call ESMF_LogWrite('fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore', ESMF_LOGMSG_ERROR, rc=rc)
+              call ESMF_Finalize(endflag=ESMF_END_ABORT)
+            end if
             call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc)
             if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
               line=__LINE__, file=__FILE__)) return  ! bail out

gfsphysics/GFS_layer/GFS_typedefs.F90

@@ -1451,8 +1451,8 @@ subroutine coupling_create (Coupling, IM, Model)
       Coupling%q2mi_cpl    = clear_val
       Coupling%tsfci_cpl   = clear_val
       Coupling%psurfi_cpl  = clear_val
-!!    Coupling%oro_cpl     = clear_val  !< pointer to sfcprop%oro
-!!    Coupling%slmsk_cpl   = clear_val  !< pointer to sfcprop%slmsk
+      Coupling%oro_cpl     = clear_val  !< pointer to sfcprop%oro
+      Coupling%slmsk_cpl   = clear_val  !< pointer to sfcprop%slmsk
     endif
 
    !-- cellular automata

io/FV3GFS_io.F90

@@ -2133,7 +2133,7 @@ subroutine add_field_to_phybundle(var_name,long_name,units,cell_methods, axes,ph
    call ESMF_FieldBundleAdd(phys_bundle,(/field/), rc=rc)
    if( present(rcd)) rcd=rc
 !
-   call ESMF_LogWrite('phys field add to fieldbundle'//trim(var_name), ESMF_LOGMSG_INFO, rc=rc)
+   call ESMF_LogWrite('phys field add to fieldbundle '//trim(var_name), ESMF_LOGMSG_INFO, rc=rc)
 
  end subroutine add_field_to_phybundle
 !

io/module_write_netcdf.F90

@@ -8,10 +8,6 @@
     if (status /= nf90_noerr) write(0,*) "line ", __LINE__, trim(nf90_strerror(status)); \
     if (status /= nf90_noerr) call ESMF_Finalize(endflag=ESMF_END_ABORT)
 
-#define NF_ERR_STOP(status) \
-    if (status /= nf_noerr) write(0,*) "line ", __LINE__, trim(nfmpi_strerror(status)); \
-    if (status /= nf_noerr) call ESMF_Finalize(endflag=ESMF_END_ABORT)
-
 module module_write_netcdf
 
   use esmf
@@ -440,6 +436,17 @@ subroutine add_dim(ncid, dim_name, dimid, grid, rc)
        ncerr = nf90_put_var(ncid, dim_varid, values=valueListR8 ); NC_ERR_STOP(ncerr)
        ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr)
        deallocate(valueListR8)
+!    else if (typekind==ESMF_TYPEKIND_R4) then
+!       allocate(valueListR4(n))
+!       call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", &
+!                              name=trim(dim_name), valueList=valueListR4, rc=rc); ESMF_ERR_RETURN(rc)
+!       ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr)
+!       ncerr = nf90_put_var(ncid, dim_varid, values=valueListR4 ); NC_ERR_STOP(ncerr)
+!       ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr)
+!       deallocate(valueListR4)
+!    else
+!       write(0,*)'Error in module_write_netcdf.F90(add_dim) unknown typekind for ',trim(dim_name)
+!       call ESMF_Finalize(endflag=ESMF_END_ABORT)
     end if
 
     call get_grid_attr(grid, dim_name, ncid, dim_varid, rc)

io/module_wrt_grid_comp.F90

@@ -509,9 +509,10 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc)
                     name="output_file", value=outfile_name, rc=rc)
 
                if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
-                 line=__LINE__, file=__FILE__)) return  ! bail out
-
-               CALL ESMF_LogWrite("bf fcstfield, get output_file"//trim(outfile_name)//trim(fieldName),ESMF_LOGMSG_INFO,rc=RC)
+                 line=__LINE__, &
+                 file=__FILE__)) &
+                 return  ! bail out
+               CALL ESMF_LogWrite("bf fcstfield, get output_file "//trim(outfile_name)//" "//trim(fieldName),ESMF_LOGMSG_INFO,rc=RC)
                if( trim(outfile_name) /= '') then
                  outfilename(j,i) = trim(outfile_name)
                endif
@@ -1184,7 +1185,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc)
          write(cfhour, cform) nf_hours
        endif
 !
-       if(mype == lead_write_task) print *,'in wrt run, 2, nf_hours=',nf_hours,nf_minutes,nseconds, &
+       if(mype == lead_write_task) print *,'in wrt run, nf_hours=',nf_hours,nf_minutes,nseconds, &
        'nseconds_num=',nseconds_num,nseconds_den,' FBCount=',FBCount,' cfhour=',trim(cfhour)
 
 !    if(mype == lead_write_task) print *,'in wrt run, cfhour=',cfhour, &
@@ -1485,6 +1486,10 @@ subroutine recover_fields(file_bundle,rc)
 ! get filed count
      call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, &
          grid=fieldGrid, rc=rc)
+        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
+            line=__LINE__, &
+            file=__FILE__)) &
+            return  ! bail out
 !
      CALL ESMF_LogWrite("call recover field on wrt comp",ESMF_LOGMSG_INFO,rc=RC)
      call ESMF_GridGet(fieldgrid, dimCount=gridDimCount, rc=rc)

makefile

@@ -18,6 +18,7 @@ else
 endif
 
 FFLAGS   += -I$(FMS_DIR) -I$(PHYSP)physics -Iipd -Icpl -Iio -Iatmos_cubed_sphere
+CPPDEFS  += -DESMF_VERSION_MAJOR=$(ESMF_VERSION_MAJOR)
 
 FV3_EXE  = fv3.exe
 FV3CAP_LIB  = libfv3cap.a