From ab94e52e5d75676696078974d118bf143c2e0f2f Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Sun, 23 May 2021 17:42:22 +0000 Subject: [PATCH] Refactor updated setup_exportdata() (#301) to work with chemistry and other coupled components that don't require cplflx set to .true.. Fortran preprocessor macros are introduced to minimize code replication. --- CMakeLists.txt | 1 + atmos_model.F90 | 989 ++----------------------------- fv3_cap.F90 | 6 +- include/atm_data_copy.h | 64 ++ include/dynamics_export_fields.h | 46 ++ include/gfs_data_copy.h | 84 +++ include/jedi_export_fields.h | 135 +++++ include/physics_export_fields.h | 239 ++++++++ 8 files changed, 632 insertions(+), 932 deletions(-) create mode 100644 include/atm_data_copy.h create mode 100644 include/dynamics_export_fields.h create mode 100644 include/gfs_data_copy.h create mode 100644 include/jedi_export_fields.h create mode 100644 include/physics_export_fields.h diff --git a/CMakeLists.txt b/CMakeLists.txt index 2cecbf2d0..bf6fda113 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -143,6 +143,7 @@ list(APPEND _fv3atm_defs_private GFS_PHYS target_compile_definitions(fv3atm PRIVATE "${_fv3atm_defs_private}") set_target_properties(fv3atm PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) +target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/include) target_include_directories(fv3atm INTERFACE $ $) diff --git a/atmos_model.F90 b/atmos_model.F90 index 26868bedb..7db6a7de3 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -761,14 +761,17 @@ end subroutine atmos_model_exchange_phase_2 ! -subroutine update_atmos_model_state (Atmos) +subroutine update_atmos_model_state (Atmos, rc) ! to update the model state after all concurrency is completed + use ESMF type (atmos_data_type), intent(inout) :: Atmos + integer, optional, intent(out) :: rc !--- local variables integer :: isec, seconds, isec_fhzero - integer :: rc real(kind=GFS_kind_phys) :: time_int, time_intfull ! + if (present(rc)) rc = ESMF_SUCCESS + call set_atmosphere_pelist() call mpp_clock_begin(fv3Clock) call mpp_clock_begin(updClock) @@ -827,7 +830,9 @@ subroutine update_atmos_model_state (Atmos) !if in coupled mode, set up coupled fields if (.not. GFS_control%cplchm) then - call setup_exportdata() + call setup_exportdata(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return endif end subroutine update_atmos_model_state @@ -2302,31 +2307,40 @@ subroutine assign_importdata(rc) end subroutine assign_importdata ! - subroutine setup_exportdata() + subroutine setup_exportdata(rc) use ESMF use module_cplfields, only: exportFields + !--- arguments + integer, optional, intent(out) :: rc + !--- local variables - integer :: j, i, k, ix, nb, nk, isc, iec, jsc, jec, idx + integer :: i, j, k, idx, ix + integer :: isc, iec, jsc, jec + integer :: ib, jb, nb, nsb, nk integer :: sphum, liq_wat, ice_wat, o3mr real(GFS_kind_phys) :: rtime, rtimek - integer :: localrc, rc - integer :: n,dimCount - logical :: isCreated + integer :: localrc + integer :: n,rank + logical :: isFound type(ESMF_TypeKind_Flag) :: datatype character(len=ESMF_MAXSTR) :: fieldName real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer :: datar83d + !--- begin + if (present(rc)) rc = ESMF_SUCCESS + isc = Atm_block%isc iec = Atm_block%iec jsc = Atm_block%jsc jec = Atm_block%jec nk = Atm_block%npz + nsb = Atm_block%blkno(isc,jsc) rtime = one / GFS_control%dtp rtimek = GFS_control%rho_h2o * rtime @@ -2337,931 +2351,46 @@ subroutine setup_exportdata() datar82d => null() datar83d => null() - isCreated = ESMF_FieldIsCreated(exportFields(n), rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if (.not. isCreated) cycle - - call ESMF_FieldGet(exportFields(n), name=fieldname, dimCount=dimCount, typekind=datatype, rc=localrc) + isFound = ESMF_FieldIsCreated(exportFields(n), 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=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - else if (dimCount == 3) then - call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - else - write(0,*)'not implemented dimCount ',dimCount, trim(fieldname) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - else if (datatype == ESMF_TYPEKIND_R4) then - if (dimCount == 2) then - call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - else - write(0,*)'not implemented dimCount ',dimCount, trim(fieldname) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - else - write(0,*) 'not implemented datatype ',datatype, trim(fieldname) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - - - ! Instantaneous u wind (m/s) 10 m above ground - if (trim(fieldname) == 'inst_zonal_wind_height10m') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%u10mi_cpl(ix) - enddo - enddo - endif - - ! Instantaneous v wind (m/s) 10 m above ground - if (trim(fieldname) == 'inst_merid_wind_height10m') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%v10mi_cpl(ix) - enddo - enddo - endif - - ! MEAN Zonal compt of momentum flux (N/m**2) - if (trim(fieldname) == 'mean_zonal_moment_flx_atm') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dusfc_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN Merid compt of momentum flux (N/m**2) - if (trim(fieldname) == 'mean_merid_moment_flx_atm') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvsfc_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN Sensible heat flux (W/m**2) - if (trim(fieldname) == 'mean_sensi_heat_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dtsfc_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN Latent heat flux (W/m**2) - if (trim(fieldname) == 'mean_laten_heat_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dqsfc_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN Downward LW heat flux (W/m**2) - if (trim(fieldname) == 'mean_down_lw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dlwsfc_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN Downward SW heat flux (W/m**2) - if (trim(fieldname) == 'mean_down_sw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dswsfc_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN precipitation rate (kg/m2/s) - if (trim(fieldname) == 'mean_prec_rate') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%rain_cpl(ix) * rtimek - enddo - enddo - endif - - ! Instataneous Zonal compt of momentum flux (N/m**2) - if (trim(fieldname) == 'inst_zonal_moment_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dusfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous Merid compt of momentum flux (N/m**2) - if (trim(fieldname) == 'inst_merid_moment_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvsfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous Sensible heat flux (W/m**2) - if (trim(fieldname) == 'inst_sensi_heat_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dtsfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous Latent heat flux (W/m**2) - if (trim(fieldname) == 'inst_laten_heat_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dqsfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous Downward long wave radiation flux (W/m**2) - if (trim(fieldname) == 'inst_down_lw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dlwsfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous Downward solar radiation flux (W/m**2) - if (trim(fieldname) == 'inst_down_sw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dswsfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous Temperature (K) 2 m above ground - if (trim(fieldname) == 'inst_temp_height2m') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%t2mi_cpl(ix) - enddo - enddo - endif - - ! Instataneous Specific humidity (kg/kg) 2 m above ground - if (trim(fieldname) == 'inst_spec_humid_height2m') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%q2mi_cpl(ix) - enddo - enddo - endif - - ! Instataneous Temperature (K) at surface - if (trim(fieldname) == 'inst_temp_height_surface') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%tsfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous Pressure (Pa) land and sea surface - if (trim(fieldname) == 'inst_pres_height_surface') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%psurfi_cpl(ix) - enddo - enddo - endif - - ! Instataneous Surface height (m) - if (trim(fieldname) == 'inst_surface_height') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%oro_cpl(ix) - enddo - enddo - endif - - ! MEAN NET long wave radiation flux (W/m**2) - if (trim(fieldname) == 'mean_net_lw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nlwsfc_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN NET solar radiation flux over the ocean (W/m**2) - if (trim(fieldname) == 'mean_net_sw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nswsfc_cpl(ix) * rtime - enddo - enddo - endif - - ! Instataneous NET long wave radiation flux (W/m**2) - if (trim(fieldname) == 'inst_net_lw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nlwsfci_cpl(ix) - enddo - enddo - endif - - ! Instataneous NET solar radiation flux over the ocean (W/m**2) - if (trim(fieldname) == 'inst_net_sw_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nswsfci_cpl(ix) - enddo - enddo - endif - - ! MEAN sfc downward nir direct flux (W/m**2) - if (trim(fieldname) == 'mean_down_sw_ir_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirbm_cpl(ix) * rtime - enddo - enddo - endif - ! MEAN sfc downward nir diffused flux (W/m**2) - if (trim(fieldname) == 'mean_down_sw_ir_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirdf_cpl(ix) * rtime - enddo - enddo - endif + if (isFound) then + call ESMF_FieldGet(exportFields(n), name=fieldname, rank=rank, 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 + select case (rank) + case (2) + 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 + case (3) + 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 + case default + !--- skip field + isFound = .false. + end select + else if (datatype == ESMF_TYPEKIND_R4) then + select case (rank) + case (2) + call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + case default + !--- skip field + isFound = .false. + end select + else + !--- skip field + isFound = .false. + end if + end if - ! MEAN sfc downward uv+vis direct flux (W/m**2) - if (trim(fieldname) == 'mean_down_sw_vis_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisbm_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN sfc downward uv+vis diffused flux (W/m**2) - if (trim(fieldname) == 'mean_down_sw_vis_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisdf_cpl(ix) * rtime - enddo - enddo - endif - - ! Instataneous sfc downward nir direct flux (W/m**2) - if (trim(fieldname) == 'inst_down_sw_ir_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirbmi_cpl(ix) - enddo - enddo - endif - - ! Instataneous sfc downward nir diffused flux (W/m**2) - if (trim(fieldname) == 'inst_down_sw_ir_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirdfi_cpl(ix) - enddo - enddo - endif - - ! Instataneous sfc downward uv+vis direct flux (W/m**2) - if (trim(fieldname) == 'inst_down_sw_vis_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisbmi_cpl(ix) - enddo - enddo - endif - - ! Instataneous sfc downward uv+vis diffused flux (W/m**2) - if (trim(fieldname) == 'inst_down_sw_vis_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisdfi_cpl(ix) - enddo - enddo - endif - - ! MEAN NET sfc nir direct flux (W/m**2) - if (trim(fieldname) == 'mean_net_sw_ir_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirbm_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN NET sfc nir diffused flux (W/m**2) - if (trim(fieldname) == 'mean_net_sw_ir_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirdf_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN NET sfc uv+vis direct flux (W/m**2) - if (trim(fieldname) == 'mean_net_sw_vis_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisbm_cpl(ix) * rtime - enddo - enddo - endif - - ! MEAN NET sfc uv+vis diffused flux (W/m**2) - if (trim(fieldname) == 'mean_net_sw_vis_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisdf_cpl(ix) * rtime - enddo - enddo - endif - - ! Instataneous net sfc nir direct flux (W/m**2) - if (trim(fieldname) == 'inst_net_sw_ir_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirbmi_cpl(ix) - enddo - enddo - endif - - ! Instataneous net sfc nir diffused flux (W/m**2) - if (trim(fieldname) == 'inst_net_sw_ir_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirdfi_cpl(ix) - enddo - enddo - endif - - ! Instataneous net sfc uv+vis direct flux (W/m**2) - if (trim(fieldname) == 'inst_net_sw_vis_dir_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisbmi_cpl(ix) - enddo - enddo - endif - - ! Instataneous net sfc uv+vis diffused flux (W/m**2) - if (trim(fieldname) == 'inst_net_sw_vis_dif_flx') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisdfi_cpl(ix) - enddo - enddo - endif - - ! Land/Sea mask (sea:0,land:1) - if (trim(fieldname) == 'inst_land_sea_mask') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%slmsk_cpl(ix) - enddo - enddo - endif - -! Data from DYCORE: - - ! bottom layer temperature (t) - if (trim(fieldname) == 'inst_temp_height_lowest') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%t_bot)) then - datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%t_bot(ix) - else - datar82d(i-isc+1,j-jsc+1) = zero - endif - enddo - enddo - endif - - ! bottom layer specific humidity (q) - !!! CHECK if tracer 1 is for specific humidity !!! - if (trim(fieldname) == 'inst_spec_humid_height_lowest') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%tr_bot)) then - datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%tr_bot(ix,1) - else - datar82d(i-isc+1,j-jsc+1) = zero - endif - enddo - enddo - endif - - ! bottom layer zonal wind (u) - if (trim(fieldname) == 'inst_zonal_wind_height_lowest') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%u_bot)) then - datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%u_bot(ix) - else - datar82d(i-isc+1,j-jsc+1) = zero - endif - enddo - enddo - endif - - ! bottom layer meridionalw wind (v) - if (trim(fieldname) == 'inst_merid_wind_height_lowest') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%v_bot)) then - datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%v_bot(ix) - else - datar82d(i-isc+1,j-jsc+1) = zero - endif - enddo - enddo - endif - - ! bottom layer pressure (p) - if (trim(fieldname) == 'inst_pres_height_lowest') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%p_bot)) then - datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%p_bot(ix) - else - datar82d(i-isc+1,j-jsc+1) = zero - endif - enddo - enddo - endif - - ! bottom layer height (z) - if (trim(fieldname) == 'inst_height_lowest') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%z_bot)) then - datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%z_bot(ix) - else - datar82d(i-isc+1,j-jsc+1) = zero - endif - enddo - enddo - endif - -! END Data from DYCORE. - - ! MEAN snow precipitation rate (kg/m2/s) - if (trim(fieldname) == 'mean_fprec_rate') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%snow_cpl(ix) * rtimek - enddo - enddo - endif - - ! oceanfrac used by atm to calculate fluxes - if (trim(fieldname) == 'openwater_frac_in_atm') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = (one - GFS_Data(nb)%Sfcprop%fice(ix))*GFS_Data(nb)%Sfcprop%oceanfrac(ix) - enddo - enddo - endif - - ! For JEDI - - sphum = get_tracer_index(MODEL_ATMOS, 'sphum') - liq_wat = get_tracer_index(MODEL_ATMOS, 'liq_wat') - ice_wat = get_tracer_index(MODEL_ATMOS, 'ice_wat') - o3mr = get_tracer_index(MODEL_ATMOS, 'o3mr') - - if (trim(fieldname) == 'u') then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%u(i,j,k) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'v') then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%v(i,j,k) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'ua') then -!$omp parallel do default(shared) private(i,j,k,nb,ix) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%ua(i,j,k) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'va') then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%va(i,j,k) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 't') then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%pt(i,j,k) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'delp') then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%delp(i,j,k) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'sphum' .and. sphum > 0) then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,sphum) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'ice_wat' .and. ice_wat > 0) then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,ice_wat) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'liq_wat' .and. liq_wat > 0) then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,liq_wat) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'o3mr' .and. o3mr > 0) then -!$omp parallel do default(shared) private(i,j,k) - do k = 1, nk - do j=jsc,jec - do i=isc,iec - datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,o3mr) - enddo - enddo - enddo - endif - - if (trim(fieldname) == 'phis') then -!$omp parallel do default(shared) private(i,j) - do j=jsc,jec - do i=isc,iec - datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%phis(i,j) - enddo - enddo - endif - - if (trim(fieldname) == 'u_srf') then -!$omp parallel do default(shared) private(i,j) - do j=jsc,jec - do i=isc,iec - datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%u_srf(i,j) - enddo - enddo - endif - - if (trim(fieldname) == 'v_srf') then -!$omp parallel do default(shared) private(i,j) - do j=jsc,jec - do i=isc,iec - datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%v_srf(i,j) - enddo - enddo - endif - - ! physics - if (trim(fieldname) == 'slmsk') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%slmsk(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'weasd') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%weasd(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'tsea') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%tsfco(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'vtype') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%vtype(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'stype') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%stype(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'vfrac') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%vfrac(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'stc') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar83d(i-isc+1,j-jsc+1,:) = GFS_data(nb)%Sfcprop%stc(ix,:) - enddo - enddo - endif - - if (trim(fieldname) == 'smc') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar83d(i-isc+1,j-jsc+1,:) = GFS_data(nb)%Sfcprop%smc(ix,:) - enddo - enddo - endif - - if (trim(fieldname) == 'snwdph') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%snowd(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'f10m') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%f10m(ix) - enddo - enddo - endif - - if (trim(fieldname) == 'zorl') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%zorl(ix) - enddo - enddo - endif - - if (trim(fieldname) == 't2m') then -!$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%t2m(ix) - enddo - enddo - endif + if (isFound) then + select case (trim(fieldname)) +#include "physics_export_fields.h" +#include "dynamics_export_fields.h" +#include "jedi_export_fields.h" + end select + end if enddo ! exportFields diff --git a/fv3_cap.F90 b/fv3_cap.F90 index dce7ed6c7..49c977348 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -916,6 +916,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! -- initialize export fields if applicable + call setup_exportdata(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! -- realize connected fields in importState call realizeConnectedCplFields(importState, fcstGrid, & numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, & @@ -924,8 +928,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) importFields, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call setup_exportdata() - end if end subroutine InitializeRealize diff --git a/include/atm_data_copy.h b/include/atm_data_copy.h new file mode 100644 index 000000000..a2cc8d013 --- /dev/null +++ b/include/atm_data_copy.h @@ -0,0 +1,64 @@ +#undef __atm_data_src +#ifdef _atm_src_ptr +# define __atm_data_src Atm(mygrid)%_atm_src_ptr +#endif + +#undef __atm_data_dst +#ifdef _atm_dst_ptr +# define __atm_data_dst _atm_dst_ptr +#endif + +#undef __ik +#undef __beg_k_loop +#undef __end_k_loop +#ifdef _atm_copy_3d +# define __ik ,k +# define __beg_k_loop do k=1,nk +# define __end_k_loop enddo +#else +# define __ik +# define __beg_k_loop +# define __end_k_loop +#endif + +#undef __lev +#ifdef _atm_copy_lev +# define __lev ,: +#else +# define __lev +#endif + +#undef __trac +#undef __itrac +#undef __beg_check_trac +#undef __end_check_trac +#ifdef _atm_src_trac +# define __trac _atm_src_trac +# define __itrac ,__trac +# define __beg_check_trac if (__trac > 0) then +# define __end_check_trac endif +#else +# define __trac +# define __itrac +# define __beg_check_trac +# define __end_check_trac +#endif + +#if (defined(__atm_data_dst) && defined(__atm_data_src)) + __beg_check_trac +!$omp parallel do default(shared) private(i,ib,ix,j,jb __ik) + __beg_k_loop + do jb=jsc,jec + i = 0 + j = jb - jsc + 1 + do ib=isc,iec + i = i + 1 + __atm_data_dst(i, j __ik __lev) = __atm_data_src(i, j __ik __itrac __lev) + enddo + enddo + __end_k_loop + __end_check_trac +#endif + +#undef _atm_src_ptr +#undef _atm_src_trac diff --git a/include/dynamics_export_fields.h b/include/dynamics_export_fields.h new file mode 100644 index 000000000..77d8080f6 --- /dev/null +++ b/include/dynamics_export_fields.h @@ -0,0 +1,46 @@ +#undef _atm_src_gfs +#undef _atm_src_dycore +#undef _atm_src_array +#undef _atm_src_cnv +#undef _atm_src_ptr +#undef _atm_src_trac +#undef _atm_dst_ptr +#undef _atm_copy_lev +#undef _atm_copy_3d + + !--- Dycore quantities + +#define _atm_src_dycore +#define _atm_dst_ptr datar82d + + ! bottom layer temperature (t) + case('inst_temp_height_lowest') +#define _atm_src_ptr coupling%t_bot +#include "gfs_data_copy.h" + + ! bottom layer specific humidity (q) + ! ! ! CHECK if tracer 1 is for specific humidity ! ! ! + case('inst_spec_humid_height_lowest') +#define _atm_src_ptr coupling%tr_bot +#define _atm_src_trac 1 +#include "gfs_data_copy.h" + + ! bottom layer zonal wind (u) + case('inst_zonal_wind_height_lowest') +#define _atm_src_ptr coupling%u_bot +#include "gfs_data_copy.h" + + ! bottom layer meridionalw wind (v) + case('inst_merid_wind_height_lowest') +#define _atm_src_ptr coupling%v_bot +#include "gfs_data_copy.h" + + ! bottom layer pressure (p) + case('inst_pres_height_lowest') +#define _atm_src_ptr coupling%p_bot +#include "gfs_data_copy.h" + + ! bottom layer height (z) + case('inst_height_lowest') +#define _atm_src_ptr coupling%z_bot +#include "gfs_data_copy.h" diff --git a/include/gfs_data_copy.h b/include/gfs_data_copy.h new file mode 100644 index 000000000..872c83b65 --- /dev/null +++ b/include/gfs_data_copy.h @@ -0,0 +1,84 @@ +#undef __atm_data_type +#if defined(_atm_src_gfs) +# define __atm_data_type GFS_data +#elif defined(_atm_src_dycore) +# define __atm_data_type DYCORE_data +#else +# define __atm_data_type GFS_data +#endif + +#undef __atm_data_src +#undef __atm_data_zero +#undef __beg_check_ptr +#undef __end_check_ptr +#if defined(_atm_src_ptr) +# define __atm_data_src(N) __atm_data_type(N)%_atm_src_ptr +# define __beg_check_ptr if (associated(__atm_data_src(nsb))) then +# define __end_check_ptr endif +# ifdef _atm_src_dycore +# define __atm_data_zero +# endif +#elif defined(_atm_src_array) +# define __atm_data_src(N) __atm_data_type(N)%_atm_src_array +# define __beg_check_ptr +# define __end_check_ptr +#endif + +#undef __atm_data_dst +#ifdef _atm_dst_ptr +# define __atm_data_dst _atm_dst_ptr +#endif + +#undef __atm_data_cnv +#ifdef _atm_src_cnv +# define __atm_data_cnv *_atm_src_cnv +#else +# define __atm_data_cnv +#endif + +#undef __lev +#ifdef _atm_copy_lev +# define __lev ,: +#else +# define __lev +#endif + +#undef __itrac +#ifdef _atm_src_trac +# define __itrac ,_atm_src_trac +#else +# define __itrac +#endif + +#if (defined(__atm_data_dst) && defined(__atm_data_src)) + __beg_check_ptr +!$omp parallel do default(shared) private(i,ib,ix,j,jb,nb) + do jb=jsc,jec + i = 0 + j = jb - jsc + 1 + do ib=isc,iec + nb = Atm_block%blkno(ib,jb) + ix = Atm_block%ixp(ib,jb) + i = i + 1 + __atm_data_dst(i,j __lev) = __atm_data_src(nb)(ix __lev __itrac)__atm_data_cnv + enddo + enddo +# ifdef __atm_data_zero + else +!$omp parallel do default(shared) private(i,ib,j,jb) + do jb=jsc,jec + i = 0 + j = jb - jsc + 1 + do ib=isc,iec + i = i + 1 + __atm_data_dst(i,j __lev) = zero + enddo + enddo +# endif + __end_check_ptr +#endif + +#undef _atm_src_array +#undef _atm_src_ptr +#undef _atm_src_trac +#undef _atm_copy_lev diff --git a/include/jedi_export_fields.h b/include/jedi_export_fields.h new file mode 100644 index 000000000..723a6166e --- /dev/null +++ b/include/jedi_export_fields.h @@ -0,0 +1,135 @@ +#undef _atm_src_dycore +#undef _atm_src_gfs +#undef _atm_src_array +#undef _atm_src_ptr +#undef _atm_src_trac +#undef _atm_dst_ptr +#undef _atm_src_cnv +#undef _atm_copy_lev +#undef _atm_copy_3d + + !--- JEDI fields + +#define _atm_dst_ptr datar83d +#define _atm_copy_3d + + case ('u') +#define _atm_src_ptr u +#include "atm_data_copy.h" + + case ('v') +#define _atm_src_ptr v +#include "atm_data_copy.h" + + case ('ua') +#define _atm_src_ptr ua +#include "atm_data_copy.h" + + case ('va') +#define _atm_src_ptr va +#include "atm_data_copy.h" + + case ('t') +#define _atm_src_ptr pt +#include "atm_data_copy.h" + + case ('delp') +#define _atm_src_ptr delp +#include "atm_data_copy.h" + +#define _atm_src_trac sphum + case ('sphum') + sphum = get_tracer_index(MODEL_ATMOS, 'sphum') +#define _atm_src_ptr q +#include "atm_data_copy.h" + +#define _atm_src_trac ice_wat + case ('ice_wat') + ice_wat = get_tracer_index(MODEL_ATMOS, 'ice_wat') +#define _atm_src_ptr q +#include "atm_data_copy.h" + +#define _atm_src_trac liq_wat + case ('liq_wat') + liq_wat = get_tracer_index(MODEL_ATMOS, 'liq_wat') +#define _atm_src_ptr q +#include "atm_data_copy.h" + +#define _atm_src_trac o3mr + case ('o3mr') + o3mr = get_tracer_index(MODEL_ATMOS, 'o3mr') +#define _atm_src_ptr q +#include "atm_data_copy.h" + +#undef _atm_copy_3d +#undef _atm_dst_ptr +#define _atm_dst_ptr datar82d + + case ('phis') +#define _atm_src_ptr phis +#include "atm_data_copy.h" + + case ('u_srf') +#define _atm_src_ptr u_srf +#include "atm_data_copy.h" + + case ('v_srf') +#define _atm_src_ptr v_srf +#include "atm_data_copy.h" + + case ('slmsk') +#define _atm_src_gfs +#define _atm_src_ptr sfcprop%slmsk +#include "gfs_data_copy.h" + + case ('weasd') +#define _atm_src_ptr sfcprop%weasd +#include "gfs_data_copy.h" + + case ('tsea') +#define _atm_src_ptr sfcprop%tsfco +#include "gfs_data_copy.h" + + case ('vtype') +#define _atm_src_ptr sfcprop%vtype +#include "gfs_data_copy.h" + + case ('stype') +#define _atm_src_ptr sfcprop%stype +#include "gfs_data_copy.h" + + case ('vfrac') +#define _atm_src_ptr sfcprop%vfrac +#include "gfs_data_copy.h" + +#undef _atm_dst_ptr +#define _atm_dst_ptr datar83d + + case ('stc') +#define _atm_src_ptr sfcprop%stc +#define _atm_copy_lev +#include "gfs_data_copy.h" + + case ('smc') +#define _atm_src_ptr sfcprop%smc +#define _atm_copy_lev +#include "gfs_data_copy.h" + +#undef _atm_dst_ptr +#define _atm_dst_ptr datar82d + + case ('snwdph') +#define _atm_src_ptr sfcprop%snowd +#include "gfs_data_copy.h" + + case ('f10m') +#define _atm_src_ptr sfcprop%f10m +#include "gfs_data_copy.h" + + case ('zorl') +#define _atm_src_ptr sfcprop%zorl +#include "gfs_data_copy.h" + + case ('t2m') +#define _atm_src_ptr sfcprop%t2m +#include "gfs_data_copy.h" diff --git a/include/physics_export_fields.h b/include/physics_export_fields.h new file mode 100644 index 000000000..edb82c04e --- /dev/null +++ b/include/physics_export_fields.h @@ -0,0 +1,239 @@ +#undef _atm_src_dycore +#undef _atm_src_gfs +#undef _atm_src_array +#undef _atm_src_ptr +#undef _atm_src_trac +#undef _atm_dst_ptr +#undef _atm_src_cnv +#undef _atm_copy_lev + + !--- Instantaneous quantities + +#define _atm_src_gfs +#define _atm_dst_ptr datar82d + + ! Instantaneous u wind (m/s) 10 m above ground + case ('inst_zonal_wind_height10m') +#define _atm_src_ptr coupling%u10mi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous v wind (m/s) 10 m above ground + case ('inst_merid_wind_height10m') +#define _atm_src_ptr coupling%v10mi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Zonal compt of momentum flux (N/m**2) + case ('inst_zonal_moment_flx') +#define _atm_src_ptr coupling%dusfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Merid compt of momentum flux (N/m**2) + case ('inst_merid_moment_flx') +#define _atm_src_ptr coupling%dvsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Sensible heat flux (W/m**2) + case ('inst_sensi_heat_flx') +#define _atm_src_ptr coupling%dtsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Latent heat flux (W/m**2) + case ('inst_laten_heat_flx') +#define _atm_src_ptr coupling%dqsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Downward long wave radiation flux (W/m**2) + case ('inst_down_lw_flx') +#define _atm_src_ptr coupling%dlwsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Downward solar radiation flux (W/m**2) + case ('inst_down_sw_flx') +#define _atm_src_ptr coupling%dswsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Temperature (K) 2 m above ground + case ('inst_temp_height2m') +#define _atm_src_ptr coupling%t2mi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Specific humidity (kg/kg) 2 m above ground + case ('inst_spec_humid_height2m') +#define _atm_src_ptr coupling%q2mi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Temperature (K) at surface + case ('inst_temp_height_surface') +#define _atm_src_ptr coupling%tsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Pressure (Pa) land and sea surface + case ('inst_pres_height_surface') +#define _atm_src_ptr coupling%psurfi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous Surface height (m) + case ('inst_surface_height') +#define _atm_src_ptr coupling%oro_cpl +#include "gfs_data_copy.h" + + ! Instantaneous NET long wave radiation flux (W/m**2) + case ('inst_net_lw_flx') +#define _atm_src_ptr coupling%nlwsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous NET solar radiation flux over the ocean (W/m**2) + case ('inst_net_sw_flx') +#define _atm_src_ptr coupling%nswsfci_cpl +#include "gfs_data_copy.h" + + ! Instantaneous sfc downward nir direct flux (W/m**2) + case ('inst_down_sw_ir_dir_flx') +#define _atm_src_ptr coupling%dnirbmi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous sfc downward nir diffused flux (W/m**2) + case ('inst_down_sw_ir_dif_flx') +#define _atm_src_ptr coupling%dnirdfi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous sfc downward uv+vis direct flux (W/m**2) + case ('inst_down_sw_vis_dir_flx') +#define _atm_src_ptr coupling%dvisbmi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous sfc downward uv+vis diffused flux (W/m**2) + case ('inst_down_sw_vis_dif_flx') +#define _atm_src_ptr coupling%dvisdfi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous net sfc nir direct flux (W/m**2) + case ('inst_net_sw_ir_dir_flx') +#define _atm_src_ptr coupling%nnirbmi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous net sfc nir diffused flux (W/m**2) + case ('inst_net_sw_ir_dif_flx') +#define _atm_src_ptr coupling%nnirdfi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous net sfc uv+vis direct flux (W/m**2) + case ('inst_net_sw_vis_dir_flx') +#define _atm_src_ptr coupling%nvisbmi_cpl +#include "gfs_data_copy.h" + + ! Instantaneous net sfc uv+vis diffused flux (W/m**2) + case ('inst_net_sw_vis_dif_flx') +#define _atm_src_ptr coupling%nvisdfi_cpl +#include "gfs_data_copy.h" + + ! Land/Sea mask (sea:0,land:1) + case ('inst_land_sea_mask') +#define _atm_src_ptr coupling%slmsk_cpl +#include "gfs_data_copy.h" + + !--- Mean quantities + +#define _atm_src_cnv rtime + + ! MEAN Zonal compt of momentum flux (N/m**2) + case ('mean_zonal_moment_flx_atm') +#define _atm_src_ptr coupling%dusfc_cpl +#include "gfs_data_copy.h" + + ! MEAN Merid compt of momentum flux (N/m**2) + case ('mean_merid_moment_flx_atm') +#define _atm_src_ptr coupling%dvsfc_cpl +#include "gfs_data_copy.h" + + ! MEAN Sensible heat flux (W/m**2) + case ('mean_sensi_heat_flx') +#define _atm_src_ptr coupling%dtsfc_cpl +#include "gfs_data_copy.h" + + ! MEAN Latent heat flux (W/m**2) + case ('mean_laten_heat_flx') +#define _atm_src_ptr coupling%dqsfc_cpl +#include "gfs_data_copy.h" + + ! MEAN Downward LW heat flux (W/m**2) + case ('mean_down_lw_flx') +#define _atm_src_ptr coupling%dlwsfc_cpl +#include "gfs_data_copy.h" + + ! MEAN Downward SW heat flux (W/m**2) + case ('mean_down_sw_flx') +#define _atm_src_ptr coupling%dswsfc_cpl +#include "gfs_data_copy.h" + + ! MEAN NET long wave radiation flux (W/m**2) + case ('mean_net_lw_flx') +#define _atm_src_ptr coupling%nlwsfc_cpl +#include "gfs_data_copy.h" + + ! MEAN NET solar radiation flux over the ocean (W/m**2) + case ('mean_net_sw_flx') +#define _atm_src_ptr coupling%nswsfc_cpl +#include "gfs_data_copy.h" + + ! MEAN sfc downward nir direct flux (W/m**2) + case ('mean_down_sw_ir_dir_flx') +#define _atm_src_ptr coupling%dnirbm_cpl +#include "gfs_data_copy.h" + + ! MEAN sfc downward nir diffused flux (W/m**2) + case ('mean_down_sw_ir_dif_flx') +#define _atm_src_ptr coupling%dnirdf_cpl +#include "gfs_data_copy.h" + + ! MEAN sfc downward uv+vis direct flux (W/m**2) + case ('mean_down_sw_vis_dir_flx') +#define _atm_src_ptr coupling%dvisbm_cpl +#include "gfs_data_copy.h" + + ! MEAN sfc downward uv+vis diffused flux (W/m**2) + case ('mean_down_sw_vis_dif_flx') +#define _atm_src_ptr coupling%dvisdf_cpl +#include "gfs_data_copy.h" + + ! MEAN NET sfc nir direct flux (W/m**2) + case ('mean_net_sw_ir_dir_flx') +#define _atm_src_ptr coupling%nnirbm_cpl +#include "gfs_data_copy.h" + + ! MEAN NET sfc nir diffused flux (W/m**2) + case ('mean_net_sw_ir_dif_flx') +#define _atm_src_ptr coupling%nnirdf_cpl +#include "gfs_data_copy.h" + + ! MEAN NET sfc uv+vis direct flux (W/m**2) + case ('mean_net_sw_vis_dir_flx') +#define _atm_src_ptr coupling%nvisbm_cpl +#include "gfs_data_copy.h" + + ! MEAN NET sfc uv+vis diffused flux (W/m**2) + case ('mean_net_sw_vis_dif_flx') +#define _atm_src_ptr coupling%nvisdf_cpl +#include "gfs_data_copy.h" + +#undef _atm_src_cnv +#define _atm_src_cnv rtimek + + ! MEAN precipitation rate (kg/m2/s) + case ('mean_prec_rate') +#define _atm_src_ptr coupling%rain_cpl +#include "gfs_data_copy.h" + + ! MEAN snow precipitation rate (kg/m2/s) + case ('mean_fprec_rate') +#define _atm_src_ptr coupling%snow_cpl +#include "gfs_data_copy.h" + + ! oceanfrac used by atm to calculate fluxes + case ('openwater_frac_in_atm') +#undef _atm_src_cnv +#define _atm_src_cnv (one-GFS_Data(nb)%sfcprop%fice(ix)) +#define _atm_src_ptr sfcprop%oceanfrac + if (associated(GFS_Data(nsb)%sfcprop%fice)) then +#include "gfs_data_copy.h" + endif