diff --git a/atmos_model.F90 b/atmos_model.F90 index 9b3d08548..a503284ec 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -44,7 +44,7 @@ module atmos_model_mod use mpp_mod, only: mpp_pe, mpp_root_pe, mpp_clock_id, mpp_clock_begin use mpp_mod, only: mpp_clock_end, CLOCK_COMPONENT, MPP_CLOCK_SYNC -use mpp_mod, only: mpp_min, mpp_max, mpp_error, mpp_chksum +use mpp_mod, only: mpp_min, mpp_max, mpp_error, mpp_chksum, FATAL use mpp_domains_mod, only: domain2d use mpp_mod, only: mpp_get_current_pelist_name #ifdef INTERNAL_FILE_NML @@ -60,7 +60,8 @@ module atmos_model_mod use time_manager_mod, only: time_type, get_time, get_date, & operator(+), operator(-) use field_manager_mod, only: MODEL_ATMOS -use tracer_manager_mod, only: get_number_tracers, get_tracer_names +use tracer_manager_mod, only: get_number_tracers, get_tracer_names, & + get_tracer_index use xgrid_mod, only: grid_box_type use atmosphere_mod, only: atmosphere_init use atmosphere_mod, only: atmosphere_restart @@ -101,7 +102,9 @@ module atmos_model_mod public update_atmos_model_state public update_atmos_model_dynamics public atmos_model_init, atmos_model_end, atmos_data_type +public atmos_model_exchange_phase_1, atmos_model_exchange_phase_2 public atmos_model_restart +public get_atmos_model_ungridded_dim public addLsmask2grid !----------------------------------------------------------------------- @@ -544,6 +547,84 @@ end subroutine update_atmos_model_dynamics ! +!####################################################################### +! +! Perform data exchange with coupled components in run phase 1 +! +! +! +! This subroutine currently exports atmospheric fields and tracers +! to the chemistry component during the model's run phase 1, i.e. +! before chemistry is run. +! + +subroutine atmos_model_exchange_phase_1 (Atmos, rc) + + use ESMF + + type (atmos_data_type), intent(inout) :: Atmos + integer, optional, intent(out) :: rc +!--- local variables + integer :: localrc + + !--- begin + if (present(rc)) rc = ESMF_SUCCESS + + !--- if coupled, exchange coupled fields + if( IPD_Control%cplchm ) then + ! -- export fields to chemistry + call update_atmos_chemistry('export', rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc)) return ! bail out + endif + + end subroutine atmos_model_exchange_phase_1 +! + + +!####################################################################### +! +! Perform data exchange with coupled components in run phase 2 +! +! +! +! This subroutine currently imports fields updated by the coupled +! chemistry component back into the atmospheric model during run +! phase 2. +! + +subroutine atmos_model_exchange_phase_2 (Atmos, rc) + + use ESMF + + type (atmos_data_type), intent(inout) :: Atmos + integer, optional, intent(out) :: rc +!--- local variables + integer :: localrc + + !--- begin + if (present(rc)) rc = ESMF_SUCCESS + + !--- if coupled, exchange coupled fields + if( IPD_Control%cplchm ) then + ! -- import fields from chemistry + call update_atmos_chemistry('import', rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc)) return ! bail out + endif + + end subroutine atmos_model_exchange_phase_2 +! + + !####################################################################### ! !####################################################################### +! +! +! +! Retrieve ungridded dimensions of atmospheric model arrays +! + +subroutine get_atmos_model_ungridded_dim(nlev, ntracers, nsoillev) + + integer, optional, intent(out) :: nlev, ntracers, nsoillev + + if (present(nlev)) nlev = Atm_block%npz + if (present(ntracers)) call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers) + if (present(nsoillev)) then + nsoillev = 0 + if (allocated(IPD_Data)) then + if (associated(IPD_Data(1)%Sfcprop%slc)) & + nsoillev = size(IPD_Data(1)%Sfcprop%slc, 2) + end if + end if + +end subroutine get_atmos_model_ungridded_dim +! + +!####################################################################### +! +! +! Populate exported chemistry fields with current atmospheric state +! data (state='export'). Update tracer concentrations for atmospheric +! chemistry with values from chemistry component (state='import'). +! Fields should be exported/imported from/to the atmospheric state +! after physics calculations. +! +! NOTE: It is assumed that all the chemical tracers follow the standard +! atmospheric tracers, which end with ozone. The order of the chemical +! tracers must match their order in the chemistry component. +! +! Requires: +! IPD_Data +! Atm_block +! +subroutine update_atmos_chemistry(state, rc) + + use ESMF + use module_cplfields, only: cplFieldGet + + character(len=*), intent(in) :: state + integer, optional, intent(out) :: rc + + !--- local variables + integer :: localrc + integer :: ni, nj, nk, nt, ntoz + integer :: nb, ix, i, j, k, it + integer :: ib, jb + + real(ESMF_KIND_R8), dimension(:,:,:), pointer :: prsl, phil, & + prsi, phii, & + temp, & + ua, va, vvl, & + dkt, slc + real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: q + + real(ESMF_KIND_R8), dimension(:,:), pointer :: hpbl, area, stype, rainc, & + uustar, rain, sfcdsw, slmsk, tsfc, shfsfc, snowd, vtype, vfrac, zorl + + logical, parameter :: diag = .true. + + ! -- begin + if (present(rc)) rc = ESMF_SUCCESS + + ni = Atm_block%iec - Atm_block%isc + 1 + nj = Atm_block%jec - Atm_block%jsc + 1 + nk = Atm_block%npz + call get_number_tracers(MODEL_ATMOS, num_tracers=nt) + + select case (trim(state)) + case ('import') + !--- retrieve references to allocated memory for each field + call cplFieldGet(state,'inst_tracer_mass_frac', & + farrayPtr4d=q, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + !--- tracers quantities + !--- locate the end location of standard atmospheric tracers, marked by ozone + ntoz = get_tracer_index(MODEL_ATMOS, 'o3mr') + + do it = ntoz + 1, nt +!$OMP parallel do default (none) & +!$OMP shared (it, nk, nj, ni, Atm_block, IPD_Data, q) & +!$OMP private (k, j, jb, i, ib, nb, ix) + do k = 1, nk + 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)%Stateout%gq0(ix,k,it) = q(i,j,k,it) + enddo + enddo + enddo + enddo + + if (diag) then + write(6,'("update_atmos: ",a,": qgrs - min/max/avg",3g16.6)') & + trim(state), minval(q), maxval(q), sum(q)/size(q) + end if + + case ('export') + !--- retrieve references to allocated memory for each field + call cplFieldGet(state,'inst_pres_interface', farrayPtr3d=prsi, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_pres_levels', & + farrayPtr3d=prsl, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_geop_interface', farrayPtr3d=phii, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_geop_levels', & + farrayPtr3d=phil, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_temp_levels', farrayPtr3d=temp, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_zonal_wind_levels', farrayPtr3d=ua, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_merid_wind_levels', farrayPtr3d=va, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_omega_levels', farrayPtr3d=vvl, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_tracer_mass_frac', & + farrayPtr4d=q, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_soil_moisture_content', farrayPtr3d=slc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'soil_type', farrayPtr2d=stype, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_pbl_height', & + farrayPtr2d=hpbl, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'surface_cell_area', farrayPtr2d=area, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_convective_rainfall_amount', & + farrayPtr2d=rainc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_exchange_coefficient_heat_levels', & + farrayPtr3d=dkt, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_friction_velocity', farrayPtr2d=uustar, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_rainfall_amount', farrayPtr2d=rain, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_down_sw_flx', & + farrayPtr2d=sfcdsw, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_land_sea_mask', farrayPtr2d=slmsk, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_temp_height_surface', farrayPtr2d=tsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_up_sensi_heat_flx', & + farrayPtr2d=shfsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_lwe_snow_thickness', & + farrayPtr2d=snowd, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'vegetation_type', farrayPtr2d=vtype, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_vegetation_area_frac', & + farrayPtr2d=vfrac, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_surface_roughness', farrayPtr2d=zorl, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + !--- handle all three-dimensional variables +!$OMP parallel do default (none) & +!$OMP shared (nk, nj, ni, Atm_block, IPD_Data, prsi, phii, prsl, phil, temp, ua, va, vvl, dkt) & +!$OMP private (k, j, jb, i, ib, nb, ix) + do k = 1, nk + 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) + !--- interface values + prsi(i,j,k) = IPD_Data(nb)%Statein%prsi(ix,k) + phii(i,j,k) = IPD_Data(nb)%Statein%phii(ix,k) + !--- layer values + prsl(i,j,k) = IPD_Data(nb)%Statein%prsl(ix,k) + phil(i,j,k) = IPD_Data(nb)%Statein%phil(ix,k) + temp(i,j,k) = IPD_Data(nb)%Stateout%gt0(ix,k) + ua (i,j,k) = IPD_Data(nb)%Stateout%gu0(ix,k) + va (i,j,k) = IPD_Data(nb)%Stateout%gv0(ix,k) + vvl (i,j,k) = IPD_Data(nb)%Statein%vvl (ix,k) + dkt (i,j,k) = IPD_Data(nb)%Coupling%dkt(ix,k) + enddo + enddo + enddo + + !--- top interface values + k = nk+1 + 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) + prsi(i,j,k) = IPD_Data(nb)%Statein%prsi(ix,k) + phii(i,j,k) = IPD_Data(nb)%Statein%phii(ix,k) + enddo + enddo + + !--- tracers quantities + do it = 1, nt +!$OMP parallel do default (none) & +!$OMP shared (it, nk, nj, ni, Atm_block, IPD_Data, q) & +!$OMP private (k, j, jb, i, ib, nb, ix) + do k = 1, nk + 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) + q(i,j,k,it) = IPD_Data(nb)%Stateout%gq0(ix,k,it) + enddo + enddo + enddo + enddo + +!$OMP parallel do default (none) & +!$OMP shared (nj, ni, Atm_block, IPD_Data, & +!$OMP hpbl, area, stype, rainc, rain, uustar, sfcdsw, & +!$OMP slmsk, snowd, tsfc, shfsfc, vtype, vfrac, zorl, slc) & +!$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) + hpbl(i,j) = IPD_Data(nb)%IntDiag%hpbl(ix) + area(i,j) = IPD_Data(nb)%Grid%area(ix) + stype(i,j) = IPD_Data(nb)%Sfcprop%stype(ix) + rainc(i,j) = IPD_Data(nb)%Coupling%rainc_cpl(ix) + rain(i,j) = IPD_Data(nb)%Coupling%rain_cpl(ix) + uustar(i,j) = IPD_Data(nb)%Sfcprop%uustar(ix) + sfcdsw(i,j) = IPD_Data(nb)%Coupling%sfcdsw(ix) + slmsk(i,j) = IPD_Data(nb)%Sfcprop%slmsk(ix) + snowd(i,j) = IPD_Data(nb)%Sfcprop%snowd(ix) + tsfc(i,j) = IPD_Data(nb)%Sfcprop%tsfc(ix) + shfsfc(i,j) = IPD_Data(nb)%Coupling%ushfsfci(ix) + vtype(i,j) = IPD_Data(nb)%Sfcprop%vtype(ix) + vfrac(i,j) = IPD_Data(nb)%Sfcprop%vfrac(ix) + zorl(i,j) = IPD_Data(nb)%Sfcprop%zorl(ix) + slc(i,j,:) = IPD_Data(nb)%Sfcprop%slc(ix,:) + enddo + enddo + + if (diag) then + ! -- diagnostics + write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi) + write(6,'("update_atmos: phii - min/max/avg",3g16.6)') minval(phii), maxval(phii), sum(phii)/size(phii) + write(6,'("update_atmos: prsl - min/max/avg",3g16.6)') minval(prsl), maxval(prsl), sum(prsl)/size(prsl) + write(6,'("update_atmos: phil - min/max/avg",3g16.6)') minval(phil), maxval(phil), sum(phil)/size(phil) + write(6,'("update_atmos: tgrs - min/max/avg",3g16.6)') minval(temp), maxval(temp), sum(temp)/size(temp) + write(6,'("update_atmos: ugrs - min/max/avg",3g16.6)') minval(ua), maxval(ua), sum(ua)/size(ua) + write(6,'("update_atmos: vgrs - min/max/avg",3g16.6)') minval(va), maxval(va), sum(va)/size(va) + write(6,'("update_atmos: vvl - min/max/avg",3g16.6)') minval(vvl), maxval(vvl), sum(vvl)/size(vvl) + write(6,'("update_atmos: qgrs - min/max/avg",3g16.6)') minval(q), maxval(q), sum(q)/size(q) + + write(6,'("update_atmos: hpbl - min/max/avg",3g16.6)') minval(hpbl), maxval(hpbl), sum(hpbl)/size(hpbl) + write(6,'("update_atmos: rainc - min/max/avg",3g16.6)') minval(rainc), maxval(rainc), sum(rainc)/size(rainc) + write(6,'("update_atmos: rain - min/max/avg",3g16.6)') minval(rain), maxval(rain), sum(rain)/size(rain) + write(6,'("update_atmos: shfsfc - min/max/avg",3g16.6)') minval(shfsfc), maxval(shfsfc), sum(shfsfc)/size(shfsfc) + write(6,'("update_atmos: sfcdsw - min/max/avg",3g16.6)') minval(sfcdsw), maxval(sfcdsw), sum(sfcdsw)/size(sfcdsw) + write(6,'("update_atmos: slmsk - min/max/avg",3g16.6)') minval(slmsk), maxval(slmsk), sum(slmsk)/size(slmsk) + write(6,'("update_atmos: snowd - min/max/avg",3g16.6)') minval(snowd), maxval(snowd), sum(snowd)/size(snowd) + write(6,'("update_atmos: tsfc - min/max/avg",3g16.6)') minval(tsfc), maxval(tsfc), sum(tsfc)/size(tsfc) + write(6,'("update_atmos: vtype - min/max/avg",3g16.6)') minval(vtype), maxval(vtype), sum(vtype)/size(vtype) + write(6,'("update_atmos: vfrac - min/max/avg",3g16.6)') minval(vfrac), maxval(vfrac), sum(vfrac)/size(vfrac) + write(6,'("update_atmos: area - min/max/avg",3g16.6)') minval(area), maxval(area), sum(area)/size(area) + write(6,'("update_atmos: stype - min/max/avg",3g16.6)') minval(stype), maxval(stype), sum(stype)/size(stype) + write(6,'("update_atmos: zorl - min/max/avg",3g16.6)') minval(zorl), maxval(zorl), sum(zorl)/size(zorl) + write(6,'("update_atmos: slc - min/max/avg",3g16.6)') minval(slc), maxval(slc), sum(slc)/size(slc) + end if + + case default + ! -- do nothing + end select + +end subroutine update_atmos_chemistry +! + !####################################################################### ! ! @@ -1576,7 +1998,7 @@ subroutine setup_exportdata (rc) !--- ! Fill the export Fields for ESMF/NUOPC style coupling - call fillExportFields(exportData,rc) + call fillExportFields(exportData) !--- ! zero out accumulated fields diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index 6283a51eb..bd17bff69 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -12,6 +12,7 @@ module module_cap_cpl private public clock_cplIntval public realizeConnectedInternCplField + public realizeConnectedCplFields public Dump_cplFields ! contains @@ -19,7 +20,7 @@ module module_cap_cpl !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- - subroutine clock_cplIntval(gcomp, CF) + subroutine clock_cplIntval(gcomp, CF) type(ESMF_GridComp) :: gcomp type(ESMF_Config) :: CF @@ -115,6 +116,92 @@ subroutine realizeConnectedInternCplField(state, field, standardName, grid, rc) end subroutine realizeConnectedInternCplField + !----------------------------------------------------------------------------- + + subroutine realizeConnectedCplFields(state, grid, & + numLevels, numSoilLayers, numTracers, fieldNames, fieldTypes, fieldList, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: numLevels + integer, intent(in) :: numSoilLayers + integer, intent(in) :: numTracers + character(len=*), dimension(:), intent(in) :: fieldNames + character(len=*), dimension(:), intent(in) :: fieldTypes + type(ESMF_Field), dimension(:), intent(out) :: fieldList + integer, intent(out) :: rc + + ! local variables + integer :: item + type(ESMF_Field) :: field + + ! begin + rc = ESMF_SUCCESS + + if (size(fieldNames) /= size(fieldTypes)) then + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, & + msg="fieldNames and fieldTypes must have same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end if + + do item = 1, size(fieldNames) + if (NUOPC_IsConnected(state, fieldName=trim(fieldNames(item)))) then + select case (fieldTypes(item)) + case ('l','layer') + field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R8, & + name=trim(fieldNames(item)), & + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + case ('i','interface') + field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R8, & + name=trim(fieldNames(item)), & + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + case ('t','tracer') + field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R8, & + name=trim(fieldNames(item)), & + ungriddedLBound=(/1,1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + case ('s','surface') + field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R8, & + name=trim(fieldNames(item)), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + case ('g','soil') + field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R8, & + name=trim(fieldNames(item)), & + ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + case default + call ESMF_LogSetError(ESMF_RC_NOT_VALID, & + msg="exportFieldType = '"//trim(fieldTypes(item))//"' not recognized", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + ! -- save field + fieldList(item) = field + else + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/trim(fieldNames(item))/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + end do + + end subroutine realizeConnectedCplFields + !----------------------------------------------------------------------------- subroutine Dump_cplFields(gcomp, importState, exportstate, clock_fv3, & diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 4f1ecb9f6..c12d7ca6a 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -6,102 +6,181 @@ module module_cplfields !----------------------------------------------------------------------------- use ESMF + use NUOPC + implicit none private - integer, parameter :: MAXNAMELEN = 128 - ! Export Fields ---------------------------------------- -! integer, public, parameter :: NexportFields = 56 - integer, public, parameter :: NexportFields = 48 - type(ESMF_Field), public :: exportFields(NexportFields) - real(kind=8), allocatable,public :: exportData(:,:,:) - character(len=40), public, parameter :: exportFieldsList(NexportFields) = (/ & - "mean_zonal_moment_flx ", & - "mean_merid_moment_flx ", & - "mean_sensi_heat_flx ", & - "mean_laten_heat_flx ", & - "mean_down_lw_flx ", & - "mean_down_sw_flx ", & - "mean_prec_rate ", & - "inst_zonal_moment_flx ", & - "inst_merid_moment_flx ", & - "inst_sensi_heat_flx ", & - "inst_laten_heat_flx ", & - "inst_down_lw_flx ", & - "inst_down_sw_flx ", & - "inst_temp_height2m ", & - "inst_spec_humid_height2m ", & - "inst_zonal_wind_height10m ", & - "inst_merid_wind_height10m ", & - "inst_temp_height_surface ", & - "inst_pres_height_surface ", & - "inst_surface_height ", & - "mean_net_lw_flx ", & - "mean_net_sw_flx ", & - "inst_net_lw_flx ", & - "inst_net_sw_flx ", & - "mean_down_sw_ir_dir_flx ", & - "mean_down_sw_ir_dif_flx ", & - "mean_down_sw_vis_dir_flx ", & - "mean_down_sw_vis_dif_flx ", & - "inst_down_sw_ir_dir_flx ", & - "inst_down_sw_ir_dif_flx ", & - "inst_down_sw_vis_dir_flx ", & - "inst_down_sw_vis_dif_flx ", & - "mean_net_sw_ir_dir_flx ", & - "mean_net_sw_ir_dif_flx ", & - "mean_net_sw_vis_dir_flx ", & - "mean_net_sw_vis_dif_flx ", & - "inst_net_sw_ir_dir_flx ", & - "inst_net_sw_ir_dif_flx ", & - "inst_net_sw_vis_dir_flx ", & - "inst_net_sw_vis_dif_flx ", & - "inst_land_sea_mask ", & - "inst_temp_height_lowest ", & - "inst_spec_humid_height_lowest ", & - "inst_zonal_wind_height_lowest ", & - "inst_merid_wind_height_lowest ", & - "inst_pres_height_lowest ", & - "inst_height_lowest ", & - "mean_fprec_rate " & -! "northward_wind_neutral ", & -! "eastward_wind_neutral ", & -! "upward_wind_neutral ", & -! "temp_neutral ", & -! "O_Density ", & -! "O2_Density ", & -! "N2_Density ", & -! "height " & + integer, public, parameter :: NexportFields = 70 + type(ESMF_Field), target, public :: exportFields(NexportFields) + character(len=*), public, parameter :: exportFieldsList(NexportFields) = (/ & + "inst_pres_interface ", & + "inst_pres_levels ", & + "inst_geop_interface ", & + "inst_geop_levels ", & + "inst_temp_levels ", & + "inst_zonal_wind_levels ", & + "inst_merid_wind_levels ", & + "inst_omega_levels ", & + "inst_tracer_mass_frac ", & + "soil_type ", & + "inst_pbl_height ", & + "surface_cell_area ", & + "inst_convective_rainfall_amount ", & + "inst_exchange_coefficient_heat_levels ", & + "inst_friction_velocity ", & + "inst_rainfall_amount ", & + "inst_soil_moisture_content ", & + "inst_up_sensi_heat_flx ", & + "inst_lwe_snow_thickness ", & + "vegetation_type ", & + "inst_vegetation_area_frac ", & + "inst_surface_roughness ", & + "mean_zonal_moment_flx ", & + "mean_merid_moment_flx ", & + "mean_sensi_heat_flx ", & + "mean_laten_heat_flx ", & + "mean_down_lw_flx ", & + "mean_down_sw_flx ", & + "mean_prec_rate ", & + "inst_zonal_moment_flx ", & + "inst_merid_moment_flx ", & + "inst_sensi_heat_flx ", & + "inst_laten_heat_flx ", & + "inst_down_lw_flx ", & + "inst_down_sw_flx ", & + "inst_temp_height2m ", & + "inst_spec_humid_height2m ", & + "inst_zonal_wind_height10m ", & + "inst_merid_wind_height10m ", & + "inst_temp_height_surface ", & + "inst_pres_height_surface ", & + "inst_surface_height ", & + "mean_net_lw_flx ", & + "mean_net_sw_flx ", & + "inst_net_lw_flx ", & + "inst_net_sw_flx ", & + "mean_down_sw_ir_dir_flx ", & + "mean_down_sw_ir_dif_flx ", & + "mean_down_sw_vis_dir_flx ", & + "mean_down_sw_vis_dif_flx ", & + "inst_down_sw_ir_dir_flx ", & + "inst_down_sw_ir_dif_flx ", & + "inst_down_sw_vis_dir_flx ", & + "inst_down_sw_vis_dif_flx ", & + "mean_net_sw_ir_dir_flx ", & + "mean_net_sw_ir_dif_flx ", & + "mean_net_sw_vis_dir_flx ", & + "mean_net_sw_vis_dif_flx ", & + "inst_net_sw_ir_dir_flx ", & + "inst_net_sw_ir_dif_flx ", & + "inst_net_sw_vis_dir_flx ", & + "inst_net_sw_vis_dif_flx ", & + "inst_land_sea_mask ", & + "inst_temp_height_lowest ", & + "inst_spec_humid_height_lowest ", & + "inst_zonal_wind_height_lowest ", & + "inst_merid_wind_height_lowest ", & + "inst_pres_height_lowest ", & + "inst_height_lowest ", & + "mean_fprec_rate " & +! "northward_wind_neutral ", & +! "eastward_wind_neutral ", & +! "upward_wind_neutral ", & +! "temp_neutral ", & +! "O_Density ", & +! "O2_Density ", & +! "N2_Density ", & +! "height " & + /) + ! Field types should be provided for proper handling + ! according to the table below: + ! g : soil levels (3D) + ! i : interface (3D) + ! l : model levels (3D) + ! s : surface (2D) + ! t : tracers (4D) + character(len=*), public, parameter :: exportFieldTypes(NexportFields) = (/ & + "i","l","i","l","l","l","l","l","t", & + "s","s","s","s","l","s","s","g", & + "s","s","s","s","s","s","s","s", & + "s","s","s","s","s","s","s","s", & + "s","s","s","s","s","s","s","s", & + "s","s","s","s","s","s","s","s", & + "s","s","s","s","s","s","s","s", & + "s","s","s","s","s","s","s","s", & + "s","s","s","s","s" & +! "l","l","l","l","l","l","l","s", & + /) + ! Set exportFieldShare to .true. if field is provided as memory reference + ! to coupled components + logical, public, parameter :: exportFieldShare(NexportFields) = (/ & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false., & + .false.,.false.,.false.,.false.,.false. & +! .false.,.false.,.false.,.false.,.false., & +! .false.,.false.,.false. & /) + real(kind=8), allocatable, public :: exportData(:,:,:) ! Import Fields ---------------------------------------- -! integer, public, parameter :: NimportFields = 16 - integer, public, parameter :: NimportFields = 11 - type(ESMF_Field), public :: importFields(NimportFields) - character(len=40), public, parameter :: importFieldsList(NimportFields) = (/ & - "land_mask ", & - "surface_temperature ", & - "sea_surface_temperature ", & - "ice_fraction ", & -! "inst_ice_ir_dif_albedo ", & -! "inst_ice_ir_dir_albedo ", & -! "inst_ice_vis_dif_albedo ", & -! "inst_ice_vis_dir_albedo ", & - "mean_up_lw_flx ", & - "mean_laten_heat_flx ", & - "mean_sensi_heat_flx ", & -! "mean_evap_rate ", & - "mean_zonal_moment_flx ", & - "mean_merid_moment_flx ", & - "mean_ice_volume ", & - "mean_snow_volume " & + integer, public, parameter :: NimportFields = 12 + type(ESMF_Field), target, public :: importFields(NimportFields) + character(len=*), public, parameter :: importFieldsList(NimportFields) = (/ & + "inst_tracer_mass_frac ", & + "land_mask ", & + "surface_temperature ", & + "sea_surface_temperature ", & + "ice_fraction ", & +! "inst_ice_ir_dif_albedo ", & +! "inst_ice_ir_dir_albedo ", & +! "inst_ice_vis_dif_albedo ", & +! "inst_ice_vis_dir_albedo ", & + "mean_up_lw_flx ", & + "mean_laten_heat_flx ", & + "mean_sensi_heat_flx ", & +! "mean_evap_rate ", & + "mean_zonal_moment_flx ", & + "mean_merid_moment_flx ", & + "mean_ice_volume ", & + "mean_snow_volume " & + /) + character(len=*), public, parameter :: importFieldTypes(NimportFields) = (/ & + "t", & + "s","s","s","s", & +! "s","s","s","s", & + "s","s","s", & +! "s", & + "s","s","s","s" & + /) + ! Set importFieldShare to .true. if field is provided as memory reference + ! from coupled components + logical, public, parameter :: importFieldShare(NimportFields) = (/ & + .true., & + .false.,.false.,.false.,.false., & +! .false.,.false.,.false.,.false., & + .false.,.false.,.false., & +! .false., & + .false.,.false.,.false.,.false. & /) ! Methods public fillExportFields public queryFieldList + public cplFieldGet !----------------------------------------------------------------------------- contains @@ -112,6 +191,7 @@ subroutine fillExportFields(data_a2oi, rc) real(kind=8), target, intent(in) :: data_a2oi(:,:,:) integer, intent(out), optional :: rc + integer :: localrc integer :: n,dimCount type(ESMF_TypeKind_Flag) :: datatype real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d @@ -123,15 +203,29 @@ subroutine fillExportFields(data_a2oi, rc) do n=1, size(exportFields) if (ESMF_FieldIsCreated(exportFields(n))) then ! set data - call ESMF_FieldGet(exportFields(n), dimCount=dimCount ,typekind=datatype, rc=rc) + call ESMF_FieldGet(exportFields(n), dimCount=dimCount, & + typekind=datatype, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return if ( datatype == ESMF_TYPEKIND_R8) then if ( dimCount == 2) then - call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=rc) + call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, & + rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, & + msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return datar82d=data_a2oi(:,:,n) endif else if ( datatype == ESMF_TYPEKIND_R4) then if ( dimCount == 2) then - call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=rc) + call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, & + rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, & + msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return datar42d=data_a2oi(:,:,n) endif endif @@ -178,5 +272,117 @@ integer function queryFieldList(fieldlist, fieldname, abortflag, rc) end function queryFieldList ! !------------------------------------------------------------------------------ +! + subroutine cplStateGet(state, fieldList, fieldCount, rc) + + character(len=*), intent(in) :: state + type(ESMF_Field), pointer, optional :: fieldList(:) + integer, intent(out), optional :: fieldCount + integer, intent(out), optional :: rc + + !--- begin + if (present(rc)) rc = ESMF_SUCCESS + + select case (trim(state)) + case ('import','i') + if (present(fieldList )) fieldList => importFields + if (present(fieldCount)) fieldCount = size(importFields) + case ('export','o') + if (present(fieldList )) fieldList => exportFields + if (present(fieldCount)) fieldCount = size(exportFields) + case default + call ESMF_LogSetError(ESMF_RC_ARG_OUTOFRANGE, & + msg="state argument can only be import(i)/export(o).", & + line=__LINE__, file=__FILE__,& + rcToReturn=rc) + return + end select + + end subroutine cplStateGet + + + subroutine cplFieldGet(state, name, localDe, & + farrayPtr2d, farrayPtr3d, farrayPtr4d, rc) + + character(len=*), intent(in) :: state + character(len=*), intent(in) :: name + integer, intent(in), optional :: localDe + real(ESMF_KIND_R8), pointer, optional :: farrayPtr2d(:,:) + real(ESMF_KIND_R8), pointer, optional :: farrayPtr3d(:,:,:) + real(ESMF_KIND_R8), pointer, optional :: farrayPtr4d(:,:,:,:) + integer, intent(out), optional :: rc + + !--- local variables + integer :: localrc + integer :: de, item, fieldCount, rank + type(ESMF_Field), pointer :: fieldList(:) + character(len=ESMF_MAXSTR) :: fieldName + + !--- begin + if (present(rc)) rc = ESMF_SUCCESS + + if (present(farrayPtr2d)) nullify(farrayPtr2d) + if (present(farrayPtr3d)) nullify(farrayPtr3d) + if (present(farrayPtr4d)) nullify(farrayPtr4d) + + de = 0 + if (present(localDe)) de = localDe + + call cplStateGet(state, fieldList=fieldList, fieldCount=fieldCount, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return + + do item = 1, fieldCount + if (NUOPC_IsConnected(fieldList(item))) then + call ESMF_FieldGet(fieldList(item), name=fieldName, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return + if (trim(fieldName) == trim(name)) then + call ESMF_FieldGet(fieldList(item), rank=rank, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return + select case (rank) + case (2) + if (present(farrayPtr2d)) then + call ESMF_FieldGet(fieldList(item), localDe=de, farrayPtr=farrayPtr2d, & + rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return + end if + case (3) + if (present(farrayPtr3d)) then + call ESMF_FieldGet(fieldList(item), localDe=de, farrayPtr=farrayPtr3d, & + rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return + end if + case (4) + if (present(farrayPtr4d)) then + call ESMF_FieldGet(fieldList(item), localDe=de, farrayPtr=farrayPtr4d, & + rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, & + rcToReturn=rc)) return + end if + case default + call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & + msg="field rank should be 2, 3, or 4.", & + line=__LINE__, file=__FILE__, & + rcToReturn=rc) + return + end select + exit + end if + end if + end do + + end subroutine cplFieldGet +! !------------------------------------------------------------------------------ - end module module_cplfields +! +end module module_cplfields diff --git a/fv3_cap.F90 b/fv3_cap.F90 index aba205fb0..4aad499ab 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -7,7 +7,7 @@ ! revision history ! 11 Oct 2016: J. Wang Initial code ! 18 Apr 2017: J. Wang set up fcst grid component and write grid components -! 24 Jul 2017: J. Wang initialization and time stepping changes for coupling +! 24 Jul 2017: J. Wang initialization and time stepping changes for coupling ! 02 Nov 2017: J. Wang Use Gerhard's transferable RouteHandle ! @@ -16,9 +16,12 @@ module fv3gfs_cap_mod use ESMF use NUOPC use NUOPC_Model, only: model_routine_SS => SetServices, & + model_routine_Run => routine_Run, & model_label_Advance => label_Advance, & + model_label_SetRunClock => label_SetRunClock, & model_label_CheckImport => label_CheckImport, & - model_label_Finalize => label_Finalize + model_label_Finalize => label_Finalize, & + NUOPC_ModelGet ! use module_fv3_config, only: quilting, restart_interval, & nfhout, nfhout_hf, nsout, dt_atmos, & @@ -36,13 +39,18 @@ module fv3gfs_cap_mod imo, jmo, write_nemsioflip, & write_fsyncflag, nsout_io ! - use module_fcst_grid_comp, only: fcstSS => SetServices, fcstGrid + use module_fcst_grid_comp, only: fcstSS => SetServices, & + fcstGrid, numLevels, numTracers, & + numSoilLayers use module_wrt_grid_comp, only: wrtSS => SetServices ! - use module_cplfields, only: nExportFields, exportFields, & - exportFieldsList,importFieldsList, & - nImportFields, importFields - use module_cap_cpl, only: realizeConnectedInternCplField, & + use module_cplfields, only: nExportFields, exportFields, & + exportFieldsList, exportFieldTypes, & + exportFieldShare, & + nImportFields, importFields, & + importFieldsList, importFieldTypes, & + importFieldShare + use module_cap_cpl, only: realizeConnectedCplFields, & clock_cplIntval, Dump_cplFields @@ -67,7 +75,7 @@ module fv3gfs_cap_mod type(ESMF_RouteHandle), allocatable :: routehandle(:,:) integer, allocatable :: fcstPetList(:) - + logical :: profile_memory = .true. character(len=160) :: nuopcMsg @@ -89,14 +97,14 @@ subroutine SetServices(gcomp, rc) character(len=*),parameter :: subname='(fv3gfs_cap:SetServices)' rc = ESMF_SUCCESS - + ! the NUOPC model component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialization, switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=InitializeP0, phase=0, rc=rc) @@ -127,7 +135,7 @@ subroutine SetServices(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! checking the import fields is a bit more complex because of coldstart option call ESMF_MethodRemove(gcomp, model_label_CheckImport, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -142,6 +150,40 @@ subroutine SetServices(gcomp, rc) file=__FILE__)) & return ! bail out + ! setup Run/Advance phase: phase1 + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"phase1"/), userRoutine=model_routine_Run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specPhaseLabel="phase1", specRoutine=ModelAdvance_phase1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! setup Run/Advance phase: phase2 + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"phase2"/), userRoutine=model_routine_Run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specPhaseLabel="phase2", specRoutine=ModelAdvance_phase2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & + specPhaseLabel="phase2", specRoutine=SetRunClock_onestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! model finalize method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & specRoutine=atmos_model_finalize, rc=rc) @@ -159,7 +201,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - + character(len=10) :: value character(240) :: msgString @@ -191,7 +233,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) end subroutine - + !----------------------------------------------------------------------------- subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) @@ -205,8 +247,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm type(ESMF_Time) :: CurrTime, starttime, StopTime - type(ESMF_Time) :: alarm_output_hf_ring, alarm_output_ring - type(ESMF_Time) :: alarm_output_hf_stop, alarm_output_stop + type(ESMF_Time) :: alarm_output_hf_ring, alarm_output_ring + type(ESMF_Time) :: alarm_output_hf_stop, alarm_output_stop type(ESMF_TimeInterval) :: RunDuration, timeStep type(ESMF_Config) :: cf type(ESMF_RegridMethod_Flag) :: regridmethod @@ -225,7 +267,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(160) :: msg integer :: isrctermprocessing - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + character(len=*),parameter :: subname='(fv3_cap:InitializeAdvertise)' integer nfmout, nfsout , nfmout_hf, nfsout_hf real(kind=8) :: MPI_Wtime, timewri, timeis,timeie,timerhs, timerhe ! @@ -404,7 +446,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out 999 continue 998 continue ! if(mype==0) print *,'final date =',date,'date_init=',date_init @@ -415,8 +457,38 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out +! + ! + !Under NUOPC, the EARTH driver clock is a separate instance from the + ! - fv3 clock. However, the fv3 clock may have been reset from restart + ! - therefore the EARTH driver clock must also be adjusted. + ! - Affected: currTime, timeStep + call ESMF_ClockGet(clock, timeStep=earthStep, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (earthStep>(stopTime-currTime)) earthStep=stopTime-currTime + call ESMF_ClockSet(clock, currTime=currTime, & + timeStep=earthStep, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Set fv3 component clock as copy of EARTH clock. + call NUOPC_CompSetClock(gcomp, clock, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! Read in the FV3 coupling interval + if ( cpl ) then + call clock_cplIntval(gcomp, CF) + endif ! ! !Under NUOPC, the EARTH driver clock is a separate instance from the @@ -469,24 +541,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! call ESMF_GridCompSetServices(fcstComp, fcstSS, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc)) & + return ! bail out ! create fcst state fcstState = ESMF_StateCreate(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! call fcst Initialize (including creating fcstgrid and fcst fieldbundle) call ESMF_GridCompInitialize(fcstComp, exportState=fcstState, & @@ -494,11 +566,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc)) & + return ! bail out ! ! reconcile the fcstComp's import state call ESMF_StateReconcile(fcstState, attreconflag= ESMF_ATTRECONCILE_ON, & @@ -506,14 +578,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! ! determine number elements in fcstState call ESMF_StateGet(fcstState, itemCount=FBCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if(mype==0) print *,'af fcstCom FBCount= ',FBcount ! ! allocate arrays @@ -525,7 +597,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! ! loop over all items in the fcstState and collect all FieldBundles do i=1, FBcount @@ -536,7 +608,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! if(mype==0.or.mype==144) print *,'af fcstFB,i=',i,'name=',trim(fcstItemNameList(i)) else @@ -544,8 +616,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg="Only FieldBundles supported in fcstState.", & line=__LINE__, & - file=__FILE__) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc) + return ! bail out endif enddo ! @@ -587,25 +659,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! call into wrtComp(i) SetServices call ESMF_GridCompSetServices(wrtComp(i), wrtSS, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc)) & + return ! bail out ! create wrtstate(i) wrtstate(i) = ESMF_StateCreate(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! add the fcst FieldBundles to the wrtState(i) so write component can ! use this info to create mirror objects @@ -614,13 +686,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out call ESMF_StateAdd(wrtState(i), fcstFB, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! call into wrtComp(i) Initialize call ESMF_GridCompInitialize(wrtComp(i), importState=wrtstate(i), & @@ -628,25 +700,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc)) & + return ! bail out ! remove fcst FieldBundles from the wrtState(i) because done with it call ESMF_StateRemove(wrtState(i), fcstItemNameList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! reconcile the wrtComp(i)'s export state call ESMF_StateReconcile(wrtState(i), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if(mype==0) print *,'af wrtState reconcile, FBcount=',FBcount call ESMF_AttributeCopy(fcstState, wrtState(i), & @@ -654,7 +726,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! loop over all FieldBundle in the states and precompute Regrid operation do j=1, FBcount @@ -667,7 +739,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! determine regridmethod if (index(fcstItemNameList(j),"_bilinear") >0 ) then @@ -684,8 +756,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg="Unable to determine regrid method.", & line=__LINE__, & - file=__FILE__) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc) + return ! bail out endif call ESMF_LogWrite('bf FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) @@ -706,7 +778,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out originPetList(1:num_pes_fcst) = fcstPetList(:) originPetList(num_pes_fcst+1:) = petList(:) @@ -719,7 +791,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out endif write(msg,"(A,I2.2,',',I2.2,A)") "... returned from wrtFB(",j,i, ") FieldBundleRegridStore()." @@ -768,7 +840,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out alarm_output_ring = currtime + output_hfmax + output_interval else alarm_output_ring = currtime + output_interval @@ -788,7 +860,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! !----------------------------------------------------------------------- !*** SET THE FIRST WRITE GROUP AS THE FIRST ONE TO ACT. @@ -805,19 +877,45 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_GridCompIsPetLocal(fcstComp, rc=rc)) then ! importable fields: - call NUOPC_Advertise(importState, StandardNames=ImportFieldsList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - + do i = 1, size(ImportFieldsList) + if (importFieldShare(i)) then + call NUOPC_Advertise(importState, & + StandardName=trim(ImportFieldsList(i)), & + SharePolicyField="share", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call NUOPC_Advertise(importState, & + StandardName=trim(ImportFieldsList(i)), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + end do + ! exportable fields: - call NUOPC_Advertise(exportState, StandardNames=ExportFieldsList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - + do i = 1, size(exportFieldsList) + if (exportFieldShare(i)) then + call NUOPC_Advertise(exportState, & + StandardName=trim(exportFieldsList(i)), & + SharePolicyField="share", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call NUOPC_Advertise(exportState, & + StandardName=trim(exportFieldsList(i)), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + end do + endif if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' endif @@ -843,27 +941,24 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if ( cpl ) then if (ESMF_GridCompIsPetLocal(fcstComp, rc=rc)) then - do n = 1,nImportFields - call realizeConnectedInternCplField(importState, & - field=importFields(n), standardName=trim(importFieldsList(n)), & - grid=fcstGrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo + ! -- realize connected fields in exportState + call realizeConnectedCplFields(exportState, fcstGrid, & + numLevels, numSoilLayers, numTracers, & + exportFieldsList, exportFieldTypes, exportFields, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - do n = 1,nExportFields - call realizeConnectedInternCplField(exportState, & - field=exportFields(n), standardName=trim(exportFieldsList(n)), & - grid=fcstGrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - endif + ! -- realize connected fields in importState + call realizeConnectedCplFields(importState, fcstGrid, & + numLevels, numSoilLayers, numTracers, & + importFieldsList, importFieldTypes, importFields, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if endif end subroutine InitializeRealize @@ -875,7 +970,6 @@ subroutine ModelAdvance(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Field) :: field_work type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime @@ -883,15 +977,13 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: startTime, stopTime type(ESMF_TimeInterval) :: time_elapsed integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec - character(len=64) :: timestamp ! - integer :: na,i,j,i1,j1, urc + integer :: na, i, urc logical :: lalarm, reconcileFlag character(len=*),parameter :: subname='(fv3_cap:ModelAdvance)' character(240) :: msgString !jw debug character(ESMF_MAXSTR) :: name - type(ESMF_VM) :: vm integer :: mype,date(6), fieldcount, fcst_nfld real(kind=ESMF_KIND_R4), pointer :: dataPtr(:,:,:), dataPtr2d(:,:) character(64) :: fcstbdl_name @@ -906,13 +998,7 @@ subroutine ModelAdvance(gcomp, rc) timeri = mpi_wtime() ! - call ESMF_GridCompGet(gcomp,name=name,vm=vm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(vm, localpet = mype,rc=rc) + call ESMF_GridCompGet(gcomp, name=name, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1008,34 +1094,46 @@ subroutine ModelAdvance(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out - call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3,userRc=urc, rc=rc) + call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3, & + phase=1, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + + call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3, & + phase=2, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out call ESMF_LogWrite('Model Advance: after fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out call ESMF_ClockAdvance(clock = clock_fv3, rc = RC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out call esmf_clockget(clock_fv3, currtime=currtime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out time_elapsed = currtime - starttime na = nint(time_elapsed/timeStep) ! @@ -1080,7 +1178,7 @@ subroutine ModelAdvance(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! !end FBcount enddo @@ -1092,7 +1190,7 @@ subroutine ModelAdvance(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out timerhi = mpi_wtime() call ESMF_GridCompRun(wrtComp(n_group), importState=wrtState(n_group), clock=clock_fv3,userRc=urc,rc=rc) @@ -1100,11 +1198,11 @@ subroutine ModelAdvance(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc)) & + return ! bail out ! if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft wrtgridcomp run,na=',na, & ! ' time=', timerh- timerhi @@ -1112,7 +1210,7 @@ subroutine ModelAdvance(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'fv3_cap,aft model advance,na=', & ! na,' time=', mpi_wtime()- timewri @@ -1148,6 +1246,421 @@ subroutine ModelAdvance(gcomp, rc) end subroutine ModelAdvance + !----------------------------------------------------------------------------- + + subroutine ModelAdvance_phase1(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime, stopTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec +! + integer :: na, i, urc + logical :: lalarm, reconcileFlag + character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase1)' + character(240) :: msgString +!jw debug + character(ESMF_MAXSTR) :: name + integer :: mype,date(6), fieldcount, fcst_nfld + real(kind=ESMF_KIND_R4), pointer :: dataPtr(:,:,:), dataPtr2d(:,:) + character(64) :: fcstbdl_name + real(kind=8) :: MPI_Wtime + real(kind=8) :: timewri, timewr, timerhi, timerh + +!----------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if(profile_memory) & + call ESMF_VMLogMemInfo("Entering FV3 Model_ADVANCE phase1: ") +! + call ESMF_GridCompGet(gcomp, name=name, localpet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Expecting to be called by NUOPC run method exactly once for every coupling + ! step. + ! Also expecting the coupling step to be identical to the timeStep for + ! clock_fv3. + + call ESMF_ClockPrint(clock_fv3, options="currTime", & + preString="------>Advancing FV3 from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +!----------------------------------------------------------------------- +!*** Use the internal Clock set by NUOPC layer for FV3 but update stopTime +!----------------------------------------------------------------------- + + ! Component internal Clock gets updated per NUOPC rules + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! The stopTime will be updated to be the next external coupling time + call ESMF_ClockGet(clock, currTime=currTime, stopTime=stopTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Set the FV3-OCN coupling time to be stopTime in Clock that FV3 core uses + call ESMF_ClockSet(clock_fv3, currTime=currTime, stopTime=stopTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockPrint(clock_fv3, options="currTime", & + preString="entering FV3_ADVANCE phase1 with clock_fv3 current: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="startTime", & + preString="entering FV3_ADVANCE phase1 with clock_fv3 start: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="stopTime", & + preString="entering FV3_ADVANCE phase1 with clock_fv3 stop: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock_fv3, startTime=startTime, currTime=currTime, & + timeStep=timeStep, stopTime=stopTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! if(mype==0) print *,'total steps=', nint((stopTime-startTime)/timeStep) +! if(mype==lead_wrttask(1)) print *,'on wrt lead,total steps=', nint((stopTime-startTime)/timeStep) + call ESMF_TimeGet(time=stopTime,yy=date(1),mm=date(2),dd=date(3),h=date(4), & + m=date(5),s=date(6),rc=rc) +! if(mype==0) print *,'af clock,stop date=',date +! if(mype==lead_wrttask(1)) print *,'on wrt lead,af clock,stop date=',date + call ESMF_TimeIntervalGet(timeStep,yy=date(1),mm=date(2),d=date(3),h=date(4), & + m=date(5),s=date(6),rc=rc) +! if(mype==0) print *,'af clock,timestep date=',date +! if(mype==lead_wrttask(1)) print *,'on wrt lead,af clock,timestep date=',date +! + +!----------------------------------------------------------------------------- +!*** no integration loop here! + + reconcileFlag = .true. + +!*** for forecast tasks + + call ESMF_LogWrite('Model Advance phase1: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3, & + phase=1, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + + call ESMF_LogWrite('Model Advance phase1: after fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if(profile_memory) & + call ESMF_VMLogMemInfo("Leaving FV3 Model_ADVANCE phase1: ") + + end subroutine ModelAdvance_phase1 + + !----------------------------------------------------------------------------- + + subroutine ModelAdvance_phase2(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime, stopTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec +! + integer :: na, i, urc + logical :: lalarm, reconcileFlag + character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase2)' + character(240) :: msgString +!jw debug + character(ESMF_MAXSTR) :: name + integer :: mype,date(6), fieldcount, fcst_nfld + real(kind=ESMF_KIND_R4), pointer :: dataPtr(:,:,:), dataPtr2d(:,:) + character(64) :: fcstbdl_name + real(kind=8) :: MPI_Wtime + real(kind=8) :: timewri, timewr, timerhi, timerh + +!----------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if(profile_memory) & + call ESMF_VMLogMemInfo("Entering FV3 Model_ADVANCE phase2: ") +! + call ESMF_GridCompGet(gcomp, name=name, localpet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +!----------------------------------------------------------------------------- +!*** no integration loop + + reconcileFlag = .true. + +! +!*** for forecast tasks + + timewri = mpi_wtime() + call ESMF_LogWrite('Model Advance phase2: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3, & + phase=2, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + + call ESMF_LogWrite('Model Advance phase2: after fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockAdvance(clock = clock_fv3, rc = RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_ClockGet(clock_fv3, startTime=startTime, currTime=currTime, & + timeStep=timeStep, stopTime=stopTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + time_elapsed = currtime - starttime + na = nint(time_elapsed/timeStep) +! + if(mype==0) print *,'n fv3_cap,in model run, advance,na=',na + +!------------------------------------------------------------------------------- +!*** if alarms ring, call data transfer and write grid comp run + if( quilting ) then + + lalarm = .false. + if (nfhmax_hf > 0) then + + if(currtime <= starttime+output_hfmax) then + if(ESMF_AlarmIsEnabled(alarm = ALARM_OUTPUT_HF, rc = RC)) then + if( ESMF_AlarmIsRinging(alarm = ALARM_OUTPUT_HF,rc = Rc)) LALARM = .true. + endif + else + if(ESMF_AlarmIsEnabled(alarm = ALARM_OUTPUT, rc = RC)) then + if(ESMF_AlarmIsRinging(alarm = ALARM_OUTPUT,rc = Rc)) LALARM = .true. + endif + endif + + endif +! + if(ESMF_AlarmIsEnabled(alarm = ALARM_OUTPUT, rc = RC)) then + if(ESMF_AlarmIsRinging(alarm = ALARM_OUTPUT,rc = Rc)) LALARM = .true. + endif + if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run lalarm=',lalarm, & + 'FBcount=',FBcount,'na=',na + + output: IF(lalarm .or. na==1 ) then + + timerhi = mpi_wtime() + do i=1, FBCount +! +! get fcst fieldbundle +! + call ESMF_FieldBundleRegrid(fcstFB(i), wrtFB(i,n_group), & + routehandle=routehandle(i, n_group), rc=rc) + timerh = mpi_wtime() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! +!end FBcount + enddo + if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft fieldbundleregrid,na=',na, & + ' time=', timerh- timerhi + +! if(mype==0 .or. mype==lead_wrttask(1)) print *,'on wrt bf wrt run, na=',na + call ESMF_LogWrite('Model Advance: before wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + timerhi = mpi_wtime() + call ESMF_GridCompRun(wrtComp(n_group), importState=wrtState(n_group), clock=clock_fv3,userRc=urc,rc=rc) + timerh = mpi_wtime() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft wrtgridcomp run,na=',na, & + ' time=', timerh- timerhi + + call ESMF_LogWrite('Model Advance: after wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'fv3_cap,aft model advance phase2,na=', & + na,' time=', mpi_wtime()- timewri + + if(n_group == write_groups) then + n_group = 1 + else + n_group = n_group + 1 + endif + + endif output + +! end quilting + endif + +! +!jw check clock + call ESMF_ClockPrint(clock_fv3, options="currTime", & + preString="leaving FV3_ADVANCE phase2 with clock_fv3 current: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="startTime", & + preString="leaving FV3_ADVANCE phase2 with clock_fv3 start: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="stopTime", & + preString="leaving FV3_ADVANCE phase2 with clock_fv3 stop: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + + if(profile_memory) & + call ESMF_VMLogMemInfo("Leaving FV3 Model_ADVANCE phase2: ") + + end subroutine ModelAdvance_phase2 + + !----------------------------------------------------------------------------- + + subroutine SetRunClock_onestep(model, rc) + type(ESMF_GridComp) :: model + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock, driverClock + type(ESMF_Time) :: checkCurrTime, currTime, stopTime + type(ESMF_TimeInterval) :: checkTimeStep, timeStep + type(ESMF_Direction_Flag) :: direction + + rc = ESMF_SUCCESS + + ! query component for clock and driver clock + call NUOPC_ModelGet(model, modelClock=clock, driverClock=driverClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! query driver clock for incoming information + call ESMF_ClockGet(driverClock, currTime=checkCurrTime, & + timeStep=checkTimeStep, direction=direction, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! query component clock for its information + call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ensure the current times have the correct relationship + if (currTime /= checkCurrTime + checkTimeStep) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="NUOPC INCOMPATIBILITY DETECTED: "// & + "component clock and driver clock currentTime not as expected!", & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc) + return ! bail out + endif + + ! ensure that the driver timestep is a multiple of the component timestep + if (ceiling(checkTimeStep/timeStep) /= floor(checkTimeStep/timeStep))& + then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="NUOPC INCOMPATIBILITY DETECTED: "// & + "driver timestep is not multiple of model timestep!", & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc) + return ! bail out + endif + + ! adjust the currTime of the clock + if (direction==ESMF_DIRECTION_FORWARD) then + currTime = currTime - checkTimeStep + else + currTime = currTime + checkTimeStep + endif + call ESMF_ClockSet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine SetRunClock_onestep + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- @@ -1177,11 +1690,11 @@ subroutine atmos_model_finalize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc)) & + return ! bail out enddo endif @@ -1189,11 +1702,11 @@ subroutine atmos_model_finalize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + file=__FILE__, rcToReturn=rc)) & + return ! bail out ! !*** destroy grid comps if( quilting ) then @@ -1202,12 +1715,12 @@ subroutine atmos_model_finalize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out call ESMF_GridCompDestroy(wrtComp(i), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out enddo endif @@ -1215,12 +1728,12 @@ subroutine atmos_model_finalize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out call ESMF_GridCompDestroy(fcstComp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) + return ! bail out ! if(mype==0)print *,' wrt grid comp destroy time=',mpi_wtime()-timeffs diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 68ff9a413..2138d0bcc 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1248,8 +1248,8 @@ subroutine GFS_physics_driver & Sfcprop%snowd, qss, snowmt, gflx, Diag%cmm, Diag%chh, evap, & hflx) - if (Model%cplflx) then - do i=1,im + if (Model%cplflx .or. Model%cplchm) then + do i = 1, im if (flag_cice(i)) then islmsk(i) = nint(Sfcprop%slmsk(i)) endif @@ -1689,6 +1689,15 @@ subroutine GFS_physics_driver & enddo endif + if (Model%cplchm) then + do i = 1, im + tem1 = max(Diag%q1(i), 1.e-8) + tem = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(1.0+con_fvirt*tem1)) + Coupling%ushfsfci(i) = -con_cp * tem * hflx(i) ! upward sensible heat flux + enddo + Coupling%dkt (:,:) = dkt (:,:) + endif + ! if (lprnt) then ! write(0,*) ' dusfc1=',dusfc1(ipr),' kdt=',kdt,' lat=',lat ! write(0,*)' dtsfc1=',dtsfc1(ipr) @@ -3758,6 +3767,12 @@ subroutine GFS_physics_driver & enddo endif + if ((Model%cplchm).and.(.not.Model%cplflx)) then + do i = 1, im + Coupling%rain_cpl(i) = Coupling%rain_cpl(i) + Diag%rain(i) + Coupling%rainc_cpl(i) = Coupling%rainc_cpl(i) + Diag%rainc(i) + enddo + endif ! --- ... end coupling insertion !!! update surface diagnosis fields at the end of phys package diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 076e1d37d..f59e89810 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -260,7 +260,8 @@ module GFS_typedefs !--- outgoing accumulated quantities real (kind=kind_phys), pointer :: rain_cpl (:) => null() !< total rain precipitation - real (kind=kind_phys), pointer :: snow_cpl (:) => null() !< total snow precipitation + real (kind=kind_phys), pointer :: rainc_cpl (:) => null() !< convective rain precipitation + real (kind=kind_phys), pointer :: snow_cpl (:) => null() !< total snow precipitation real (kind=kind_phys), pointer :: dusfc_cpl (:) => null() !< sfc u momentum flux real (kind=kind_phys), pointer :: dvsfc_cpl (:) => null() !< sfc v momentum flux real (kind=kind_phys), pointer :: dtsfc_cpl (:) => null() !< sfc sensible heat flux @@ -323,6 +324,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: cldcovi (:,:) => null() !< instantaneous 3D cloud fraction real (kind=kind_phys), pointer :: nwfa2d (:) => null() !< instantaneous sfc aerosol source + !--- instantaneous quantities for GSDCHEM coupling + real (kind=kind_phys), pointer :: ushfsfci(:) => null() !< instantaneous upward sensible heat flux (w/m**2) + real (kind=kind_phys), pointer :: dkt (:,:) => null() !< instantaneous dkt diffusion coefficient for temperature (m**2/s) + contains procedure :: create => coupling_create !< allocate array data end type GFS_coupling_type @@ -365,6 +370,7 @@ module GFS_typedefs !--- coupling parameters logical :: cplflx !< default no cplflx collection logical :: cplwav !< default no cplwav collection + logical :: cplchm !< default no cplchm collection !--- integrated dynamics through earth's atmosphere logical :: lsidea @@ -1334,6 +1340,22 @@ subroutine coupling_create (Coupling, IM, Model) !! Coupling%slmsk_cpl = clear_val !< pointer to sfcprop%slmsk endif + ! -- GSDCHEM coupling options + if (Model%cplchm) then + !--- outgoing instantaneous quantities + allocate (Coupling%ushfsfci(IM)) + allocate (Coupling%dkt (IM,Model%levs)) + !--- accumulated total and convective rainfall + allocate (Coupling%rain_cpl (IM)) + allocate (Coupling%rainc_cpl (IM)) + + Coupling%rain_cpl = clear_val + Coupling%rainc_cpl = clear_val + + Coupling%ushfsfci = clear_val + Coupling%dkt = clear_val + endif + !--- stochastic physics option if (Model%do_sppt) then allocate (Coupling%sppt_wts (IM,Model%levs)) @@ -1451,6 +1473,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters logical :: cplflx = .false. !< default no cplflx collection logical :: cplwav = .false. !< default no cplwav collection + logical :: cplchm = .false. !< default no cplchm collection !--- integrated dynamics through earth's atmosphere logical :: lsidea = .false. @@ -1689,7 +1712,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & fhzero, ldiag3d, lssav, fhcyc, lgocart, fhgoc3d, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplwav, lsidea, & + cplflx, cplwav, cplchm, lsidea, & !--- radiation parameters fhswr, fhlwr, levr, nfxr, aero_in, iflip, isol, ico2, ialb, & isot, iems, iaer, iovr_sw, iovr_lw, ictm, isubc_sw, & @@ -1795,6 +1818,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters Model%cplflx = cplflx Model%cplwav = cplwav + Model%cplchm = cplchm !--- integrated dynamics through earth's atmosphere Model%lsidea = lsidea @@ -2360,6 +2384,7 @@ subroutine control_print(Model) print *, 'coupling parameters' print *, ' cplflx : ', Model%cplflx print *, ' cplwav : ', Model%cplwav + print *, ' cplchm : ', Model%cplchm print *, ' ' print *, 'integrated dynamics through earth atmosphere' print *, ' lsidea : ', Model%lsidea diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index ebf34d2ee..1746c7414 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -21,10 +21,13 @@ module module_fcst_grid_comp get_date use atmos_model_mod, only: atmos_model_init, atmos_model_end, & + get_atmos_model_ungridded_dim, & update_atmos_model_dynamics, & update_atmos_radiation_physics, & update_atmos_model_state, & atmos_data_type, atmos_model_restart, & + atmos_model_exchange_phase_1, & + atmos_model_exchange_phase_2, & addLsmask2grid use constants_mod, only: constants_init @@ -87,13 +90,17 @@ module module_fcst_grid_comp type(ESMF_VM),save :: VM type(ESMF_Grid) :: fcstGrid -!----- coupled model date ----- +!----- coupled model data ----- integer :: date_init(6) + integer :: numLevels = 0 + integer :: numTracers = 0 + integer :: numSoilLayers = 0 ! !----------------------------------------------------------------------- ! public SetServices, fcstGrid + public numLevels, numTracers, numSoilLayers ! contains ! @@ -116,7 +123,13 @@ subroutine SetServices(fcst_comp, rc) return ! bail out ! call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_RUN, & - userRoutine=fcst_run, rc=rc) + userRoutine=fcst_run_phase_1, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_RUN, & + userRoutine=fcst_run_phase_2, phase=2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -372,10 +385,18 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) !test to write out vtk file: if( cpl ) then call addLsmask2grid(fcstGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! print *,'call addLsmask2grid after fcstgrid, rc=',rc if( cplprint_flag ) then call ESMF_GridWriteVTK(fcstgrid, staggerloc=ESMF_STAGGERLOC_CENTER, & filename='fv3cap_fv3Grid', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif endif ! @@ -527,6 +548,9 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) !end qulting endif + + call get_atmos_model_ungridded_dim(nlev=numLevels, ntracers=numTracers, & + nsoillev=numSoilLayers) ! !----------------------------------------------------------------------- ! @@ -538,19 +562,19 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! if(mype==0) print *,'in fcst,init total time: ', mpi_wtime() - timeis ! -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! end subroutine fcst_initialize ! -!----------------------------------------------------------------------- -!####################################################################### -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- ! - subroutine fcst_run(fcst_comp, importState, exportState,clock,rc) + subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) ! -!----------------------------------------------------------------------- -!*** the run step for the fcst gridded component. -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!*** the run step for the fcst gridded component. +!----------------------------------------------------------------------- ! type(ESMF_GridComp) :: fcst_comp type(ESMF_State) :: importState, exportState @@ -578,26 +602,26 @@ subroutine fcst_run(fcst_comp, importState, exportState,clock,rc) !----------------------------------------------------------------------- ! tbeg1 = mpi_wtime() - rc = esmf_success + rc = esmf_success ! !----------------------------------------------------------------------- ! - call ESMF_GridCompGet(fcst_comp, name=compname, rc=rc) + call ESMF_GridCompGet(fcst_comp, name=compname, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out ! - call ESMF_VMGetCurrent(VM,rc=RC) -! - call ESMF_VMGet(VM, localpet=mype,rc=rc) - call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, rc=rc) - + call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + na = NTIMESTEP_ESMF -! if(mype==0) print *,'in fcst run, na=',na ! !----------------------------------------------------------------------- -! *** call fcst integration subroutines +! *** call fcst integration subroutines call get_date (atm_int_state%Time_atmos, date(1), date(2), date(3), & date(4), date(5), date(6)) @@ -607,6 +631,90 @@ subroutine fcst_run(fcst_comp, importState, exportState,clock,rc) call update_atmos_radiation_physics (atm_int_state%Atm) + call atmos_model_exchange_phase_1 (atm_int_state%Atm, 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,*)"FAIL: fcst_RUN" +! ELSE + WRITE(0,*)"PASS: fcstRUN, na=",na +! ENDIF +! + if(mype==0) print *,'fcst_run_phase_1 time is ', mpi_wtime()-tbeg1 +! +!----------------------------------------------------------------------- +! + end subroutine fcst_run_phase_1 +! +!----------------------------------------------------------------------- +!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!----------------------------------------------------------------------- +! + subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) +! +!----------------------------------------------------------------------- +!*** the run step for the fcst gridded component. +!----------------------------------------------------------------------- +! + type(ESMF_GridComp) :: fcst_comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc +! +!----------------------------------------------------------------------- +!*** local variables +! + type(ESMF_FieldBundle) :: file_bundle +! + integer :: i,j, mype, na, date(6) + character(20) :: compname + + type(ESMF_Time) :: currtime + integer(kind=ESMF_KIND_I8) :: ntimestep_esmf + character(len=64) :: timestamp +! +!----------------------------------------------------------------------- +! + real(kind=8) :: mpi_wtime, tbeg1 +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + tbeg1 = mpi_wtime() + rc = esmf_success +! +!----------------------------------------------------------------------- +! + call ESMF_GridCompGet(fcst_comp, name=compname, localpet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! + call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + na = NTIMESTEP_ESMF + if(mype==0) print *,'in fcst run phase 2, na=',na +! +!----------------------------------------------------------------------- +! *** call fcst integration subroutines + + call atmos_model_exchange_phase_2 (atm_int_state%Atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call update_atmos_model_state (atm_int_state%Atm) !--- intermediate restart @@ -625,17 +733,17 @@ subroutine fcst_run(fcst_comp, importState, exportState,clock,rc) ! !----------------------------------------------------------------------- ! - IF(RC /= ESMF_SUCCESS) THEN - WRITE(0,*)"FAIL: fcst_RUN" +! IF(RC /= ESMF_SUCCESS) THEN +! WRITE(0,*)"FAIL: fcst_RUN" ! ELSE -! WRITE(0,*)"PASS: fcstRUN, na=",na - ENDIF + WRITE(0,*)"PASS: fcstRUN, na=",na +! ENDIF ! -! if(mype==0) print *,'fcst _run time is ', mpi_wtime()-tbeg1 + if(mype==0) print *,'fcst_run_phase_2 time is ', mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! - end subroutine fcst_run + end subroutine fcst_run_phase_2 ! !----------------------------------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&