From 137694ab8c013ce8538fb0eb10faf7a2a91ff7b9 Mon Sep 17 00:00:00 2001 From: "jun.wang" Date: Mon, 16 Apr 2018 14:43:31 +0000 Subject: [PATCH] FV3: this commits #48158 Change-Id: Id2ec9435167bb7e51852adb4a2ea3ce2241cdce5 --- .../driver/fvGFS/atmosphere.F90 | 4 + atmos_model.F90 | 1002 ++++++++++++++++- cpl/makefile | 66 ++ cpl/module_cap_cpl.F90 | 285 +++++ cpl/module_cplfields.F90 | 182 +++ fv3_cap.F90 | 274 ++++- gfsphysics/GFS_layer/GFS_typedefs.F90 | 18 +- gfsphysics/makefile | 6 +- io/module_wrt_grid_comp.F90 | 26 +- makefile | 15 +- module_fcst_grid_comp.F90 | 65 +- module_fv3_config.F90 | 1 + 12 files changed, 1863 insertions(+), 81 deletions(-) create mode 100644 cpl/makefile create mode 100644 cpl/module_cap_cpl.F90 create mode 100644 cpl/module_cplfields.F90 diff --git a/atmos_cubed_sphere/driver/fvGFS/atmosphere.F90 b/atmos_cubed_sphere/driver/fvGFS/atmosphere.F90 index f0132cbb1..7e435c189 100644 --- a/atmos_cubed_sphere/driver/fvGFS/atmosphere.F90 +++ b/atmos_cubed_sphere/driver/fvGFS/atmosphere.F90 @@ -968,9 +968,11 @@ subroutine get_bottom_mass ( t_bot, tr_bot, p_bot, z_bot, p_surf, slp ) ! returns temp, sphum, pres, height at the lowest model level ! and surface pressure !-------------------------------------------------------------- + !--- interface variables --- real, intent(out), dimension(isc:iec,jsc:jec):: t_bot, p_bot, z_bot, p_surf real, intent(out), optional, dimension(isc:iec,jsc:jec):: slp real, intent(out), dimension(isc:iec,jsc:jec,nq):: tr_bot + !--- local variables --- integer :: i, j, m, k, kr real :: rrg, sigtop, sigbot real, dimension(isc:iec,jsc:jec) :: tref @@ -1025,7 +1027,9 @@ subroutine get_bottom_wind ( u_bot, v_bot ) !----------------------------------------------------------- ! returns u and v on the mass grid at the lowest model level !----------------------------------------------------------- + !--- interface variables --- real, intent(out), dimension(isc:iec,jsc:jec):: u_bot, v_bot + !--- local variables --- integer i, j do j=jsc,jec diff --git a/atmos_model.F90 b/atmos_model.F90 index 3cb2b87cc..a5837e2e8 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -75,9 +75,11 @@ module atmos_model_mod !rab use atmosphere_mod, only: atmosphere_tracer_postinit use atmosphere_mod, only: atmosphere_diss_est, atmosphere_nggps_diag use atmosphere_mod, only: atmosphere_scalar_field_halo +use atmosphere_mod, only: atmosphere_get_bottom_layer use atmosphere_mod, only: set_atmosphere_pelist use atmosphere_mod, only: Atm, mytile use block_control_mod, only: block_control_type, define_blocks_packed +use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type use IPD_typedefs, only: IPD_init_type, IPD_control_type, & IPD_data_type, IPD_diag_type, & IPD_restart_type, IPD_kind_phys, & @@ -100,6 +102,7 @@ module atmos_model_mod public update_atmos_model_dynamics public atmos_model_init, atmos_model_end, atmos_data_type public atmos_model_restart +public addLsmask2grid !----------------------------------------------------------------------- ! @@ -142,6 +145,12 @@ module atmos_model_mod type (time_type) :: diag_time !--- concurrent and decoupled radiation and physics variables +!------------------- +! DYCORE containers +!------------------- +type(DYCORE_data_type), allocatable :: DYCORE_Data(:) ! number of blocks +type(DYCORE_diag_type) :: DYCORE_Diag(25) + !---------------- ! IPD containers !---------------- @@ -150,7 +159,9 @@ module atmos_model_mod type(IPD_diag_type), target :: IPD_Diag(DIAG_SIZE) type(IPD_restart_type) :: IPD_Restart +!-------------- ! IAU container +!-------------- type(iau_external_data_type) :: IAU_Data ! number of blocks !----------------- @@ -191,10 +202,9 @@ subroutine update_atmos_radiation_physics (Atmos) !----------------------------------------------------------------------- type (atmos_data_type), intent(in) :: Atmos !--- local variables--- - integer :: nb, jdat(8) + integer :: nb, jdat(8), rc procedure(IPD_func0d_proc), pointer :: Func0d => NULL() procedure(IPD_func1d_proc), pointer :: Func1d => NULL() - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "statein driver" !--- get atmospheric state from the dynamic core call set_atmosphere_pelist() @@ -219,10 +229,21 @@ subroutine update_atmos_radiation_physics (Atmos) call get_date (Atmos%Time, jdat(1), jdat(2), jdat(3), & jdat(5), jdat(6), jdat(7)) IPD_Control%jdat(:) = jdat(:) + !--- execute the IPD atmospheric setup step call mpp_clock_begin(setupClock) Func1d => time_vary_step call IPD_step (IPD_Control, IPD_Data(:), IPD_Diag, IPD_Restart, IPD_func1d=Func1d) +!--- if coupled, assign coupled fields + if( IPD_Control%cplflx ) then +! print *,'in atmos_model,nblks=',Atm_block%nblks +! print *,'in atmos_model,IPD_Data size=',size(IPD_Data) +! print *,'in atmos_model,tsfc(1)=',IPD_Data(1)%sfcprop%tsfc(1) +! print *,'in atmos_model, tsfc size=',size(IPD_Data(1)%sfcprop%tsfc) + call assign_importdata(rc) +! print *,'in atmos_model, after assign_importdata, rc=',rc + endif + call mpp_clock_end(setupClock) if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "radiation driver" @@ -376,6 +397,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call define_blocks_packed ('atmos_model', Atm_block, isc, iec, jsc, jec, nlev, & blocksize, block_message) + allocate(DYCORE_Data(Atm_block%nblks)) allocate(IPD_Data(Atm_block%nblks)) !--- update IPD_Control%jdat(8) @@ -532,8 +554,9 @@ subroutine update_atmos_model_state (Atmos) type (atmos_data_type), intent(inout) :: Atmos !--- local variables integer :: isec,seconds + integer :: rc real(kind=IPD_kind_phys) :: time_int, time_intfull - +! call set_atmosphere_pelist() call mpp_clock_begin(fv3Clock) call mpp_clock_begin(updClock) @@ -543,10 +566,11 @@ subroutine update_atmos_model_state (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'UPDATE STATE ', IPD_Control%kdt, IPD_Control%fhour + if (mpp_pe() == mpp_root_pe()) print *,'in UPDATE STATE ', size(IPD_Data(1)%SfcProp%tsfc),'nblks=',Atm_block%nblks call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) endif -!------ advance time ------ + !--- advance time --- Atmos % Time = Atmos % Time + Atmos % Time_step call get_time (Atmos%Time - diag_time, isec) @@ -563,6 +587,19 @@ subroutine update_atmos_model_state (Atmos) call diag_send_complete_instant (Atmos%Time) endif + !--- this may not be necessary once write_component is fully implemented + !!!call diag_send_complete_extra (Atmos%Time) + + !--- get bottom layer data from dynamical core for coupling + call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data) + + !if in coupled mode, set up coupled fields + if (IPD_Control%cplflx) then + print *,'COUPLING: IPD layer' +!jw call setup_exportdata(IPD_Control, IPD_Data, Atm_block) + call setup_exportdata(rc) + endif + end subroutine update_atmos_model_state ! @@ -686,4 +723,961 @@ subroutine dealloc_atmos_data_type (Atmos) Atmos%lat ) end subroutine dealloc_atmos_data_type + subroutine assign_importdata(rc) + + use module_cplfields, only: importFields, nImportFields + use ESMF +! + implicit none + integer, intent(out) :: rc + + !--- local variables + integer :: n, j, i, ix, nb, isc, iec, jsc, jec, dimCount + character(len=128) :: impfield_name, fldname + type(ESMF_TypeKind_Flag) :: datatype + real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d + real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d + real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8 + logical found +! +!------------------------------------------------------------------------------ +! + ! set up local dimension + rc=-999 + isc = IPD_control%isc + iec = IPD_control%isc+IPD_control%nx-1 + jsc = IPD_control%jsc + jec = IPD_control%jsc+IPD_control%ny-1 + + allocate(datar8(isc:iec,jsc:jec)) + print *,'in cplImp,dim=',isc,iec,jsc,jec + print *,'in cplImp,IPD_Data, size', size(IPD_Data) + print *,'in cplImp,tsfc, size', size(IPD_Data(1)%sfcprop%tsfc) + + do n=1,nImportFields + + ! Each import field is only available if it was connected in the + ! import state. + found = .false. + if (ESMF_FieldIsCreated(importFields(n))) then + + ! put the data from local cubed sphere grid to column grid for phys + datar8 = -99999.0 + call ESMF_FieldGet(importFields(n), dimCount=dimCount ,typekind=datatype, & + name=impfield_name, rc=rc) + if ( dimCount == 2) then + if ( datatype == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(importFields(n),farrayPtr=datar82d,localDE=0, rc=rc) + datar8=datar82d + print *,'in cplIMP, get sst, datar8=',maxval(datar8),minval(datar8), & + datar8(isc,jsc) + found = .true. +! gfs physics runs with r8 +! else +! call ESMF_FieldGet(importFields(n),farrayPtr=datar42d,localDE=0, +! rc=rc) +! datar8=datar42d + endif + endif +! + ! get sea land mask: in order to update the coupling fields over the ocean/ice + fldname = 'land_mask' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%slimskin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get surface temperature: update ice temperature for atm ??? can SST be applied here??? + fldname = 'surface_temperature' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get sst: sst needs to be adjusted by land sea mask before passing to + ! fv3 + fldname = 'sea_surface_temperature' + if (trim(impfield_name) == trim(fldname) .and. found) then +! + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) +! if (Sfcprop%slimskin(i,j) < 3.1 .and. Sfcprop%slimskin(i,j) > 2.9) then +! if (Sfcprop%slmsk(i,j) < 0.1 .or. Sfcprop%slmsk(i,j) > 1.9) then + IPD_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) +! IPD_Data(nb)%Sfcprop%tsfc(ix) = datar8(i,j) +! endif +! endif + enddo + enddo + endif + + ! get sea ice fraction: fice or sea ice concentration from the mediator + fldname = 'ice_fraction' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%ficein_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get upward LW flux: for sea ice covered area + fldname = 'mean_up_lw_flx' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%ulwsfcin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get latent heat flux: for sea ice covered area + fldname = 'mean_laten_heat_flx' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%dqsfcin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get sensible heat flux: for sea ice covered area + fldname = 'mean_sensi_heat_flx' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get zonal compt of momentum flux: for sea ice covered area + fldname = 'mean_zonal_moment_flx' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%dusfcin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get meridional compt of momentum flux: for sea ice covered area + fldname = 'mean_merid_moment_flx' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%dvsfcin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get sea ice volume: for sea ice covered area + fldname = 'mean_ice_volume' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + ! get snow volume: for sea ice covered area + fldname = 'mean_snow_volume' + if (trim(impfield_name) == trim(fldname) .and. found) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = datar8(i,j) + enddo + enddo + endif + + endif + enddo + + deallocate(datar8) + rc=0 +! + print *,'end of assign_importdata' + end subroutine assign_importdata + +! + subroutine setup_exportdata (rc) + + use module_cplfields, only: exportData, nExportFields, exportFieldsList, & + queryFieldList, fillExportFields + + implicit none + +!------------------------------------------------------------------------------ + + !--- interface variables + integer, intent(out) :: rc + + !--- local variables + integer :: j, i, ix, nb, isc, iec, jsc, jec, idx + real(IPD_kind_phys) :: rtime +! + print *,'enter setup_exportdata' + + isc = IPD_control%isc + iec = IPD_control%isc+IPD_control%nx-1 + jsc = IPD_control%jsc + jec = IPD_control%jsc+IPD_control%ny-1 + + rtime = 1./IPD_control%dtp +! print *,'in cplExp,dim=',isc,iec,jsc,jec,'nExportFields=',nExportFields +! print *,'in cplExp,IPD_Data, size', size(IPD_Data) +! print *,'in cplExp,u10micpl, size', size(IPD_Data(1)%coupling%u10mi_cpl) + + if(.not.allocated(exportData)) then + allocate(exportData(isc:iec,jsc:jec,nExportFields)) + endif + + ! set cpl fields to export Data + ! MEAN Zonal compt of momentum flux (N/m**2) + idx = queryfieldlist(exportFieldsList,'mean_zonal_moment_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dusfc_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN Merid compt of momentum flux (N/m**2) + idx = queryfieldlist(exportFieldsList,'mean_merid_moment_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dvsfc_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN Sensible heat flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_sensi_heat_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dtsfc_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN Latent heat flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_laten_heat_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dqsfc_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN Downward LW heat flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_down_lw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dlwsfc_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN Downward SW heat flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_down_sw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dswsfc_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN precipitation rate (kg/m2) ?????? checking unit ?????? + idx = queryfieldlist(exportFieldsList,'mean_prec_rate') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%rain_cpl(ix) * rtime + enddo + enddo + endif + + ! Instataneous Zonal compt of momentum flux (N/m**2) + idx = queryfieldlist(exportFieldsList,'inst_zonal_moment_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dusfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous Merid compt of momentum flux (N/m**2) + idx = queryfieldlist(exportFieldsList,'inst_merid_moment_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dvsfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous Sensible heat flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_sensi_heat_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dtsfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous Latent heat flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_laten_heat_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dqsfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous Downward long wave radiation flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_down_lw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dlwsfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous Downward solar radiation flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_down_sw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dswsfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous Temperature (K) 2 m above ground + idx = queryfieldlist(exportFieldsList,'inst_temp_height2m') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%t2mi_cpl(ix) + enddo + enddo + endif + + ! Instataneous Specific humidity (kg/kg) 2 m above ground + idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height2m') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%q2mi_cpl(ix) + enddo + enddo + endif + + ! Instataneous u wind (m/s) 10 m above ground + idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height10m') + if (idx > 0 ) then + print *,'cpl, in get u10mi_cpl' + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) +! if(i==isc.and.j==jsc) then +! print *,'in cpl exp, nb=',nb,'ix=',ix,'idx=',idx +! print *,'in cpl exp, u10mi_cpl=',IPD_Data(nb)%coupling%u10mi_cpl(ix) +! endif + exportData(i,j,idx) = IPD_Data(nb)%coupling%u10mi_cpl(ix) + enddo + enddo +! print *,'cpl, get u10mi_cpl, exportData=',exportData(isc,jsc,idx),'idx=',idx + endif + + ! Instataneous v wind (m/s) 10 m above ground + idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height10m') + if (idx > 0 ) then + print *,'cpl, in get v10mi_cpl' + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%v10mi_cpl(ix) + enddo + enddo + print *,'cpl, get v10mi_cpl, exportData=',exportData(isc,jsc,idx),'idx=',idx + endif + + ! Instataneous Temperature (K) at surface + idx = queryfieldlist(exportFieldsList,'inst_temp_height_surface') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%tsfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous Pressure (Pa) land and sea surface + idx = queryfieldlist(exportFieldsList,'inst_pres_height_surface') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%psurfi_cpl(ix) + enddo + enddo + endif + + ! Instataneous Surface height (m) + idx = queryfieldlist(exportFieldsList,'inst_surface_height') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%oro_cpl(ix) + enddo + enddo + endif + + ! MEAN NET long wave radiation flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_net_lw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nlwsfc_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN NET solar radiation flux over the ocean (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_net_sw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nswsfc_cpl(ix) * rtime + enddo + enddo + endif + + ! Instataneous NET long wave radiation flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_net_lw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nlwsfci_cpl(ix) + enddo + enddo + endif + + ! Instataneous NET solar radiation flux over the ocean (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_net_sw_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nswsfci_cpl(ix) + enddo + enddo + endif + + ! MEAN sfc downward nir direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirbm_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN sfc downward nir diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirdf_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN sfc downward uv+vis direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisbm_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN sfc downward uv+vis diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisdf_cpl(ix) * rtime + enddo + enddo + endif + + ! Instataneous sfc downward nir direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirbmi_cpl(ix) + enddo + enddo + endif + + ! Instataneous sfc downward nir diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirdfi_cpl(ix) + enddo + enddo + endif + + ! Instataneous sfc downward uv+vis direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisbmi_cpl(ix) + enddo + enddo + endif + + ! Instataneous sfc downward uv+vis diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisdfi_cpl(ix) + enddo + enddo + endif + + ! MEAN NET sfc nir direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirbm_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN NET sfc nir diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirdf_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN NET sfc uv+vis direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisbm_cpl(ix) * rtime + enddo + enddo + endif + + ! MEAN NET sfc uv+vis diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisdf_cpl(ix) * rtime + enddo + enddo + endif + + ! Instataneous net sfc nir direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirbmi_cpl(ix) + enddo + enddo + endif + + ! Instataneous net sfc nir diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirdfi_cpl(ix) + enddo + enddo + endif + + ! Instataneous net sfc uv+vis direct flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dir_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisbmi_cpl(ix) + enddo + enddo + endif + + ! Instataneous net sfc uv+vis diffused flux (W/m**2) + idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dif_flx') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisdfi_cpl(ix) + enddo + enddo + endif + + ! Land/Sea mask (sea:0,land:1) + idx = queryfieldlist(exportFieldsList,'inst_land_sea_mask') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%slmsk_cpl(ix) + enddo + enddo + endif + +! Data from DYCORE: + + ! bottom layer temperature (t) + idx = queryfieldlist(exportFieldsList,'inst_temp_height_lowest') + if (idx > 0 ) then + 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 + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%t_bot(ix) + else + exportData(i,j,idx) = 0.0 + endif + enddo + enddo + endif + + ! bottom layer specific humidity (q) + !!! CHECK if tracer 1 is for specific humidity !!! + idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height_lowest') + if (idx > 0 ) then + 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 + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%tr_bot(ix,1) + else + exportData(i,j,idx)=0.0 + endif + enddo + enddo + endif + + ! bottom layer zonal wind (u) + idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height_lowest') + if (idx > 0 ) then + 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 + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%u_bot(ix) + else + exportData(i,j,idx) = 0.0 + endif + enddo + enddo + endif + + ! bottom layer meridionalw wind (v) + idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height_lowest') + if (idx > 0 ) then + 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 + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%v_bot(ix) + else + exportData(i,j,idx) = 0.0 + endif + enddo + enddo + endif + + ! bottom layer pressure (p) + idx = queryfieldlist(exportFieldsList,'inst_pres_height_lowest') + if (idx > 0 ) then + 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 + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%p_bot(ix) + else + exportData(i,j,idx) = 0.0 + endif + enddo + enddo + endif + + ! bottom layer height (z) + idx = queryfieldlist(exportFieldsList,'inst_height_lowest') + if (idx > 0 ) then + 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 + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%z_bot(ix) + else + exportData(i,j,idx) = 0.0 + endif + enddo + enddo + endif + +! END Data from DYCORE. + + ! MEAN snow precipitation rate (kg/m2) ?????? checking unit ?????? + idx = queryfieldlist(exportFieldsList,'mean_fprec_rate') + if (idx > 0 ) then + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = IPD_Data(nb)%coupling%snow_cpl(ix) * rtime + enddo + enddo + endif + +!--- + ! Fill the export Fields for ESMF/NUOPC style coupling + call fillExportFields(exportData,rc) + +!--- + ! zero out accumulated fields + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%coupling%dusfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%dvsfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%dtsfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%dqsfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%dlwsfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%dswsfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%rain_cpl(ix) = 0. + IPD_Data(nb)%coupling%nlwsfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%nswsfc_cpl(ix) = 0. + IPD_Data(nb)%coupling%dnirbm_cpl(ix) = 0. + IPD_Data(nb)%coupling%dnirdf_cpl(ix) = 0. + IPD_Data(nb)%coupling%dvisbm_cpl(ix) = 0. + IPD_Data(nb)%coupling%dvisdf_cpl(ix) = 0. + IPD_Data(nb)%coupling%nnirbm_cpl(ix) = 0. + IPD_Data(nb)%coupling%nnirdf_cpl(ix) = 0. + IPD_Data(nb)%coupling%nvisbm_cpl(ix) = 0. + IPD_Data(nb)%coupling%nvisdf_cpl(ix) = 0. + IPD_Data(nb)%coupling%snow_cpl(ix) = 0. + enddo + enddo + print *,'end of setup_exportdata' + + end subroutine setup_exportdata + + subroutine addLsmask2grid(fcstgrid, rc) + + use ESMF +! + implicit none + type(ESMF_Grid) :: fcstgrid + integer, optional, intent(out) :: rc +! +! local vars + integer isc, iec, jsc, jec + integer i, j, nb, ix +! integer CLbnd(2), CUbnd(2), CCount(2), TLbnd(2), TUbnd(2), TCount(2) + type(ESMF_StaggerLoc) :: staggerloc + integer, allocatable :: lsmask(:,:) + integer(kind=ESMF_KIND_I4), pointer :: maskPtr(:,:) +! + isc = IPD_control%isc + iec = IPD_control%isc+IPD_control%nx-1 + jsc = IPD_control%jsc + jec = IPD_control%jsc+IPD_control%ny-1 + allocate(lsmask(isc:iec,jsc:jec)) +! + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + lsmask(i,j) = IPD_Data(nb)%SfcProp%slmsk(ix) + enddo + enddo +! +! Get mask + call ESMF_GridAddItem(fcstgrid, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +! call ESMF_GridGetItemBounds(fcstgrid, itemflag=ESMF_GRIDITEM_MASK, & +! staggerloc=ESMF_STAGGERLOC_CENTER, computationalLBound=ClBnd, & +! computationalUBound=CUbnd, computationalCount=Ccount, & +! totalLBound=TLbnd, totalUBound=TUbnd, totalCount=Tcount, rc=rc) +! print *,'in set up grid, aft add esmfgridadd item mask, rc=',rc, & +! 'ClBnd=',ClBnd,'CUbnd=',CUbnd,'Ccount=',Ccount, & +! 'TlBnd=',TlBnd,'TUbnd=',TUbnd,'Tcount=',Tcount +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + + call ESMF_GridGetItem(fcstgrid, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER,farrayPtr=maskPtr, rc=rc) +! print *,'in set up grid, aft get maskptr, rc=',rc, 'size=',size(maskPtr,1),size(maskPtr,2), & +! 'bound(maskPtr)=', LBOUND(maskPtr,1),LBOUND(maskPtr,2),UBOUND(maskPtr,1),UBOUND(maskPtr,2) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! + do j=jsc,jec + do i=isc,iec + maskPtr(i-isc+1,j-jsc+1) = lsmask(i,j) + enddo + enddo +! print *,'in set set lsmask, maskPtr=', maxval(maskPtr), minval(maskPtr) +! + deallocate(lsmask) + + end subroutine addLsmask2grid +!------------------------------------------------------------------------------ + end module atmos_model_mod diff --git a/cpl/makefile b/cpl/makefile new file mode 100644 index 000000000..04e4c8762 --- /dev/null +++ b/cpl/makefile @@ -0,0 +1,66 @@ +SHELL = /bin/sh + +inside_nems := $(wildcard ../../../conf/configure.nems) +ifneq ($(strip $(inside_nems)),) + include ../../../conf/configure.nems +else + exist_configure_fv3 := $(wildcard ../conf/configure.fv3) + ifneq ($(strip $(exist_configure_fv3)),) + include ../conf/configure.fv3 + else + $(error "../conf/configure.fv3 file is missing. Run ./configure") + endif + $(info ) + $(info Build standalone FV3 io ...) + $(info ) +endif + +LIBRARY = libfv3cpl.a + +#FFLAGS += -I../fms + +SRCS_f = + +SRCS_f90 = + +SRCS_F = + +SRCS_F90 = ./module_cplfields.F90 \ + ./module_cap_cpl.F90 + +SRCS_c = + +DEPEND_FILES = $(SRCS_f) $(SRCS_f90) $(SRCS_F) $(SRCS_F90) + +OBJS_f = $(SRCS_f:.f=.o) +OBJS_f90 = $(SRCS_f90:.f90=.o) +OBJS_F = $(SRCS_F:.F=.o) +OBJS_F90 = $(SRCS_F90:.F90=.o) +OBJS_c = $(SRCS_c:.c=.o) + +OBJS = $(OBJS_f) $(OBJS_f90) $(OBJS_F) $(OBJS_F90) $(OBJS_c) + +all default: depend $(LIBRARY) + +$(LIBRARY): $(OBJS) + $(AR) $(ARFLAGS) $@ $? + +module_cplfields.o: module_cplfields.F90 + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) -c module_cplfields.F90 +module_cap_cpl.o: module_cap_cpl.F90 + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) -c module_cap_cpl.F90 + +.PHONY: clean +clean: + @echo "Cleaning io ... " + @echo + $(RM) -f $(LIBRARY) *.o *.mod *.lst *.i depend + +MKDEPENDS = ../mkDepends.pl +include ../conf/make.rules + +# do not include 'depend' file if the target contains string 'clean' +ifneq (clean,$(findstring clean,$(MAKECMDGOALS))) + -include depend +endif + diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 new file mode 100644 index 000000000..6283a51eb --- /dev/null +++ b/cpl/module_cap_cpl.F90 @@ -0,0 +1,285 @@ +module module_cap_cpl +! +!*** this module contains the debug subroutines for fv3 coupled run +! +! revision history +! 12 Mar 2018: J. Wang Pull coupled subroutines from fv3_cap.F90 to this module +! + use esmf + use NUOPC +! + implicit none + private + public clock_cplIntval + public realizeConnectedInternCplField + public Dump_cplFields +! + contains + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + + subroutine clock_cplIntval(gcomp, CF) + + type(ESMF_GridComp) :: gcomp + type(ESMF_Config) :: CF +! + real(ESMF_KIND_R8) :: medAtmCouplingIntervalSec + type(ESMF_Clock) :: fv3Clock + type(ESMF_TimeInterval) :: fv3Step + integer :: rc +! + call ESMF_ConfigGetAttribute(config=CF, value=medAtmCouplingIntervalSec, & + label="atm_coupling_interval_sec:", default=-1.0_ESMF_KIND_R8, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + if (medAtmCouplingIntervalSec>0._ESMF_KIND_R8) then + ! The coupling time step was provided + call ESMF_TimeIntervalSet(fv3Step, s_r8=medAtmCouplingIntervalSec, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_GridCompGet(gcomp, clock=fv3Clock, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_ClockSet(fv3Clock, timestep=fv3Step, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + + end subroutine clock_cplIntval + + !----------------------------------------------------------------------------- + + subroutine realizeConnectedInternCplField(state, field, standardName, grid, rc) + + type(ESMF_State) :: state + type(ESMF_Field), optional :: field + character(len=*), optional :: standardName + type(ESMF_Grid), optional :: grid + integer, intent(out), optional :: rc + + ! local variables + character(len=80) :: fieldName + type(ESMF_ArraySpec) :: arrayspec + integer :: i + real(ESMF_KIND_R8), pointer :: fptr(:,:) + + if (present(rc)) rc = ESMF_SUCCESS + + fieldName = standardName ! use standard name as field name + + !! Create fields using wam2dmesh if they are WAM fields + if (NUOPC_IsConnected(state, fieldName=fieldName)) then + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=fieldName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + fptr=0.d0 ! zero out the entire field + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/fieldName/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + end subroutine realizeConnectedInternCplField + + !----------------------------------------------------------------------------- + + subroutine Dump_cplFields(gcomp, importState, exportstate, clock_fv3, & + statewrite_flag, timeslice) + + type(ESMF_GridComp), intent(in) :: gcomp + type(ESMF_State) :: importState, exportstate + type(ESMF_Clock),intent(in) :: clock_fv3 + logical, intent(in) :: statewrite_flag + integer :: timeslice +! + character(len=160) :: nuopcMsg + integer :: rc +! + call ESMF_ClockPrint(clock_fv3, options="currTime", & + preString="leaving FV3_ADVANCE with clock_fv3 current: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="startTime", & + preString="leaving FV3_ADVANCE with clock_fv3 start: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="stopTime", & + preString="leaving FV3_ADVANCE with clock_fv3 stop: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + + ! Dumping Fields out + if (statewrite_flag) then + timeslice = timeslice + 1 + call ESMF_GridCompGet(gcomp, importState=importState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMFPP_RegridWriteState(importState, "fv3_cap_import_", timeslice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridCompGet(gcomp, exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMFPP_RegridWriteState(exportState, "fv3_cap_export_", timeslice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif +! + end subroutine Dump_cplFields + + !----------------------------------------------------------------------------- + + subroutine ESMFPP_RegridWriteState(state, fileName, timeslice, rc) + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: fileName + integer, intent(in) :: timeslice + integer, intent(out) :: rc + + ! local + type(ESMF_Field) :: field + type(ESMF_Grid) :: outGrid + integer :: i, icount + character(64), allocatable :: itemNameList(:) + type(ESMF_StateItem_Flag), allocatable :: typeList(:) + + rc = ESMF_SUCCESS + + outGrid = ESMF_GridCreate1PeriDimUfrm( maxIndex=(/180,360/), & + minCornerCoord=(/0.0_ESMF_KIND_R8,-90.0_ESMF_KIND_R8/), & + maxCornerCoord=(/360.0_ESMF_KIND_R8,90.0_ESMF_KIND_R8/), & + staggerLocList=(/ESMF_STAGGERLOC_CORNER, ESMF_STAGGERLOC_CENTER/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_StateGet(state, itemCount=icount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(typeList(icount), itemNameList(icount)) + call ESMF_StateGet(state, itemTypeList=typeList, itemNameList=itemNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do i = 1, icount + if(typeList(i) == ESMF_STATEITEM_FIELD) then + call ESMF_LogWrite("RegridWrite Field Name Initiated: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) + call ESMF_StateGet(state, itemName=itemNameList(i), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMFPP_RegridWrite(field, outGrid, ESMF_REGRIDMETHOD_BILINEAR, & + fileName//trim(itemNameList(i))//'.nc', trim(itemNameList(i)), timeslice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite("RegridWrite Field Name done: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) + endif + enddo + + deallocate(typeList, itemNameList) + + end subroutine ESMFPP_RegridWriteState + + subroutine ESMFPP_RegridWrite(inField, outGrid, regridMethod, fileName, fieldName, timeslice, rc) + + ! input arguments + type(ESMF_Field), intent(in) :: inField + type(ESMF_Grid), intent(in) :: outGrid + type(ESMF_RegridMethod_Flag), intent(in) :: regridMethod + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: fieldName + integer, intent(in) :: timeslice + integer, intent(inout) :: rc + + ! local arguments + type(ESMF_Routehandle) :: rh + type(ESMF_Field) :: outField + + outField = ESMF_FieldCreate(outGrid, typekind=ESMF_TYPEKIND_R8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! For other options for the regrid operation, please refer to: + ! http://www.earthsystemmodeling.org/esmf_releases/last_built/ESMF_refdoc/node5.html#SECTION050366000000000000000 + call ESMF_FieldRegridStore(inField, outField, regridMethod=regridMethod, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + Routehandle=rh, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldRegrid(inField, outField, Routehandle=rh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldWrite(outField, fileName, variableName=fieldName, timeslice=timeslice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + rc = ESMF_SUCCESS + + end subroutine ESMFPP_RegridWrite + + + !----------------------------------------------------------------------------- + +end module module_cap_cpl diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 new file mode 100644 index 000000000..4f1ecb9f6 --- /dev/null +++ b/cpl/module_cplfields.F90 @@ -0,0 +1,182 @@ +module module_cplfields + + !----------------------------------------------------------------------------- + ! This module contains the fv3 Coupling Fields: export and import + ! + !----------------------------------------------------------------------------- + + use ESMF + 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 " & + /) + +! 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 " & + /) + + ! Methods + public fillExportFields + public queryFieldList + +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- + + subroutine fillExportFields(data_a2oi, rc) + ! Fill updated data into the export Fields. + real(kind=8), target, intent(in) :: data_a2oi(:,:,:) + integer, intent(out), optional :: rc + + integer :: n,dimCount + type(ESMF_TypeKind_Flag) :: datatype + real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d + real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d + +! + if (present(rc)) rc=ESMF_SUCCESS + + do n=1, size(exportFields) + if (ESMF_FieldIsCreated(exportFields(n))) then +! set data + call ESMF_FieldGet(exportFields(n), dimCount=dimCount ,typekind=datatype, rc=rc) + if ( datatype == ESMF_TYPEKIND_R8) then + if ( dimCount == 2) then + call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=rc) + 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) + datar42d=data_a2oi(:,:,n) + endif + endif + endif + enddo + end subroutine fillExportFields +! +!------------------------------------------------------------------------------ +! + integer function queryFieldList(fieldlist, fieldname, abortflag, rc) + ! returns integer index of first found fieldname in fieldlist + ! by default, will abort if field not found, set abortflag to false + ! to turn off the abort. + ! return value of < 1 means the field was not found + + character(len=*),intent(in) :: fieldlist(:) + character(len=*),intent(in) :: fieldname + logical, optional :: abortflag + integer, optional :: rc + + integer :: n + logical :: labort + + labort = .true. + if (present(abortflag)) then + labort = abortflag + endif + + queryFieldList = 0 + n = 1 + do while (queryFieldList < 1 .and. n <= size(fieldlist)) + if (trim(fieldlist(n)) == trim(fieldname)) then + queryFieldList = n + else + n = n + 1 + endif + enddo + + if (labort .and. queryFieldList < 1) then + call ESMF_LogWrite('queryFieldList ABORT on fieldname '//trim(fieldname), & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) + CALL ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + end function queryFieldList +! +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + end module module_cplfields diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 9301d935f..308966434 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -7,6 +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 ! 02 Nov 2017: J. Wang Use Gerhard's transferable RouteHandle ! @@ -14,28 +15,37 @@ module fv3gfs_cap_mod use ESMF use NUOPC - use NUOPC_Model, only: model_routine_SS => SetServices, & - model_label_Advance => label_Advance,& - model_label_Finalize => label_Finalize -! - use module_fv3_config, only: quilting, restart_interval, & - nfhout, nfhout_hf, nsout, dt_atmos, & - nfhmax, nfhmax_hf,output_hfmax, & - output_interval,output_interval_hf, & - alarm_output_hf, alarm_output, & - calendar, calendar_type, & - force_date_from_configure - use module_fv3_io_def, only: num_pes_fcst,write_groups, & - num_files, filename_base, & - wrttasks_per_group, n_group, & - lead_wrttask, last_wrttask, & - output_grid, output_file, & - imo, jmo, write_nemsioflip, & - write_fsyncflag -! - use module_fcst_grid_comp, only: fcstSS => SetServices + use NUOPC_Model, only: model_routine_SS => SetServices, & + model_label_Advance => label_Advance,& + model_label_CheckImport => label_CheckImport, & + model_label_Finalize => label_Finalize +! + use module_fv3_config, only: quilting, restart_interval, & + nfhout, nfhout_hf, nsout, dt_atmos, & + nfhmax, nfhmax_hf,output_hfmax, & + output_interval,output_interval_hf, & + alarm_output_hf, alarm_output, & + calendar, calendar_type, cpl, & + force_date_from_configure, & + cplprint_flag + use module_fv3_io_def, only: num_pes_fcst,write_groups, & + num_files, filename_base, & + wrttasks_per_group, n_group, & + lead_wrttask, last_wrttask, & + output_grid, output_file, & + imo, jmo, write_nemsioflip, & + write_fsyncflag +! + use module_fcst_grid_comp, only: fcstSS => SetServices, fcstGrid use module_wrt_grid_comp, only: wrtSS => SetServices ! + use module_cplfields, only: nExportFields, exportFields, & + exportFieldsList,importFieldsList, & + nImportFields, importFields + use module_cap_cpl, only: realizeConnectedInternCplField, & + clock_cplIntval, Dump_cplFields + + implicit none private public SetServices @@ -60,6 +70,10 @@ module fv3gfs_cap_mod logical :: profile_memory = .true. + character(len=160) :: nuopcMsg + integer :: timeslice = 0 + + !----------------------------------------------------------------------- contains @@ -93,13 +107,14 @@ subroutine SetServices(gcomp, rc) ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv00p1"/), userRoutine=InitializeAdvertise, rc=rc) + phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv00p2"/), userRoutine=InitializeRealize, rc=rc) + phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -112,6 +127,20 @@ 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, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_CheckImport, & + specRoutine=NUOPC_NoOp, rc=rc) !TODO: replace this with a real method + !TODO: for now just disable all timestamp checking of import fields + 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, & @@ -131,13 +160,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=10) :: value + character(len=10) :: value + character(240) :: msgString + + character(len=*),parameter :: subname='(fv3gfs_cap:InitializeP0)' rc = ESMF_SUCCESS ! Switch to IPDv01 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv00p"/), rc=rc) + acceptStringList=(/"IPDv01p"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -148,8 +180,15 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return ! bail out - profile_memory=(trim(value)/="false") + profile_memory = (trim(value)/="false") + + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + cplprint_flag = (trim(value)=="true") + write(msgString,'(A,l6)') trim(subname)//' cplprint_flag = ',cplprint_flag + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) end subroutine @@ -161,6 +200,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc + ! ! local variables type(ESMF_VM) :: vm @@ -170,6 +210,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_TimeInterval) :: RunDuration, timeStep type(ESMF_Config) :: cf type(ESMF_RegridMethod_Flag) :: regridmethod + type(ESMF_TimeInterval) :: earthStep integer,dimension(6) :: date, date_init integer :: mpi_comm_atm @@ -207,8 +248,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return ! bail out ! print *,'in fv3_cap,initAdvertize,name=',trim(name),'mpi_comm=',mpi_comm_atm, & ! 'petcount=',petcount,'mype=',mype - - clock_fv3=clock +! +! create an instance clock for fv3 + clock_fv3=ESMF_ClockCreate(clock, rc=RC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! !------------------------------------------------------------------------ ! get config variables @@ -233,6 +279,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out +! + cpl = .false. + CALL ESMF_ConfigGetAttribute(config=CF,value=cpl, label ='cpl:',rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! CALL ESMF_ConfigGetAttribute(config=CF,value=quilting, & label ='quilting:',rc=rc) @@ -347,6 +400,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_VMbroadcast(vm, date, 6, 0) call ESMF_TimeSet(time=CurrTime,yy=date(1),mm=date(2),dd=date(3),h=date(4), & m=date(5),s=date(6),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) 999 continue 998 continue ! if(mype==0) print *,'final date =',date,'date_init=',date_init @@ -354,7 +411,42 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !reset CurrTime in clock call ESMF_ClockSet(clock_fv3, currTIME=CurrTime, startTime=startTime, & stopTime=stopTime, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) +! + ! + !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__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + 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__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! 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__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! Read in the FV3 coupling interval + if ( cpl ) then + call clock_cplIntval(gcomp, CF) + endif ! !####################################################################### ! set up fcst grid component @@ -515,6 +607,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! add the fcst FieldBundles to the wrtState(i) so write component can +! use this info to create mirror objects call ESMF_AttributeCopy(fcstState, wrtState(i), & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -522,7 +615,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) -! use this info to create mirror objects call ESMF_StateAdd(wrtState(i), fcstFB, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -706,12 +798,33 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !end quilting endif ! + ! --- advertise Fields in importState and exportState ------------------- + + if( cpl ) then + 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 + + ! 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 + + endif + if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' + endif + if(mype==0) print *,'in fv3_cap, init time=',mpi_wtime()-timeis !----------------------------------------------------------------------- ! end subroutine InitializeAdvertise -! - !----------------------------------------------------------------------------- subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_GridComp) :: gcomp @@ -720,13 +833,39 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Grid) :: grid + integer :: n rc = ESMF_SUCCESS - ! nothing is realized in the import/export States + ! --- conditionally realize or remove Fields in importState and exportState ------------------- - end subroutine + 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 + + 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 + endif + + end subroutine InitializeRealize !----------------------------------------------------------------------------- @@ -758,6 +897,7 @@ subroutine ModelAdvance(gcomp, rc) real(kind=8) :: MPI_Wtime real(kind=8) :: timeri, timewri, timewr, timerhi, timerh + !----------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -796,30 +936,60 @@ subroutine ModelAdvance(gcomp, rc) 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 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 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 with clock_fv3 current: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="startTime", & + preString="entering FV3_ADVANCE with clock_fv3 start: ", & + unit=nuopcMsg) + call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock_fv3, options="stopTime", & + preString="entering FV3_ADVANCE 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) +! 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 +! 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 - - call ESMF_TimePrint(currTime + timeStep, & - preString="--------------------------------> to: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +! if(mype==0) print *,'af clock,timestep date=',date +! if(mype==lead_wrttask(1)) print *,'on wrt lead,af clock,timestep date=',date ! !----------------------------------------------------------------------------- !*** integration loop @@ -964,6 +1134,13 @@ subroutine ModelAdvance(gcomp, rc) !*** end integreate loop enddo integrate +! +!jw for coupled, check clock and dump import and export state + if ( cpl ) then + call Dump_cplFields(gcomp, importState, exportstate, clock_fv3, & + cplprint_flag, timeslice) + endif + print *,'fv3_cap,end integrate,na=',na,' time=',mpi_wtime()- timeri if(profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 Model_ADVANCE: ") @@ -1051,6 +1228,7 @@ end subroutine atmos_model_finalize !####################################################################### ! +! !----------------------------------------------------------------------------- end module fv3gfs_cap_mod diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 4ab9ad340..95c72d6fe 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -245,7 +245,13 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dtsfcin_cpl(:) => null() !< aoi_fld%dtsfcin(item,lan) real (kind=kind_phys), pointer :: dqsfcin_cpl(:) => null() !< aoi_fld%dqsfcin(item,lan) real (kind=kind_phys), pointer :: ulwsfcin_cpl(:)=> null() !< aoi_fld%ulwsfcin(item,lan) -!--- only variable needed for cplwav=.TRUE. + real (kind=kind_phys), pointer :: tseain_cpl(:) => null() !< aoi_fld%tseain(item,lan) + real (kind=kind_phys), pointer :: tisfcin_cpl(:) => null() !< aoi_fld%tisfcin(item,lan) + real (kind=kind_phys), pointer :: ficein_cpl(:) => null() !< aoi_fld%ficein(item,lan) + real (kind=kind_phys), pointer :: hicein_cpl(:) => null() !< aoi_fld%hicein(item,lan) + real (kind=kind_phys), pointer :: hsnoin_cpl(:) => null() !< aoi_fld%hsnoin(item,lan) + !--- only variable needed for cplwav=.TRUE. + !--- also needed for ice/ocn coupling - Xingren real (kind=kind_phys), pointer :: slimskin_cpl(:)=> null() !< aoi_fld%slimskin(item,lan) !--- outgoing accumulated quantities @@ -1180,6 +1186,11 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%dtsfcin_cpl (IM)) allocate (Coupling%dqsfcin_cpl (IM)) allocate (Coupling%ulwsfcin_cpl (IM)) + allocate (Coupling%tseain_cpl (IM)) + allocate (Coupling%tisfcin_cpl (IM)) + allocate (Coupling%ficein_cpl (IM)) + allocate (Coupling%hicein_cpl (IM)) + allocate (Coupling%hsnoin_cpl (IM)) Coupling%slimskin_cpl = clear_val Coupling%dusfcin_cpl = clear_val @@ -1187,6 +1198,11 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%dtsfcin_cpl = clear_val Coupling%dqsfcin_cpl = clear_val Coupling%ulwsfcin_cpl = clear_val + Coupling%tseain_cpl = clear_val + Coupling%tisfcin_cpl = clear_val + Coupling%ficein_cpl = clear_val + Coupling%hicein_cpl = clear_val + Coupling%hsnoin_cpl = clear_val !--- accumulated quantities allocate (Coupling%dusfc_cpl (IM)) diff --git a/gfsphysics/makefile b/gfsphysics/makefile index 9d9c591c1..9d7a97267 100644 --- a/gfsphysics/makefile +++ b/gfsphysics/makefile @@ -17,7 +17,7 @@ endif LIBRARY = libgfsphys.a -FFLAGS += -I../fms -I../fms/include +FFLAGS += -I../fms -I../fms/include -I../cpl CPPDEFS = -DNEW_TAUCTMAX -DSMALL_PE -DNEMS_GSM -DINTERNAL_FILE_NML @@ -149,8 +149,8 @@ SRCS_F90 = \ ./GFS_layer/GFS_driver.F90 \ ./GFS_layer/GFS_physics_driver.F90 \ ./GFS_layer/GFS_radiation_driver.F90 \ - ./GFS_layer/GFS_restart.F90 \ - ./GFS_layer/GFS_typedefs.F90 + ./GFS_layer/GFS_restart.F90 \ + ./GFS_layer/GFS_typedefs.F90 SRCS_c = diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index ac407c3e7..8fa6ebb3e 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -25,6 +25,8 @@ module module_wrt_grid_comp ! !--------------------------------------------------------------------------------- ! + use fms_io_mod, only: field_exist, read_data + use esmf use write_internal_state use module_fv3_io_def, only : num_pes_fcst,lead_wrttask, last_wrttask, & @@ -168,6 +170,10 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) real, dimension(:), allocatable :: slat, lat, lon, axesdata real(ESMF_KIND_R8), dimension(:,:), pointer :: lonPtr, latPtr type(ESMF_DataCopy_Flag) :: copyflag=ESMF_DATACOPY_REFERENCE + real(8),parameter :: PI=3.14159265358979d0 + + character(256) :: gridfile + ! logical,save :: first=.true. !test @@ -228,10 +234,20 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) decomptile(1,tl) = 1 decomptile(2,tl) = jidx enddo - wrtgrid = ESMF_GridCreateMosaic(filename='INPUT/grid_spec.nc', & - regDecompPTile=decomptile,tileFilePath='INPUT/', & - staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & - name='wrt_grid', rc=rc) + + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & + name="gridfile", value=gridfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) + + wrtgrid = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & + regDecompPTile=decomptile,tileFilePath="INPUT/", & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & + name='wrt_grid', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -693,7 +709,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) return ! bail out call ESMF_AttributeGet(wrtGrid, convention="NetCDF", purpose="FV3", & - name="ESMF:gridded_dim_labels", valueList=attrValueSList, rc=rc) + name="ESMF:gridded_dim_labels", valueList=attrValueSList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & diff --git a/makefile b/makefile index dfde756e6..997a44ac7 100644 --- a/makefile +++ b/makefile @@ -2,7 +2,7 @@ SHELL = /bin/sh include conf/configure.fv3 -FFLAGS += -Ifms -Igfsphysics -Iipd -Iio -Iatmos_cubed_sphere +FFLAGS += -Ifms -Igfsphysics -Iipd -Icpl -Iio -Iatmos_cubed_sphere FV3_EXE = fv3.exe FV3CAP_LIB = libfv3cap.a @@ -16,18 +16,22 @@ nems: libs libs: $(MAKE) -C fms $(MAKEFLAGS) + $(MAKE) -C cpl $(MAKEFLAGS) $(MAKE) -C gfsphysics $(MAKEFLAGS) 32BIT=N # force gfs physics to 64bit $(MAKE) -C ipd $(MAKEFLAGS) 32BIT=N # force gfs physics to 64bit $(MAKE) -C io $(MAKEFLAGS) $(MAKE) -C atmos_cubed_sphere $(MAKEFLAGS) $(MAKE) -C stochastic_physics $(MAKEFLAGS) 32BIT=N # force gfs physics to 64bit -$(FV3_EXE): atmos_model.o coupler_main.o atmos_cubed_sphere/libfv3core.a io/libfv3io.a ipd/libipd.a gfsphysics/libgfsphys.a stochastic_physics/libstochastic_physics.a fms/libfms.a +$(FV3_EXE): atmos_model.o coupler_main.o atmos_cubed_sphere/libfv3core.a io/libfv3io.a ipd/libipd.a gfsphysics/libgfsphys.a stochastic_physics/libstochastic_physics.a cpl/libfv3cpl.a fms/libfms.a $(LD) -o $@ $^ $(NCEPLIBS) $(LDFLAGS) $(FV3CAP_LIB): atmos_model.o module_fv3_config.o module_fcst_grid_comp.o time_utils.o fv3_cap.o ar rv $(FV3CAP_LIB) $? +atmos_model.o : atmos_model.F90 + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) -c atmos_model.F90 + module_fv3_config.o: module_fv3_config.F90 $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) -c module_fv3_config.F90 module_fcst_grid_comp.o: module_fcst_grid_comp.F90 @@ -41,8 +45,7 @@ DEPEND_FILES = time_utils.F90 module_fv3_config.F90 atmos_model.F90 module_fcst_ esmf_make_fragment: @rm -rf nems_dir; mkdir nems_dir - @cp $(FV3CAP_LIB) atmos_cubed_sphere/libfv3core.a io/libfv3io.a ipd/libipd.a gfsphysics/libgfsphys.a fms/libfms.a stochastic_physics/libstochastic_physics.a nems_dir -# @cp $(FV3CAP_LIB) atmos_cubed_sphere/libfv3core.a io/libfv3io.a ipd/libipd.a gfsphysics/libgfsphys.a fms/libfms.a nems_dir + @cp $(FV3CAP_LIB) atmos_cubed_sphere/libfv3core.a io/libfv3io.a ipd/libipd.a gfsphysics/libgfsphys.a cpl/libfv3cpl.a fms/libfms.a stochastic_physics/libstochastic_physics.a nems_dir @cp fv3gfs_cap_mod.mod nems_dir @echo "# ESMF self-describing build dependency makefile fragment" > fv3.mk @echo "# src location $(PWD)" >> fv3.mk @@ -50,8 +53,7 @@ esmf_make_fragment: @echo "ESMF_DEP_FRONT = fv3gfs_cap_mod" >> fv3.mk @echo "ESMF_DEP_INCPATH = $(PWD)/nems_dir" >> fv3.mk @echo "ESMF_DEP_CMPL_OBJS =" >> fv3.mk - @echo "ESMF_DEP_LINK_OBJS = $(addprefix $(PWD)/nems_dir/, libfv3cap.a libfv3core.a libfv3io.a libipd.a libgfsphys.a libfms.a libstochastic_physics.a)" >> fv3.mk -# @echo "ESMF_DEP_LINK_OBJS = $(addprefix $(PWD)/nems_dir/, libfv3cap.a libfv3core.a libfv3io.a libipd.a libgfsphys.a libfms.a )" >> fv3.mk + @echo "ESMF_DEP_LINK_OBJS = $(addprefix $(PWD)/nems_dir/, libfv3cap.a libfv3core.a libfv3io.a libipd.a libgfsphys.a libfv3cpl.a libfms.a libstochastic_physics.a)" >> fv3.mk @echo "ESMF_DEP_SHRD_PATH =" >> fv3.mk @echo "ESMF_DEP_SHRD_LIBS =" >> fv3.mk @echo @@ -79,6 +81,7 @@ clean: (cd stochastic_physics && make clean) (cd io && make clean) (cd atmos_cubed_sphere && make clean) + (cd cpl && make clean) $(RM) -f $(FV3_EXE) $(FV3CAP_LIB) *.o *.mod *.lst depend cleanall: clean diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index c0373bc1e..32bfbe162 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -20,11 +20,12 @@ module module_fcst_grid_comp NOLEAP, NO_CALENDAR, date_to_string, & get_date - use atmos_model_mod, only: atmos_model_init, atmos_model_end, & - update_atmos_model_dynamics, & - update_atmos_radiation_physics, & - update_atmos_model_state, & - atmos_data_type, atmos_model_restart + use atmos_model_mod, only: atmos_model_init, atmos_model_end, & + update_atmos_model_dynamics, & + update_atmos_radiation_physics, & + update_atmos_model_state, & + atmos_data_type, atmos_model_restart, & + addLsmask2grid use constants_mod, only: constants_init use fms_mod, only: open_namelist_file, file_exist, check_nml_error, & @@ -47,13 +48,15 @@ module module_fcst_grid_comp use data_override_mod, only: data_override_init use fv_nggps_diags_mod, only: fv_dyn_bundle_setup use fv3gfs_io_mod, only: fv_phys_bundle_setup + + use fms_io_mod, only: field_exist, read_data use esmf ! use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, nbdlphys use module_fv3_config, only: dt_atmos, calendar, restart_interval, & - quilting, calendar_type, & - force_date_from_configure + quilting, calendar_type, cpl, & + cplprint_flag, force_date_from_configure ! !----------------------------------------------------------------------- ! @@ -82,6 +85,7 @@ module module_fcst_grid_comp type(atmos_internalstate_type),pointer,save :: atm_int_state type(atmos_internalstate_wrapper),save :: wrap type(ESMF_VM),save :: VM + type(ESMF_Grid) :: fcstGrid !----- coupled model date ----- @@ -89,7 +93,7 @@ module module_fcst_grid_comp ! !----------------------------------------------------------------------- ! - public SetServices + public SetServices, fcstGrid ! contains ! @@ -147,7 +151,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) integer :: tl, i, j integer,dimension(2,6) :: decomptile !define delayout for the 6 cubed-sphere tiles type(ESMF_FieldBundle) :: fieldbundle - type(ESMF_Grid) :: fcstGrid ! type(ESMF_Time) :: CurrTime, TINI, StopTime type(ESMF_TimeInterval) :: TINT, RunDuration, TimeElapsed @@ -167,6 +170,8 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) character(2) dateSM,dateSD,dateSH,dateSN,dateSS character(128) name_FB, name_FB1, dateS real, allocatable, dimension(:,:) :: glon_bnd, glat_bnd + + character(256) :: gridfile type(ESMF_FieldBundle),dimension(:), allocatable :: fieldbundlephys real(8) mpi_wtime, timeis @@ -336,7 +341,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! ! !----------------------------------------------------------------------- -!*** create grid for oupout fields +!*** create grid for output fields !*** first try: Create cubed sphere grid from file !----------------------------------------------------------------------- ! @@ -347,10 +352,42 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) decomptile(1,tl) = atm_int_state%Atm%layout(1) decomptile(2,tl) = atm_int_state%Atm%layout(2) enddo - fcstGrid = ESMF_GridCreateMosaic(filename='INPUT/grid_spec.nc', & - regDecompPTile=decomptile,tileFilePath='INPUT/', & - staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & - name='fcst_grid', rc=rc) + + gridfile="grid_spec.nc" ! default + if (field_exist("INPUT/grid_spec.nc", "atm_mosaic_file")) then + call read_data("INPUT/grid_spec.nc", "atm_mosaic_file", gridfile) + endif + + CALL ESMF_LogWrite("fcst: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) + + fcstGrid = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & + regDecompPTile=decomptile,tileFilePath="INPUT/", & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & + name='fcst_grid', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! +!test to write out vtk file: + if( cpl ) then + call addLsmask2grid(fcstGrid, rc=rc) +! print *,'call addLsmask2grid after fcstgrid, rc=',rc + if( cplprint_flag ) then + call ESMF_GridWriteVTK(fcstgrid, staggerloc=ESMF_STAGGERLOC_CENTER, & + filename='fv3cap_fv3Grid', rc=rc) + endif + endif +! +! Add gridfile Attribute to the exportState + call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & + attrList=(/"gridfile"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & + name="gridfile", value=trim(gridfile), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index e9dbdfe6b..367b0dbac 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -22,6 +22,7 @@ module module_fv3_config type(ESMF_TimeInterval) :: output_hfmax type(ESMF_TimeInterval) :: output_interval,output_interval_hf ! + logical :: cpl, cplprint_flag logical :: quilting logical :: force_date_from_configure !