diff --git a/CMakeLists.txt b/CMakeLists.txt index 718ba11b4..8f24f04fd 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -14,6 +14,9 @@ set(use_WRTCOMP ON) set(GFS_PHYS ON) set(GFS_TYPES ON) set(USE_GFSL63 ON) +if(MOVING_NEST) + set(MOVING_NEST ON) +endif() add_subdirectory(atmos_cubed_sphere) ############################################################################### @@ -32,6 +35,10 @@ if(NOT PARALLEL_NETCDF) list(APPEND _fv3atm_defs_private NO_PARALLEL_NETCDF) endif() +if(MOVING_NEST) + list(APPEND _fv3atm_defs_private MOVING_NEST) +endif() + add_library(fv3atm atmos_model.F90 fv3_cap.F90 diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 43f7ed39f..0b040858b 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 43f7ed39fcd302e8404a152011f7a02c5d76ddc9 +Subproject commit 0b040858b1b9b10d76bc9f4c93fbc9043efe269f diff --git a/atmos_model.F90 b/atmos_model.F90 index e5ebf390c..35433c774 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -63,6 +63,7 @@ module atmos_model_mod use atmosphere_mod, only: atmosphere_restart use atmosphere_mod, only: atmosphere_end use atmosphere_mod, only: atmosphere_state_update +use atmosphere_mod, only: atmosphere_fill_nest_cpl use atmosphere_mod, only: atmos_phys_driver_statein use atmosphere_mod, only: atmosphere_control_data use atmosphere_mod, only: atmosphere_resolution, atmosphere_domain @@ -101,6 +102,9 @@ module atmos_model_mod block_data_copy_or_fill, & block_data_combine_fractions +#ifdef MOVING_NEST +use fv_moving_nest_main_mod, only: update_moving_nest, dump_moving_nest +#endif !----------------------------------------------------------------------- implicit none @@ -126,14 +130,16 @@ module atmos_model_mod integer :: layout(2) ! computer task laytout logical :: regional ! true if domain is regional logical :: nested ! true if there is a nest + logical :: moving_nest_parent ! true if this grid has a moving nest child + logical :: is_moving_nest ! true if this is a moving nest grid integer :: ngrids ! integer :: mygrid ! integer :: mlon, mlat integer :: iau_offset ! iau running window length logical :: pe ! current pe. real(kind=8), pointer, dimension(:) :: ak, bk - real, pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. - real, pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lon => null() ! local longitude axis grid box centers in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lat => null() ! local latitude axis grid box centers in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: dx, dy @@ -149,6 +155,14 @@ module atmos_model_mod ! to calculate gradient on cubic sphere grid. ! +! these two arrays, lon_bnd_work and lat_bnd_work are 'working' arrays, always allocated +! as (nlon+1, nlat+1) and are used to get the corner lat/lon values from the dycore. +! these values are then copied to Atmos%lon_bnd, Atmos%lat_bnd which are allocated with +! sizes that correspond to the corner coordinates distgrid in fcstGrid +real(kind=GFS_kind_phys), pointer, dimension(:,:), save :: lon_bnd_work => null() +real(kind=GFS_kind_phys), pointer, dimension(:,:), save :: lat_bnd_work => null() +integer, save :: i_bnd_size, j_bnd_size + integer :: fv3Clock, getClock, updClock, setupClock, radClock, physClock !----------------------------------------------------------------------- @@ -274,6 +288,17 @@ subroutine update_atmos_radiation_physics (Atmos) call assign_importdata(jdat(:),rc) if (rc/=0) call mpp_error(FATAL, 'Call to assign_importdata failed') + ! Currently for FV3ATM, it is only enabled for parent domain coupling + ! with other model components. In this case, only the parent domain + ! receives coupled fields through the above assign_importdata step. Thus, + ! an extra step is needed to fill the coupling variables in the nest, + ! by downscaling the coupling variables from its parent. + if (Atmos%ngrids > 1) then + if (GFS_control%cplocn2atm .or. GFS_control%cplwav2atm) then + call atmosphere_fill_nest_cpl(Atm_block, GFS_control, GFS_data) + endif + endif + ! Calculate total non-physics tendencies by substracting old GFS Stateout ! variables from new/updated GFS Statein variables (gives the tendencies ! due to anything else than physics) @@ -528,12 +553,35 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !----------------------------------------------------------------------- call atmosphere_resolution (nlon, nlat, global=.false.) call atmosphere_resolution (mlon, mlat, global=.true.) - call alloc_atmos_data_type (nlon, nlat, Atmos) - call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%ngrids, Atmos%mygrid, Atmos%pelist) + call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, & + Atmos%moving_nest_parent, Atmos%is_moving_nest, & + Atmos%ngrids, Atmos%mygrid, Atmos%pelist) call atmosphere_diag_axes (Atmos%axes) call atmosphere_etalvls (Atmos%ak, Atmos%bk, flip=flip_vc) - call atmosphere_grid_bdry (Atmos%lon_bnd, Atmos%lat_bnd, global=.false.) + + call atmosphere_control_data (isc, iec, jsc, jec, nlev, p_hydro, hydro, tile_num) + + allocate (Atmos%lon(nlon,nlat), Atmos%lat(nlon,nlat)) call atmosphere_grid_ctr (Atmos%lon, Atmos%lat) + + i_bnd_size = nlon + j_bnd_size = nlat + if (iec == mlon) then + ! we are on task at the 'east' edge of the cubed sphere face or regional domain + ! corner arrays should have one extra element in 'i' direction + i_bnd_size = nlon + 1 + end if + if (jec == mlat) then + ! we are on task at the 'north' edge of the cubed sphere face or regional domain + ! corner arrays should have one extra element in 'j' direction + j_bnd_size = nlat + 1 + end if + allocate (Atmos%lon_bnd(i_bnd_size,j_bnd_size), Atmos%lat_bnd(i_bnd_size,j_bnd_size)) + allocate (lon_bnd_work(nlon+1,nlat+1), lat_bnd_work(nlon+1,nlat+1)) + call atmosphere_grid_bdry (lon_bnd_work, lat_bnd_work) + Atmos%lon_bnd(1:i_bnd_size,1:j_bnd_size) = lon_bnd_work(1:i_bnd_size,1:j_bnd_size) + Atmos%lat_bnd(1:i_bnd_size,1:j_bnd_size) = lat_bnd_work(1:i_bnd_size,1:j_bnd_size) + call atmosphere_hgt (Atmos%layer_hgt, 'layer', relative=.false., flip=flip_vc) call atmosphere_hgt (Atmos%level_hgt, 'level', relative=.false., flip=flip_vc) @@ -551,7 +599,6 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !----------------------------------------------------------------------- !--- before going any further check definitions for 'blocks' !----------------------------------------------------------------------- - call atmosphere_control_data (isc, iec, jsc, jec, nlev, p_hydro, hydro, tile_num) call define_blocks_packed ('atmos_model', Atm_block, isc, iec, jsc, jec, nlev, & blocksize, block_message) @@ -762,8 +809,23 @@ subroutine update_atmos_model_dynamics (Atmos) type (atmos_data_type), intent(in) :: Atmos call set_atmosphere_pelist() +#ifdef MOVING_NEST + ! W. Ramstrom, AOML/HRD -- May 28, 2021 + ! Evaluates whether to move nest, then performs move if needed + if (Atmos%moving_nest_parent .or. Atmos%is_moving_nest ) then + call update_moving_nest (Atm_block, GFS_control, GFS_data, Atmos%Time) + endif +#endif call mpp_clock_begin(fv3Clock) call atmosphere_dynamics (Atmos%Time) +#ifdef MOVING_NEST + ! W. Ramstrom, AOML/HRD -- June 9, 2021 + ! Debugging output of moving nest code. Called from this level to access needed input variables. + if (Atmos%moving_nest_parent .or. Atmos%is_moving_nest ) then + call dump_moving_nest (Atm_block, GFS_control, GFS_data, Atmos%Time) + endif +#endif + call mpp_clock_end(fv3Clock) end subroutine update_atmos_model_dynamics @@ -920,6 +982,14 @@ subroutine update_atmos_model_state (Atmos, rc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return + !--- conditionally update the coordinate arrays for moving domains + if (Atmos%is_moving_nest) then + call atmosphere_grid_ctr (Atmos%lon, Atmos%lat) + call atmosphere_grid_bdry (lon_bnd_work, lat_bnd_work, global=.false.) + Atmos%lon_bnd(1:i_bnd_size,1:j_bnd_size) = lon_bnd_work(1:i_bnd_size,1:j_bnd_size) + Atmos%lat_bnd(1:i_bnd_size,1:j_bnd_size) = lat_bnd_work(1:i_bnd_size,1:j_bnd_size) + endif + end subroutine update_atmos_model_state ! @@ -983,7 +1053,9 @@ subroutine atmos_model_end (Atmos) call CCPP_step (step="finalize", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP finalize step failed') - call dealloc_atmos_data_type (Atmos) + deallocate (Atmos%lon, Atmos%lat) + deallocate (Atmos%lon_bnd, Atmos%lat_bnd) + deallocate (lon_bnd_work, lat_bnd_work) end subroutine atmos_model_end @@ -1681,24 +1753,6 @@ subroutine update_atmos_chemistry(state, rc) end subroutine update_atmos_chemistry ! - subroutine alloc_atmos_data_type (nlon, nlat, Atmos) - integer, intent(in) :: nlon, nlat - type(atmos_data_type), intent(inout) :: Atmos - allocate ( Atmos % lon_bnd (nlon+1,nlat+1), & - Atmos % lat_bnd (nlon+1,nlat+1), & - Atmos % lon (nlon,nlat), & - Atmos % lat (nlon,nlat) ) - - end subroutine alloc_atmos_data_type - - subroutine dealloc_atmos_data_type (Atmos) - type(atmos_data_type), intent(inout) :: Atmos - deallocate (Atmos%lon_bnd, & - Atmos%lat_bnd, & - Atmos%lon, & - Atmos%lat ) - end subroutine dealloc_atmos_data_type - subroutine assign_importdata(jdat, rc) use module_cplfields, only: importFields, nImportFields, queryImportFields, & diff --git a/ccpp/driver/GFS_init.F90 b/ccpp/driver/GFS_init.F90 index 70f0f8494..5e79f15b0 100644 --- a/ccpp/driver/GFS_init.F90 +++ b/ccpp/driver/GFS_init.F90 @@ -17,6 +17,7 @@ module GFS_init ! Public entities !---------------- public GFS_initialize !< GFS initialization routine + public GFS_grid_populate !< Lat/lon/area setting -- exposed for moving nest CONTAINS !******************************************************************************************* diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index d69f6c989..be8dcd67b 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -186,7 +186,7 @@ subroutine state_diagnose(State,string, rc) type(ESMF_StateItem_Flag) :: itemType real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) real(ESMF_KIND_R8), pointer :: dataPtr3d(:,:,:) - integer :: lrc, dimCount + integer :: lrc, localDeCount, dimCount character(len=*),parameter :: subname='(FV3: state_diagnose)' lstring = '' @@ -211,23 +211,25 @@ subroutine state_diagnose(State,string, rc) call ESMF_StateGet(State, itemName=trim(itemNameList(n)), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(lfield, dimCount=dimcount, rc=lrc) + call ESMF_FieldGet(lfield, localDeCount=localDeCount, dimCount=dimcount, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(dimcount == 2)then - call ESMF_FieldGet(lfield, farrayPtr=dataPtr2d, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & - minval(dataPtr2d),maxval(dataPtr2d),sum(dataPtr2d) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) - else - call ESMF_FieldGet(lfield, farrayPtr=dataPtr3d, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & - minval(dataPtr3d),maxval(dataPtr3d),sum(dataPtr3d) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) + if(localDeCount.gt.0) then + if(dimcount == 2)then + call ESMF_FieldGet(lfield, farrayPtr=dataPtr2d, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & + minval(dataPtr2d),maxval(dataPtr2d),sum(dataPtr2d) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) + else + call ESMF_FieldGet(lfield, farrayPtr=dataPtr3d, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & + minval(dataPtr3d),maxval(dataPtr3d),sum(dataPtr3d) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) + end if end if end if enddo diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 87dbe0e69..0c72a2cd1 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -29,7 +29,7 @@ module fv3gfs_cap_mod ! use module_fv3_config, only: quilting, output_fh, & nfhout, nfhout_hf, nsout, dt_atmos, & - calendar, & + calendar, cpl_grid_id, & cplprint_flag,output_1st_tstep_rst, & first_kdt @@ -39,21 +39,14 @@ module fv3gfs_cap_mod lead_wrttask, last_wrttask, & nsout_io, iau_offset, lflname_fulltime ! - use module_fcst_grid_comp, only: fcstSS => SetServices, & - fcstGrid, numLevels, numSoilLayers, & - numTracers, mygrid, grid_number_on_all_pets + use module_fcst_grid_comp, only: fcstSS => SetServices use module_wrt_grid_comp, only: wrtSS => SetServices ! - use module_cplfields, only: nExportFields, exportFields, exportFieldsInfo, & - nImportFields, importFields, importFieldsInfo, & - importFieldsValid, queryImportFields + use module_cplfields, only: importFieldsValid, queryImportFields - use module_cplfields, only: realizeConnectedCplFields use module_cap_cpl, only: diagnose_cplFields - use atmos_model_mod, only: setup_exportdata - implicit none private public SetServices @@ -71,6 +64,9 @@ module fv3gfs_cap_mod type(ESMF_FieldBundle), allocatable :: wrtFB(:,:) type(ESMF_RouteHandle), allocatable :: routehandle(:,:) + type(ESMF_RouteHandle), allocatable :: gridRedistRH(:,:) + type(ESMF_Grid), allocatable :: srcGrid(:,:), dstGrid(:,:) + logical, allocatable :: is_moving_FB(:) logical :: profile_memory = .true. @@ -177,13 +173,13 @@ subroutine InitializeAdvertise(gcomp, rc) character(len=10) :: value character(240) :: msgString logical :: isPresent, isSet - type(ESMF_VM) :: vm, fcstVM + type(ESMF_VM) :: vm, wrtVM type(ESMF_Time) :: currTime, startTime type(ESMF_TimeInterval) :: timeStep, rsthour type(ESMF_Config) :: cf type(ESMF_RegridMethod_Flag) :: regridmethod - integer :: i, j, k, urc, ist + integer :: i, j, k, urc, ist, grid_id integer :: noutput_fh, nfh, nfh2 integer :: petcount integer :: nfhmax_hf @@ -196,7 +192,14 @@ subroutine InitializeAdvertise(gcomp, rc) type(ESMF_StateItem_Flag), allocatable :: fcstItemTypeList(:) character(20) :: cwrtcomp integer :: isrcTermProcessing - type(ESMF_Info) :: parentInfo, childInfo + type(ESMF_Info) :: parentInfo, childInfo, info + logical, allocatable :: is_moving(:) + logical :: needGridTransfer + type(ESMF_DistGrid) :: providerDG, acceptorDG + type(ESMF_Grid) :: grid, providerGrid + integer :: fieldCount, ii + type(ESMF_FieldBundle) :: mirrorFB + type(ESMF_Field), allocatable :: fieldList(:) character(len=*),parameter :: subname='(fv3_cap:InitializeAdvertise)' real(kind=8) :: MPI_Wtime, timeis, timerhs @@ -216,6 +219,12 @@ subroutine InitializeAdvertise(gcomp, rc) call NUOPC_ModelGet(gcomp, driverClock=clock, importState=importState, exportState=exportState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeGet(gcomp, name="cpl_grid_id", value=value, defaultValue="1", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + cpl_grid_id = ESMF_UtilString2Int(value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -356,16 +365,13 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return -! obtain fcst VM - call ESMF_GridCompGet(fcstComp, vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! create fcst state fcstState = ESMF_StateCreate(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call fcst Initialize (including creating fcstgrid and fcst fieldbundle) call ESMF_GridCompInitialize(fcstComp, exportState=fcstState, & - clock=clock, userRc=urc, rc=rc) + clock=clock, phase=1, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -380,7 +386,27 @@ subroutine InitializeAdvertise(gcomp, rc) if(mype == 0) print *,'af fcstCom FBCount= ',FBcount ! ! set start time for output - output_startfh = 0. + output_startfh = 0. +! +! query the is_moving array from the fcstState (was set by fcstComp.Initialize() above) + call ESMF_InfoGetFromHost(fcstState, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + needGridTransfer = any(is_moving) + + allocate(is_moving_fb(FBcount)) + is_moving_fb = .false. ! init + + write(msgString,'(A,L4)') trim(subname)//" needGridTransfer = ", needGridTransfer + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(msgString,'(A,8L4)') trim(subname)//" is_moving = ", is_moving + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! !----------------------------------------------------------------------- !*** create and initialize Write component(s). @@ -391,6 +417,7 @@ subroutine InitializeAdvertise(gcomp, rc) allocate(fcstFB(FBCount), fcstItemNameList(FBCount), fcstItemTypeList(FBCount)) allocate(wrtComp(write_groups), wrtState(write_groups) ) allocate(wrtFB(FBCount,write_groups), routehandle(FBCount,write_groups)) + allocate(srcGrid(FBCount,write_groups), dstGrid(FBCount,write_groups), gridRedistRH(FBCount,write_groups)) allocate(lead_wrttask(write_groups), last_wrttask(write_groups)) allocate(petList(wrttasks_per_group)) allocate(originPetList(num_pes_fcst+wrttasks_per_group)) @@ -419,6 +446,9 @@ subroutine InitializeAdvertise(gcomp, rc) line=__LINE__, file=__FILE__, rcToReturn=rc) return endif + call ESMF_AttributeGet(fcstFB(i), convention="NetCDF", purpose="FV3", name="grid_id", value=grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + is_moving_fb(i) = is_moving(grid_id) enddo ! k = num_pes_fcst @@ -461,31 +491,28 @@ subroutine InitializeAdvertise(gcomp, rc) call ESMF_GridCompSet(gridcomp=wrtComp(i),config=CF,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! create wrtstate(i) - wrtstate(i) = ESMF_StateCreate(rc=rc) +! create wrtState(i) + wrtState(i) = ESMF_StateCreate(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! 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) + call ESMF_AttributeCopy(fcstState, wrtState(i), attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_StateAdd(wrtState(i), fcstFB, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call into wrtComp(i) Initialize - call ESMF_GridCompInitialize(wrtComp(i), importState=wrtstate(i), & - clock=clock, phase=1, userRc=urc, rc=rc) + call ESMF_GridCompInitialize(wrtComp(i), importState=wrtState(i), clock=clock, phase=1, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return ! remove fcst FieldBundles from the wrtState(i) because done with it call ESMF_StateRemove(wrtState(i), fcstItemNameList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! reconcile the wrtComp(i)'s export state +! reconcile the wrtComp(i)'s import state call ESMF_StateReconcile(wrtState(i), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -495,68 +522,202 @@ subroutine InitializeAdvertise(gcomp, rc) attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! loop over all FieldBundle in the states and precompute Regrid operation - do j=1, FBcount +! deal with GridTransfer if needed + + if (needGridTransfer) then - ! access the mirrored FieldBundle in the wrtState(i) - call ESMF_StateGet(wrtState(i), & - itemName="mirror_"//trim(fcstItemNameList(j)), & - fieldbundle=wrtFB(j,i), rc=rc) - if(mype == 0) print *,'af get wrtfb=',"mirror_"//trim(fcstItemNameList(j)),' rc=',rc + ! obtain wrtComp VM needed for acceptor DistGrid + call ESMF_GridCompGet(wrtComp(i), vm=wrtVM, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! determine regridmethod - if (index(fcstItemNameList(j),"_bilinear") >0 ) then - regridmethod = ESMF_REGRIDMETHOD_BILINEAR - else if (index(fcstItemNameList(j),"_patch") >0) then - regridmethod = ESMF_REGRIDMETHOD_PATCH - else if (index(fcstItemNameList(j),"_nearest_stod") >0) then - regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD - else if (index(fcstItemNameList(j),"_nearest_dtos") >0) then - regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS - else if (index(fcstItemNameList(j),"_conserve") >0) then - regridmethod = ESMF_REGRIDMETHOD_CONSERVE - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="Unable to determine regrid method.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + ! loop over all FieldBundle in the states, for moving nests initiate GridTransfer + do j=1, FBcount + if (is_moving_fb(j)) then + ! access the fcst (provider) Grid + call ESMF_FieldBundleGet(fcstFB(j), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the mirror FieldBundle on the wrtComp + call ESMF_StateGet(wrtState(i), itemName="mirror_"//trim(fcstItemNameList(j)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! determine whether there are fields in the mirror FieldBundle + call ESMF_FieldBundleGet(mirrorFB, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fieldCount > 0) then + ! access the providerDG + call ESMF_GridGet(grid, distgrid=providerDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! construct an acceptorDG with the same number of DEs for the acceptor side + acceptorDG = ESMF_DistGridCreate(providerDG, vm=wrtVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! need a grid on the accptor side to carry the acceptorDG + grid = ESMF_GridEmptyCreate(vm=wrtVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! set the acceptorDG + call ESMF_GridSet(grid, distgrid=acceptorDG, vm=wrtVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! associate the grid with the mirror FieldBundle + call ESMF_FieldBundleSet(mirrorFB, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + endif + enddo + + ! Call into wrtComp(i) Initialize() phase=2 to re-balance the mirrored grid distribution on its PETs + call ESMF_GridCompInitialize(wrtComp(i), importState=wrtState(i), clock=clock, phase=2, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + ! Reconcile any changes (re-balanced grid distribution) across the wrtState(i) + call ESMF_StateReconcile(wrtState(i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite('bf FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) - write(msgString,"(A,I2.2,',',I2.2,A)") "calling into wrtFB(",j,i, ") FieldBundleRegridStore()...." - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - - if (i==1) then -! this is a Store() for the first wrtComp -> must do the Store() - call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,1), & - regridMethod=regridmethod, routehandle=routehandle(j,1), & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - srcTermProcessing=isrcTermProcessing, rc=rc) - -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (rc /= ESMF_SUCCESS) then - write(0,*)'fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore' - call ESMF_LogWrite('fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore', ESMF_LOGMSG_ERROR, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + ! loop over all FieldBundle in the states, for moving nests handle GridTransfer + do j=1, FBcount + if (is_moving_fb(j)) then + ! access the fcst (provider) Grid + call ESMF_FieldBundleGet(fcstFB(j), grid=providerGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the mirror FieldBundle on the wrtComp + call ESMF_StateGet(wrtState(i), itemName="mirror_"//trim(fcstItemNameList(j)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! determine whether there are fields in the mirror FieldBundle + call ESMF_FieldBundleGet(mirrorFB, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fieldCount > 0) then + ! access the field in the mirror FieldBundle + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirrorFB, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the balanced mirror Grid from the first Field in the mirror FieldBundle + call ESMF_FieldGet(fieldList(1), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the balanced mirror DistGrid from the mirror Grid + call ESMF_GridGet(grid, distgrid=acceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! construct a complete balanced mirror Grid with redistributed coordinates + call ESMF_TraceRegionEnter("ESMF_GridCreate(fromGrid,newDistGrid)", rc=rc) + grid = ESMF_GridCreate(providerGrid, acceptorDG, routehandle=gridRedistRH(j,i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_GridCreate(fromGrid,newDistGrid)", rc=rc) + ! keep src and dst Grids for run-loop + srcGrid(j,i) = providerGrid + dstGrid(j,i) = grid + ! loop over all the mirror fields and set the balanced mirror Grid + do ii=1, fieldCount + call ESMF_FieldEmptySet(fieldList(ii), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + ! clean-up + deallocate(fieldList) + endif endif - call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo - originPetList(1:num_pes_fcst) = fcstPetList(:) - originPetList(num_pes_fcst+1:) = petList(:) + ! Call into wrtComp(i) Initialize() phase=3 to finish up creating the mirror Fields + call ESMF_GridCompInitialize(wrtComp(i), importState=wrtState(i), clock=clock, phase=3, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + ! Reconcile any changes (finished mirror Fields) across the wrtState(i) + call ESMF_StateReconcile(wrtState(i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + endif + +! loop over all FieldBundle in the states and precompute Regrid operation + do j=1, FBcount + ! decide between Redist() and Regrid() + if (is_moving_fb(j)) then + ! this is a moving domain -> use a static Redist() to move data to wrtComp(:) + ! access the mirror FieldBundle in the wrtState(i) + call ESMF_StateGet(wrtState(i), & + itemName="mirror_"//trim(fcstItemNameList(j)), & + fieldbundle=wrtFB(j,i), rc=rc) + if (i==1) then + ! this is a Store() for the first wrtComp -> must do the Store() + call ESMF_TraceRegionEnter("ESMF_FieldBundleRedistStore()", rc=rc) + call ESMF_FieldBundleRedistStore(fcstFB(j), wrtFB(j,1), & + routehandle=routehandle(j,1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_FieldBundleRedistStore()", rc=rc) + originPetList(1:num_pes_fcst) = fcstPetList(:) + originPetList(num_pes_fcst+1:) = petList(:) + else + targetPetList(1:num_pes_fcst) = fcstPetList(:) + targetPetList(num_pes_fcst+1:) = petList(:) + call ESMF_TraceRegionEnter("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRedistStore()", rc=rc) + routehandle(j,i) = ESMF_RouteHandleCreate(routehandle(j,1), & + originPetList=originPetList, & + targetPetList=targetPetList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRedistStore()", rc=rc) + endif else - targetPetList(1:num_pes_fcst) = fcstPetList(:) - targetPetList(num_pes_fcst+1:) = petList(:) - routehandle(j,i) = ESMF_RouteHandleCreate(routehandle(j,1), & - originPetList=originPetList, & - targetPetList=targetPetList, rc=rc) + ! this is a static domain -> do Regrid() "on the fly" when sending data to wrtComp(:) + ! access the output FieldBundle in the wrtState(i) + call ESMF_StateGet(wrtState(i), & + itemName="output_"//trim(fcstItemNameList(j)), & + fieldbundle=wrtFB(j,i), rc=rc) + if(mype == 0) print *,'af get wrtfb=',"output_"//trim(fcstItemNameList(j)),' rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! determine regridmethod + if (index(fcstItemNameList(j),"_bilinear") >0 ) then + regridmethod = ESMF_REGRIDMETHOD_BILINEAR + else if (index(fcstItemNameList(j),"_patch") >0) then + regridmethod = ESMF_REGRIDMETHOD_PATCH + else if (index(fcstItemNameList(j),"_nearest_stod") >0) then + regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD + else if (index(fcstItemNameList(j),"_nearest_dtos") >0) then + regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS + else if (index(fcstItemNameList(j),"_conserve") >0) then + regridmethod = ESMF_REGRIDMETHOD_CONSERVE + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unable to determine regrid method.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + call ESMF_LogWrite('bf FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) + write(msgString,"(A,I2.2,',',I2.2,A)") "calling into wrtFB(",j,i, ") FieldBundleRegridStore()...." + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + + if (i==1) then + ! this is a Store() for the first wrtComp -> must do the Store() + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()", rc=rc) + call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,1), & + regridMethod=regridmethod, routehandle=routehandle(j,1), & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + srcTermProcessing=isrcTermProcessing, rc=rc) + +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (rc /= ESMF_SUCCESS) then + write(0,*)'fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore' + call ESMF_LogWrite('fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore', ESMF_LOGMSG_ERROR, rc=rc) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()", rc=rc) + call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + originPetList(1:num_pes_fcst) = fcstPetList(:) + originPetList(num_pes_fcst+1:) = petList(:) + + else + targetPetList(1:num_pes_fcst) = fcstPetList(:) + targetPetList(num_pes_fcst+1:) = petList(:) + call ESMF_TraceRegionEnter("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRegridStore()", rc=rc) + routehandle(j,i) = ESMF_RouteHandleCreate(routehandle(j,1), & + originPetList=originPetList, & + targetPetList=targetPetList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRegridStore()", rc=rc) + + endif + write(msgString,"(A,I2.2,',',I2.2,A)") "... returned from wrtFB(",j,i, ") FieldBundleRegridStore()." + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) endif - write(msgString,"(A,I2.2,',',I2.2,A)") "... returned from wrtFB(",j,i, ") FieldBundleRegridStore()." - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) enddo ! j=1, FBcount ! end write_groups @@ -719,21 +880,12 @@ subroutine InitializeAdvertise(gcomp, rc) ! ! --- advertise Fields in importState and exportState ------------------- - ! importable fields: - do i = 1, size(importFieldsInfo) - call NUOPC_Advertise(importState, & - StandardName=trim(importFieldsInfo(i)%name), & - SharePolicyField='share', vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end do +! call fcst Initialize (advertise phase) + call ESMF_GridCompInitialize(fcstComp, importState=importState, exportState=exportState, & + clock=clock, phase=2, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! exportable fields: - do i = 1, size(exportFieldsInfo) - call NUOPC_Advertise(exportState, & - StandardName=trim(exportFieldsInfo(i)%name), & - SharePolicyField='share', vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end do + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' if(mype==0) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis @@ -749,39 +901,24 @@ subroutine InitializeRealize(gcomp, rc) ! local variables character(len=*),parameter :: subname='(fv3gfs_cap:InitializeRealize)' + type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState - logical :: isPetLocal + integer :: urc rc = ESMF_SUCCESS ! query for importState and exportState - call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) + call NUOPC_ModelGet(gcomp, driverClock=clock, importState=importState, exportState=exportState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! --- conditionally realize or remove Fields in importState and exportState ------------------- - isPetLocal = ESMF_GridCompIsPetLocal(fcstComp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (isPetLocal) then - - ! -- realize connected fields in exportState - call realizeConnectedCplFields(exportState, fcstGrid(mygrid), & - numLevels, numSoilLayers, numTracers, & - exportFieldsInfo, 'FV3 Export', exportFields, 0.0_ESMF_KIND_R8, 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(mygrid), & - numLevels, numSoilLayers, numTracers, & - importFieldsInfo, 'FV3 Import', importFields, 9.99e20_ESMF_KIND_R8, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! call fcst Initialize (realize phase) + call ESMF_GridCompInitialize(fcstComp, importState=importState, exportState=exportState, & + clock=clock, phase=3, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return end subroutine InitializeRealize @@ -911,24 +1048,35 @@ subroutine ModelAdvance_phase2(gcomp, rc) output: if (ANY(nint(output_fh(:)*3600.0) == nfseconds)) then ! - if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run output time=',nfseconds, & - 'FBcount=',FBcount,'na=',na + if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run output time=',nfseconds, & + 'FBcount=',FBcount,'na=',na + + call ESMF_TraceRegionEnter("ESMF_VMEpoch:fcstFB->wrtFB", rc=rc) call ESMF_VMEpochEnter(epoch=ESMF_VMEpoch_Buffer, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return do j=1, FBCount - call ESMF_FieldBundleRegrid(fcstFB(j), wrtFB(j,n_group), & - routehandle=routehandle(j, n_group), & - termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + if (is_moving_fb(j)) then + ! Grid coords need to be redistributed to the mirror Grid on wrtComp + call ESMF_GridRedist(srcGrid(j, n_group), dstGrid(j, n_group), routehandle=gridRedistRH(j, n_group), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + ! execute the routehandle from fcstFB -> wrtFB (either Regrid() or Redist()) + call ESMF_FieldBundleSMM(fcstFB(j), wrtFB(j,n_group), & + routehandle=routehandle(j, n_group), & + termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + enddo call ESMF_VMEpochExit(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_VMEpoch:fcstFB->wrtFB", rc=rc) + call ESMF_LogWrite('Model Advance: before wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1151,7 +1299,7 @@ subroutine ModelFinalize(gcomp, rc) !*** finalize grid comps if( quilting ) then do i = 1, write_groups - call ESMF_GridCompFinalize(wrtComp(i), importState=wrtstate(i),userRc=urc, rc=rc) + call ESMF_GridCompFinalize(wrtComp(i), importState=wrtState(i),userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return enddo diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 954531446..c11e45b4b 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -240,12 +240,14 @@ subroutine write_netcdf(wrtfb, filename, & ! coordinate variable attributes based on output_grid type if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon') then + trim(output_grid(grid_id)) == 'regional_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "T-cell latiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon') then + else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "rotated T-cell longiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "degrees"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "rotated T-cell latiitude"); NC_ERR_STOP(ncerr) @@ -489,9 +491,11 @@ subroutine write_netcdf(wrtfb, filename, & allocate (x(im)) if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon') then + trim(output_grid(grid_id)) == 'regional_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving') then ncerr = nf90_put_var(ncid, im_varid, values=array_r8(:,jstart), start=[istart], count=[iend-istart+1]); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon') then + else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') then do i=1,im x(i) = lon1(grid_id) + (lon2(grid_id)-lon1(grid_id))/(im-1) * (i-1) end do @@ -538,9 +542,11 @@ subroutine write_netcdf(wrtfb, filename, & allocate (y(jm)) if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon') then + trim(output_grid(grid_id)) == 'regional_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving') then ncerr = nf90_put_var(ncid, jm_varid, values=array_r8(istart,:), start=[jstart], count=[jend-jstart+1]); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon') then + else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') then do j=1,jm y(j) = lat1(grid_id) + (lat2(grid_id)-lat1(grid_id))/(jm-1) * (j-1) end do diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index d687d803d..bf140a1ac 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -8,7 +8,7 @@ module module_wrt_grid_comp !*** At initialization step, write grid is defined. The forecast field !*** bundle is mirrored and output field information inside the field !*** bundle is used to create ESMF field on the write grid and added in -!*** the mirror field bundle on write grid component. Also the IO_BaseTime +!*** the output field bundle on write grid component. Also the IO_BaseTime !*** is set to the initial clock time. !*** At the run step, output time is set from the write grid comp clock !*** the ESMF field bundles that contains the data on write grid are @@ -101,8 +101,16 @@ subroutine SetServices(wrt_comp, rc) rc = ESMF_SUCCESS - call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, & - userRoutine=wrt_initialize, rc=rc) + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, phase=1, & + userRoutine=wrt_initialize_p1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, phase=2, & + userRoutine=wrt_initialize_p2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, phase=3, & + userRoutine=wrt_initialize_p3, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_RUN, & @@ -119,7 +127,7 @@ end subroutine SetServices !####################################################################### !----------------------------------------------------------------------- ! - subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) + subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! !----------------------------------------------------------------------- !*** INITIALIZE THE WRITE GRIDDED COMPONENT. @@ -143,6 +151,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) integer :: vm_mpi_comm character(40) :: fieldName type(ESMF_Config) :: cf, cf_output_grid + type(ESMF_Info) :: info type(ESMF_DELayout) :: delayout type(ESMF_Grid) :: fcstGrid type(ESMF_Grid), allocatable :: wrtGrid(:) @@ -151,11 +160,11 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) type(ESMF_StateItem_Flag), allocatable :: fcstItemTypeList(:) - type(ESMF_FieldBundle) :: fcstFB, fieldbundle + type(ESMF_FieldBundle) :: fcstFB, fieldbundle, mirrorFB type(ESMF_Field), allocatable :: fcstField(:) type(ESMF_TypeKind_Flag) :: typekind character(len=80), allocatable :: fieldnamelist(:) - integer :: fieldDimCount, gridDimCount + integer :: fieldDimCount, gridDimCount, tk integer, allocatable :: petMap(:) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: ungriddedLBound(:) @@ -167,6 +176,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) integer :: valueI4 real(ESMF_KIND_R4) :: valueR4 real(ESMF_KIND_R8) :: valueR8 + logical, allocatable :: is_moving(:) integer :: attCount, jidx, idx, noutfile character(19) :: newdate @@ -235,7 +245,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) !*** get configuration variables !----------------------------------------------------------------------- ! - call esmf_GridCompGet(gridcomp=wrt_comp,config=CF,rc=RC) + call ESMF_GridCompGet(gridcomp=wrt_comp,config=CF,rc=RC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! variables for post @@ -295,6 +305,11 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) enddo endif + call ESMF_InfoGetFromHost(imp_state_write, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & name="ngrids", value=ngrids, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -365,13 +380,13 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) jtasks = ntasks endif - if(trim(output_grid(n)) == 'gaussian_grid' .or. trim(output_grid(n)) == 'global_latlon') then + if (trim(output_grid(n)) == 'gaussian_grid' .or. trim(output_grid(n)) == 'global_latlon') then call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:',rc=rc) call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='jmo:',rc=rc) if (lprnt) then print *,'imo=',imo(n),'jmo=',jmo(n) end if - else if(trim(output_grid(n)) == 'regional_latlon') then + else if (trim(output_grid(n)) == 'regional_latlon') then call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:',rc=rc) call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:',rc=rc) call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon2(n), label ='lon2:',rc=rc) @@ -398,10 +413,21 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) imo(n) = (lon2(n)-lon1(n))/dlon(n) + 1 jmo(n) = (lat2(n)-lat1(n))/dlat(n) + 1 if (lprnt) then - print *,'lon1=',lon1(n),' lat1=',lat1(n) - print *,'lon2=',lon2(n),' lat2=',lat2(n) - print *,'dlon=',dlon(n),' dlat=',dlat(n) + print *,'cen_lon=',cen_lon(n),' cen_lat=',cen_lat(n) + print *,'lon1 =',lon1(n), ' lat1 =',lat1(n) + print *,'lon2 =',lon2(n), ' lat2 =',lat2(n) + print *,'dlon =',dlon(n), ' dlat =',dlat(n) + print *,'imo =',imo(n), ' jmo =',jmo(n) + end if + else if (trim(output_grid(n)) == 'rotated_latlon_moving' .or. & + trim(output_grid(n)) == 'regional_latlon_moving') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='jmo:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:',rc=rc) + if (lprnt) then print *,'imo =',imo(n), ' jmo =',jmo(n) + print *,'dlon=',dlon(n),' dlat=',dlat(n) end if else if (trim(output_grid(n)) == 'lambert_conformal') then call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lon(n), label ='cen_lon:',rc=rc) @@ -683,8 +709,10 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) deallocate(lat, lon) - else if ( trim(output_grid(n)) == 'regional_latlon' .or. & - trim(output_grid(n)) == 'rotated_latlon' .or. & + else if ( trim(output_grid(n)) == 'regional_latlon' .or. & + trim(output_grid(n)) == 'regional_latlon_moving' .or. & + trim(output_grid(n)) == 'rotated_latlon' .or. & + trim(output_grid(n)) == 'rotated_latlon_moving' .or. & trim(output_grid(n)) == 'lambert_conformal' ) then wrtGrid(n) = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), & @@ -713,6 +741,9 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) enddo enddo wrt_int_state%post_maptype = 0 + else if ( trim(output_grid(n)) == 'regional_latlon_moving' ) then + ! Do not compute lonPtr, latPtr here. Will be done in the run phase + wrt_int_state%post_maptype = 0 else if ( trim(output_grid(n)) == 'rotated_latlon' ) then do j=lbound(lonPtr,2),ubound(lonPtr,2) do i=lbound(lonPtr,1),ubound(lonPtr,1) @@ -725,6 +756,9 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) enddo enddo wrt_int_state%post_maptype = 207 + else if ( trim(output_grid(n)) == 'rotated_latlon_moving' ) then + ! Do not compute lonPtr, latPtr here. Will be done in the run phase + wrt_int_state%post_maptype = 207 else if ( trim(output_grid(n)) == 'lambert_conformal' ) then lon1_r8 = dble(lon1(n)) lat1_r8 = dble(lat1(n)) @@ -773,8 +807,8 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) else - write(0,*)"wrt_initialize: Unknown output_grid ", trim(output_grid(n)) - call ESMF_LogWrite("wrt_initialize: Unknown output_grid "//trim(output_grid(n)),ESMF_LOGMSG_ERROR,rc=RC) + write(0,*)"wrt_initialize_p1: Unknown output_grid ", trim(output_grid(n)) + call ESMF_LogWrite("wrt_initialize_p1: Unknown output_grid "//trim(output_grid(n)),ESMF_LOGMSG_ERROR,rc=RC) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif @@ -806,7 +840,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (lprnt) print *,'in wrt initial, with iau, io_baseline time=',idate,'rc=',rc endif ! -!--- Look at the incoming FieldBundles in the imp_state_write, and mirror them +!--- Look at the incoming FieldBundles in the imp_state_write, and mirror them as 'output_' bundles ! call ESMF_StateGet(imp_state_write, itemCount=FBCount, rc=rc) @@ -845,27 +879,39 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) name="grid_id", value=grid_id, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -!--- check grid dim count first +!--- get grid dim count call ESMF_GridGet(wrtGrid(grid_id), dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! create a mirror FieldBundle and add it to importState - fieldbundle = ESMF_FieldBundleCreate(name="mirror_"//trim(fcstItemNameList(i)), rc=rc) - +! create a mirrored 'output_' FieldBundle and add it to importState + fieldbundle = ESMF_FieldBundleCreate(name="output_"//trim(fcstItemNameList(i)), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_StateAdd(imp_state_write, (/fieldbundle/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! copy the fcstFB Attributes to the mirror FieldBundle +! copy the fcstFB Attributes to the 'output_' FieldBundle call ESMF_AttributeCopy(fcstFB, fieldbundle, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) +! grids in fcstFB for which 'is_moving' is .true. must provide a first level mirror for the Redist() target + if (is_moving(grid_id)) then + +! create a mirrored 'mirror_' FieldBundle and add it to importState + mirrorFB = ESMF_FieldBundleCreate(name="mirror_"//trim(fcstItemNameList(i)), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateAdd(imp_state_write, (/mirrorFB/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +! copy the fcstFB Attributes to the 'mirror_' FieldBundle + call ESMF_AttributeCopy(fcstFB, mirrorFB, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + endif + +! deal with all of the Fields inside this fcstFB + call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (fieldCount > 0) then @@ -901,7 +947,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! create the mirror field +! create the output field call ESMF_LogWrite("call field create on wrt comp",ESMF_LOGMSG_INFO,rc=RC) field_work = ESMF_FieldCreate(wrtGrid(grid_id), typekind, name=fieldName, & @@ -931,11 +977,35 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! if (lprnt) print *,' i=',i,' j=',j,' outfilename=',trim(outfilename(j,i)) -! add the mirror field to the mirror FieldBundle +! add the output field to the 'output_' FieldBundle call ESMF_FieldBundleAdd(fieldbundle, (/field_work/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! deal with grids for which 'is_moving' is .true. + if (is_moving(grid_id)) then + ! create an empty field that will serve as acceptor for GridTransfer of fcstGrid + field_work = ESMF_FieldEmptyCreate(name=fieldName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! use attributes to carry information for later FieldEmptyComplete() + call ESMF_InfoGetFromHost(field_work, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + tk = typekind ! convert TypeKind_Flag to integer + call ESMF_InfoSet(info, key="typekind", value=tk, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoSet(info, key="gridToFieldMap", values=gridToFieldMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoSet(info, key="ungriddedLBound", values=ungriddedLBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoSet(info, key="ungriddedUBound", values=ungriddedUBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! add to 'mirror_' FieldBundle + call ESMF_FieldBundleAdd(mirrorFB, (/field_work/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + endif + ! local garbage collection deallocate(gridToFieldMap, ungriddedLBound, ungriddedUBound) enddo @@ -975,12 +1045,12 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) do n=1, FBcount - call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(n)), & + call ESMF_StateGet(imp_state_write, itemName="output_"//trim(fcstItemNameList(n)), & fieldbundle=fcstFB, rc=rc) if( index(trim(fcstItemNameList(n)),trim(FBlist_outfilename(i))) == 1 ) then ! -! copy the mirror fcstfield bundle Attributes to the output field bundle +! copy the fcstfield bundle Attributes to the output field bundle call ESMF_AttributeCopy(fcstFB, wrt_int_state%wrtFB(i), & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) @@ -1045,9 +1115,11 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="jm", value=jmo(grid_id), rc=rc) - else if (trim(output_grid(grid_id)) == 'regional_latlon' & + else if (trim(output_grid(grid_id)) == 'regional_latlon' & + .or. trim(output_grid(grid_id)) == 'regional_latlon_moving' & .or. trim(output_grid(grid_id)) == 'global_latlon') then + ! for 'regional_latlon_moving' lon1/2 and lat1/2 will be overwritten in run phase call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="latlon", rc=rc) call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1065,7 +1137,8 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="dlat", value=dlat(grid_id), rc=rc) - else if (trim(output_grid(grid_id)) == 'rotated_latlon') then + else if (trim(output_grid(grid_id)) == 'rotated_latlon' & + .or. trim(output_grid(grid_id)) == 'rotated_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="rotated_latlon", rc=rc) @@ -1078,6 +1151,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) "lat2 ",& "dlon ",& "dlat "/), rc=rc) + ! for 'rotated_latlon_moving' cen_lon and cen_lat will be overwritten in run phase call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="cen_lon", value=cen_lon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1381,7 +1455,198 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! !----------------------------------------------------------------------- ! - end subroutine wrt_initialize + end subroutine wrt_initialize_p1 +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine wrt_initialize_p2(wrt_comp, imp_state_write, exp_state_write, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE WRITE GRIDDED COMPONENT. +!----------------------------------------------------------------------- +! + type(esmf_GridComp) :: wrt_comp + type(ESMF_State) :: imp_state_write, exp_state_write + type(esmf_Clock) :: clock + integer,intent(out) :: rc +! +!*** LOCAL VARIABLES + type(ESMF_Info) :: info + logical, allocatable :: is_moving(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) + character(len=ESMF_MAXSTR),allocatable :: itemNameList(:) + integer :: i, j, bundleCount, fieldCount + type(ESMF_FieldBundle) :: mirrorFB + type(ESMF_Field), allocatable :: fieldList(:) + type(ESMF_Grid) :: grid + type(ESMF_DistGrid) :: acceptorDG, newAcceptorDG +! +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + rc = ESMF_SUCCESS +! + call ESMF_InfoGetFromHost(imp_state_write, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(imp_state_write, itemCount=bundleCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate(itemNameList(bundleCount), itemTypeList(bundleCount)) + + call ESMF_StateGet(imp_state_write, itemNameList=itemNameList, & + itemTypeList=itemTypeList, & + !itemorderflag=ESMF_ITEMORDER_ADDORDER, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do i=1, bundleCount + + if (itemTypeList(i) == ESMF_STATEITEM_FIELDBUNDLE) then + + if (index(trim(itemNameList(i)), "mirror_")==1) then + ! this is a 'mirror_' FieldBundle -> GridTransfer acceptor side + call ESMF_StateGet(imp_state_write, itemName=trim(itemNameList(i)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the grid that is passed in from the provider side + call ESMF_FieldBundleGet(mirrorFB, grid=grid, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the acceptor DistGrid + call ESMF_GridGet(grid, distgrid=acceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! rebalance the acceptor DistGrid across the local PETs + newAcceptorDG = ESMF_DistGridCreate(acceptorDG, balanceflag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! create a new Grid on the rebalanced DistGrid + grid = ESMF_GridCreate(newAcceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! point all of the acceptor fields to the new acceptor Grid + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirrorFB, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + do j=1, fieldCount + call ESMF_FieldEmptySet(fieldList(j), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + ! clean-up + deallocate(fieldList) + endif + + else ! anything but a FieldBundle in the state is unexpected here + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Only FieldBundles supported in fcstState.", line=__LINE__, file=__FILE__) + return + endif + + enddo + +!----------------------------------------------------------------------- +! + end subroutine wrt_initialize_p2 +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine wrt_initialize_p3(wrt_comp, imp_state_write, exp_state_write, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE WRITE GRIDDED COMPONENT. +!----------------------------------------------------------------------- +! + type(esmf_GridComp) :: wrt_comp + type(ESMF_State) :: imp_state_write, exp_state_write + type(esmf_Clock) :: clock + integer,intent(out) :: rc +!*** LOCAL VARIABLES + type(ESMF_Info) :: info + logical, allocatable :: is_moving(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) + character(len=ESMF_MAXSTR),allocatable :: itemNameList(:) + integer :: i, j, bundleCount, fieldCount + type(ESMF_FieldBundle) :: mirrorFB + type(ESMF_Field), allocatable :: fieldList(:) + type(ESMF_TypeKind_Flag) :: typekind + integer :: tk + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: ungriddedLBound(:) + integer, allocatable :: ungriddedUBound(:) + +! +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + rc = ESMF_SUCCESS +! + call ESMF_InfoGetFromHost(imp_state_write, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(imp_state_write, itemCount=bundleCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate(itemNameList(bundleCount), itemTypeList(bundleCount)) + + call ESMF_StateGet(imp_state_write, itemNameList=itemNameList, & + itemTypeList=itemTypeList, & + !itemorderflag=ESMF_ITEMORDER_ADDORDER, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do i=1, bundleCount + + if (itemTypeList(i) == ESMF_STATEITEM_FIELDBUNDLE) then + + if (index(trim(itemNameList(i)), "mirror_")==1) then + ! this is a 'mirror_' FieldBundle -> GridTransfer acceptor side + call ESMF_StateGet(imp_state_write, itemName=trim(itemNameList(i)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! finish creating all the mirror Fields + call ESMF_FieldBundleGet(mirrorFB, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirrorFB, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + do j=1, fieldCount + ! first access information stored on the field needed for completion + call ESMF_InfoGetFromHost(fieldList(j), info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGet(info, key="typekind", value=tk, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + typekind = tk ! convert integer into TypeKind_Flag + call ESMF_InfoGetAlloc(info, key="gridToFieldMap", values=gridToFieldMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="ungriddedLBound", values=ungriddedLBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="ungriddedUBound", values=ungriddedUBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! now complete the field creation + call ESMF_FieldEmptyComplete(fieldList(j), typekind=typekind, gridToFieldMap=gridToFieldMap, & + ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + ! clean-up + deallocate(fieldList) + endif + + else ! anything but a FieldBundle in the state is unexpected here + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Only FieldBundles supported in fcstState.", line=__LINE__, file=__FILE__) + return + endif + + enddo + +!----------------------------------------------------------------------- +! + end subroutine wrt_initialize_p3 ! !----------------------------------------------------------------------- !####################################################################### @@ -1402,18 +1667,22 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !*** local variables ! TYPE(ESMF_VM) :: VM - type(ESMF_FieldBundle) :: file_bundle + type(ESMF_FieldBundle) :: file_bundle, mirror_bundle + type(ESMF_StateItem_Flag) :: itemType type(ESMF_Time) :: currtime type(ESMF_TimeInterval) :: io_currtimediff type(ESMF_Grid) :: fbgrid, wrtGrid type(ESMF_State),save :: stateGridFB type(optimizeT), save :: optimize(4) type(ESMF_GridComp), save, allocatable :: compsGridFB(:) + type(ESMF_RouteHandle) :: rh + type(ESMF_RegridMethod_Flag) :: regridmethod + integer :: srcTermProcessing ! type(write_wrap) :: wrap type(wrt_internal_state),pointer :: wrt_int_state ! - integer :: i,j,n,mype,nolog, grid_id + integer :: i,j,n,mype,nolog, grid_id, localPet ! integer :: nf_hours,nf_seconds,nf_minutes real(ESMF_KIND_R8) :: nfhour @@ -1424,10 +1693,30 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) logical :: opened logical :: lmask_fields ! - character(esmf_maxstr) :: filename,compname + character(esmf_maxstr) :: filename,compname, traceString character(40) :: cfhour, cform character(20) :: time_iso ! + type(ESMF_Grid) :: grid + type(ESMF_Info) :: info + real(ESMF_KIND_R8), allocatable :: values(:) + character(160) :: msgString + type(ESMF_Field), allocatable :: fieldList(:) + type(ESMF_Array) :: coordArray(2) + type(ESMF_DistGrid) :: coordDG + type(ESMF_DELayout) :: coordDL + integer :: fieldCount, deCount, rootPet + integer :: minIndexPTile(2,1), maxIndexPTile(2,1), centerIndex(2) + integer, allocatable :: minIndexPDe(:,:), maxIndexPDe(:,:), petMap(:) + real(ESMF_KIND_R8), pointer :: farrayPtr(:,:) + real(ESMF_KIND_R8) :: centerCoord(2) + + integer :: ii, jj + real(ESMF_KIND_R8), pointer :: lonPtr(:,:), latPtr(:,:) + real(ESMF_KIND_R8) :: rot_lon, rot_lat + real(ESMF_KIND_R8) :: geo_lon, geo_lat + real(ESMF_KIND_R8), parameter :: rtod=180.0/pi + real(kind=8) :: MPI_Wtime real(kind=8) :: tbeg real(kind=8) :: wbeg,wend @@ -1445,7 +1734,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !----------------------------------------------------------------------- !*** get the current write grid comp name, and internal state ! - call ESMF_GridCompGet(wrt_comp, name=compname, rc=rc) + call ESMF_GridCompGet(wrt_comp, name=compname, localPet=localPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! Provide log message indicating which wrtComp is active @@ -1505,14 +1794,185 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if(lprnt) print *,'in wrt run, nfhour=',nfhour,' cfhour=',trim(cfhour) ! !----------------------------------------------------------------------- -!*** loop on the files that need to write out +!*** loop on the "output_" FieldBundles, i.e. files that need to write out !----------------------------------------------------------------------- do i=1, FBCount - call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & + call ESMF_StateGet(imp_state_write, itemName="output_"//trim(fcstItemNameList(i)), & fieldbundle=file_bundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! see whether a "mirror_" FieldBundle exists, i.e. dealing with moving domain that needs updated Regrid() here. + call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & + itemType=itemType, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (itemType == ESMF_STATEITEM_FIELDBUNDLE) then + ! Regrid() for a moving domain + call ESMF_LogWrite("Regrid() for moving domain: mirror_"//trim(fcstItemNameList(i)), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & + fieldbundle=mirror_bundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! Find the centerCoord of the moving domain + + call ESMF_FieldBundleGet(mirror_bundle, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirror_bundle, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(fieldList(1), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + deallocate(fieldList) + + call ESMF_GridGetCoord(grid, coordDim=1, array=coordArray(1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=2, array=coordArray(2), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(coordArray(1), distgrid=coordDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_DistGridGet(coordDG, deCount=deCount, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, & + delayout=coordDL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(petMap(deCount),minIndexPDe(2,deCount), maxIndexPDe(2,deCount)) + call ESMF_DELayoutGet(coordDL, petMap=petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_DistGridGet(coordDG, minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + centerIndex(1) = (maxIndexPTile(1,1)-minIndexPTile(1,1)+1)/2 + centerIndex(2) = (maxIndexPTile(2,1)-minIndexPTile(2,1)+1)/2 + +! write(msgString,*) "Determined centerIndex: ", centerIndex +! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do n=1, deCount + if (minIndexPDe(1,n)<=centerIndex(1) .and. centerIndex(1)<=maxIndexPDe(1,n) .and. & + minIndexPDe(2,n)<=centerIndex(2) .and. centerIndex(2)<=maxIndexPDe(2,n)) then + ! found the DE that holds the center coordinate + rootPet = petMap(n) + if (localPet == rootPet) then + ! center DE is on local PET -> fill centerCoord locally + call ESMF_ArrayGet(coordArray(1), farrayPtr=farrayPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + centerCoord(1) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) + call ESMF_ArrayGet(coordArray(2), farrayPtr=farrayPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + centerCoord(2) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) +! write(msgString,*) "Found centerCoord: ", centerCoord +! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + exit + endif + enddo + + deallocate(petMap,minIndexPDe,maxIndexPDe) + + call ESMF_VMBroadcast(vm, centerCoord, count=2, rootPet=rootPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(msgString,*) "All PETs know centerCoord in radians: ", centerCoord + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! determine regridmethod + if (index(fcstItemNameList(i),"_bilinear") >0 ) then + traceString = "-bilinear" + regridmethod = ESMF_REGRIDMETHOD_BILINEAR + else if (index(fcstItemNameList(i),"_patch") >0) then + traceString = "-patch" + regridmethod = ESMF_REGRIDMETHOD_PATCH + else if (index(fcstItemNameList(i),"_nearest_stod") >0) then + traceString = "-nearest_stod" + regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD + else if (index(fcstItemNameList(i),"_nearest_dtos") >0) then + traceString = "-nearest_dtos" + regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS + else if (index(fcstItemNameList(i),"_conserve") >0) then + traceString = "-conserve" + regridmethod = ESMF_REGRIDMETHOD_CONSERVE + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unable to determine regrid method.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + srcTermProcessing = 1 ! have this fixed for bit-for-bit reproducibility + ! RegridStore() + + ! update output grid coordinates based of fcstgrid center lat/lon + call ESMF_FieldBundleGet(file_bundle, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=1, farrayPtr=lonPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=2, farrayPtr=latPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeGet(mirror_bundle, convention="NetCDF", purpose="FV3", & + name="grid_id", value=grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (trim(output_grid(grid_id)) == 'regional_latlon_moving' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + n = grid_id + cen_lon(n) = centerCoord(1)*rtod + cen_lat(n) = centerCoord(2)*rtod + if (cen_lon(n) > 180.0) cen_lon(n) = cen_lon(n) - 360.0 + cen_lon(n) = NINT(cen_lon(n)*1000.0)/1000.0 + cen_lat(n) = NINT(cen_lat(n)*1000.0)/1000.0 + endif + + if (trim(output_grid(grid_id)) == 'regional_latlon_moving') then + lon1(n) = cen_lon(n) - 0.5 * (imo(n)-1) * dlon(n) + lat1(n) = cen_lat(n) - 0.5 * (jmo(n)-1) * dlat(n) + lon2(n) = cen_lon(n) + 0.5 * (imo(n)-1) * dlon(n) + lat2(n) = cen_lat(n) + 0.5 * (jmo(n)-1) * dlat(n) + do jj=lbound(lonPtr,2),ubound(lonPtr,2) + do ii=lbound(lonPtr,1),ubound(lonPtr,1) + lonPtr(ii,jj) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) + latPtr(ii,jj) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) + enddo + enddo + else if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + lon1(n) = - 0.5 * (imo(n)-1) * dlon(n) + lat1(n) = - 0.5 * (jmo(n)-1) * dlat(n) + lon2(n) = 0.5 * (imo(n)-1) * dlon(n) + lat2(n) = 0.5 * (jmo(n)-1) * dlat(n) + do jj=lbound(lonPtr,2),ubound(lonPtr,2) + do ii=lbound(lonPtr,1),ubound(lonPtr,1) + rot_lon = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) + rot_lat = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) + if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 + lonPtr(ii,jj) = geo_lon + latPtr(ii,jj) = geo_lat + enddo + enddo + endif + + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) + call ESMF_FieldBundleRegridStore(mirror_bundle, file_bundle, & + regridMethod=regridmethod, routehandle=rh, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + srcTermProcessing=srcTermProcessing, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) + ! Regrid() + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegrid()"//trim(traceString), rc=rc) + call ESMF_FieldBundleRegrid(mirror_bundle, file_bundle, & + routehandle=rh, termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_FieldBundleRegrid()"//trim(traceString), rc=rc) + ! RegridRelease() + call ESMF_FieldBundleRegridRelease(routehandle=rh, noGarbage=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! done + call ESMF_LogWrite("Done Regrid() for moving domain: mirror_"//trim(fcstItemNameList(i)), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + !recover fields from cartesian vector and sfc pressure call recover_fields(file_bundle,rc) enddo @@ -1559,6 +2019,44 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) name="grid_id", value=grid_id, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! update lon1/2 and lat1/2 for regional_latlon_moving + if (trim(output_grid(grid_id)) == 'regional_latlon_moving') then + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon1", value=lon1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat1", value=lat1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon2", value=lon2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat2", value=lat2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + ! update cen_lon/cen_lat, lon1/2 and lat1/2 for rotated_latlon_moving + if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lon", value=cen_lon(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lat", value=cen_lat(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon1", value=lon1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat1", value=lat1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon2", value=lon2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat2", value=lat2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + if(step == 1) then file_bundle = wrt_int_state%wrtFB(nbdl) endif @@ -1683,8 +2181,10 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ,' at Fcst ',NF_HOURS,':',NF_MINUTES endif - else if (trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + else if (trim(output_grid(grid_id)) == 'regional_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving' .or. & trim(output_grid(grid_id)) == 'lambert_conformal') then !mask fields according to sfc pressure diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 110aed93d..886f23a23 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -17,6 +17,7 @@ module module_fcst_grid_comp ! use mpi use esmf + use nuopc use time_manager_mod, only: time_type, set_calendar_type, set_time, & set_date, month_name, & @@ -41,7 +42,7 @@ module module_fcst_grid_comp use fms_mod, only: error_mesg, fms_init, fms_end, & write_version_number, uppercase - use mpp_mod, only: mpp_init, mpp_pe, mpp_npes, mpp_root_pe, & + use mpp_mod, only: mpp_init, mpp_pe, mpp_npes, mpp_root_pe, mpp_set_current_pelist, & mpp_error, FATAL, WARNING, NOTE use mpp_mod, only: mpp_clock_id, mpp_clock_begin @@ -64,10 +65,16 @@ module module_fcst_grid_comp use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, & nbdlphys, iau_offset use module_fv3_config, only: dt_atmos, fcst_mpi_comm, fcst_ntasks, & - quilting, calendar, & + quilting, calendar, cpl_grid_id, & cplprint_flag, restart_endfcst use get_stochy_pattern_mod, only: write_stoch_restart_atm + use module_cplfields, only: nExportFields, exportFields, exportFieldsInfo, & + nImportFields, importFields, importFieldsInfo + use module_cplfields, only: realizeConnectedCplFields + + use atmos_model_mod, only: setup_exportdata + use CCPP_data, only: GFS_control ! !----------------------------------------------------------------------- ! @@ -82,9 +89,7 @@ module module_fcst_grid_comp type(atmos_data_type), save :: Atmos type(ESMF_GridComp),dimension(:),allocatable :: fcstGridComp - type(ESMF_Grid), dimension(:),allocatable :: fcstGrid integer :: ngrids, mygrid - integer,dimension(:),allocatable :: grid_number_on_all_pets(:) integer :: intrm_rst, n_atmsteps @@ -100,8 +105,7 @@ module module_fcst_grid_comp ! !----------------------------------------------------------------------- ! - public SetServices, fcstGrid, ngrids, mygrid, grid_number_on_all_pets - public numLevels, numSoilLayers, numTracers + public SetServices ! contains ! @@ -117,7 +121,13 @@ subroutine SetServices(fcst_comp, rc) rc = ESMF_SUCCESS call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_INITIALIZE, & - userRoutine=fcst_initialize, rc=rc) + userRoutine=fcst_initialize, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_INITIALIZE, & + userRoutine=fcst_advertise, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_INITIALIZE, & + userRoutine=fcst_realize, phase=3, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_RUN, & @@ -151,6 +161,9 @@ subroutine SetServicesNest(nest, rc) integer,dimension(2,6):: decomptile !define delayout for the 6 cubed-sphere tiles integer,dimension(2) :: regdecomp !define delayout for the nest grid type(ESMF_Decomp_Flag):: decompflagPTile(2,6) + character(3) :: myGridStr + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: array rc = ESMF_SUCCESS @@ -160,6 +173,12 @@ subroutine SetServicesNest(nest, rc) call ESMF_GridCompSetEntryPoint(nest, ESMF_METHOD_INITIALIZE, userRoutine=init_phys_fb, phase=2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompSetEntryPoint(nest, ESMF_METHOD_INITIALIZE, userRoutine=init_advertise, phase=3, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(nest, ESMF_METHOD_INITIALIZE, userRoutine=init_realize, phase=4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompGet(nest, name=name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -203,6 +222,69 @@ subroutine SetServicesNest(nest, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif + ! - Create coordinate arrays around allocations held within Atmos data structure and set in Grid + + call ESMF_GridGet(grid, staggerloc=ESMF_STAGGERLOC_CENTER, distgrid=distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lon, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lat, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridGet(grid, staggerloc=ESMF_STAGGERLOC_CORNER, distgrid=distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lon_bnd, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lat_bnd, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + !TODO: Consider aligning mask treatment with coordinates... especially if it requires updates for moving + call addLsmask2grid(grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! - Add Attributes used by output + + call ESMF_AttributeAdd(grid, convention="NetCDF", purpose="FV3", & + attrList=(/"ESMF:gridded_dim_labels"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(grid, convention="NetCDF", purpose="FV3", & + name="ESMF:gridded_dim_labels", valueList=(/"grid_xt", "grid_yt"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +!test to write out vtk file: +! if( cplprint_flag ) then +! call ESMF_GridWriteVTK(grid, staggerloc=ESMF_STAGGERLOC_CENTER, & +! filename='fv3cap_fv3Grid', rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! endif +! +! Write grid to netcdf file + if( cplprint_flag ) then + write (myGridStr,"(I0)") mygrid + call wrt_fcst_grid(grid, "diagnostic_FV3_fcstGrid"//trim(mygridStr)//".nc", & + regridArea=.TRUE., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + ! - Hold on to the grid by GridComp + call ESMF_GridCompSet(nest, grid=grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -306,6 +388,85 @@ end subroutine init_phys_fb !----------------------------------------------------------------------- !####################################################################### !----------------------------------------------------------------------- +! + subroutine init_advertise(nest, importState, exportState, clock, rc) +! + type(ESMF_GridComp) :: nest + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables +! + integer :: i + + rc = ESMF_SUCCESS +! + ! importable fields: + do i = 1, size(importFieldsInfo) + call NUOPC_Advertise(importState, & + StandardName=trim(importFieldsInfo(i)%name), & + SharePolicyField='share', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do + + ! exportable fields: + do i = 1, size(exportFieldsInfo) + call NUOPC_Advertise(exportState, & + StandardName=trim(exportFieldsInfo(i)%name), & + SharePolicyField='share', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do + +! +!----------------------------------------------------------------------- +! + end subroutine init_advertise +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine init_realize(nest, importState, exportState, clock, rc) +! + type(ESMF_GridComp) :: nest + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables +! + type(ESMF_Grid) :: grid + + rc = ESMF_SUCCESS +! + ! access this domain grid + call ESMF_GridCompGet(nest, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! -- realize connected fields in exportState + call realizeConnectedCplFields(exportState, grid, & + numLevels, numSoilLayers, numTracers, & + exportFieldsInfo, 'FV3 Export', exportFields, 0.0_ESMF_KIND_R8, 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, grid, & + numLevels, numSoilLayers, numTracers, & + importFieldsInfo, 'FV3 Import', importFields, 9.99e20_ESMF_KIND_R8, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! +!----------------------------------------------------------------------- +! + end subroutine init_realize +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- ! subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! @@ -345,7 +506,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) type(ESMF_DELayout) :: delayout type(ESMF_DistGrid) :: distgrid - real(ESMF_KIND_R8),dimension(:,:), pointer :: glatPtr, glonPtr integer :: jsc, jec, isc, iec, nlev type(domain2D) :: domain integer :: n, fcstNpes, tmpvar, k @@ -353,7 +513,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) integer, allocatable, dimension(:) :: isl, iel, jsl, jel integer, allocatable, dimension(:,:,:) :: deBlockList integer, allocatable, dimension(:) :: petListNest - integer :: tlb(2), tub(2) integer :: globalTileLayout(2) integer :: nestRootPet, peListSize(1) @@ -374,6 +533,8 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) type(time_type) :: iautime integer :: io_unit, calendar_type_res, date_res(6), date_init_res(6) + integer,allocatable :: grid_number_on_all_pets(:) + logical,allocatable :: is_moving_on_all_pets(:), is_moving(:) ! !----------------------------------------------------------------------- !*********************************************************************** @@ -579,7 +740,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if ( ANY(frestart(:) == total_inttime) ) restart_endfcst = .true. ! frestart only contains intermediate restart do i=1,size(frestart) - if(frestart(i) == total_inttime) then + if(frestart(i) == total_inttime) then frestart(i) = 0 exit endif @@ -620,12 +781,24 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ngrids = Atmos%ngrids mygrid = Atmos%mygrid - allocate(grid_number_on_all_pets(fcst_ntasks)) + allocate(grid_number_on_all_pets(fcst_ntasks), is_moving_on_all_pets(fcst_ntasks)) call mpi_allgather(mygrid, 1, MPI_INTEGER, & grid_number_on_all_pets, 1, MPI_INTEGER, & fcst_mpi_comm, rc) + call mpi_allgather(Atmos%is_moving_nest, 1, MPI_LOGICAL, & + is_moving_on_all_pets, 1, MPI_LOGICAL, & + fcst_mpi_comm, rc) + allocate(is_moving(ngrids)) + do n=1, fcst_ntasks + is_moving(grid_number_on_all_pets(n)) = is_moving_on_all_pets(n) + enddo + deallocate(grid_number_on_all_pets, is_moving_on_all_pets) - allocate (fcstGrid(ngrids),fcstGridComp(ngrids)) + call ESMF_InfoGetFromHost(exportState, info=info, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_InfoSet(info, key="is_moving", values=is_moving, rc=rc); ESMF_ERR_ABORT(rc) + deallocate(is_moving) + + allocate (fcstGridComp(ngrids)) do n=1,ngrids pelist => null() @@ -675,62 +848,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - deallocate(petListNest) end if - - if (ESMF_GridCompIsPetLocal(fcstGridComp(n), rc=rc)) then - call ESMF_GridCompGet(fcstGridComp(n), grid=fcstGrid(n), rc=rc); ESMF_ERR_ABORT(rc) - - call ESMF_GridAddCoord(fcstGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc); ESMF_ERR_ABORT(rc) - call ESMF_GridAddCoord(fcstGrid(n), staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc); ESMF_ERR_ABORT(rc) - - ! define "center" coordinate values - call ESMF_GridGetCoord(fcstGrid(n), coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, & - totalLBound=tlb, totalUBound=tub, & - farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) - glonPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lon(tlb(1):tub(1),tlb(2):tub(2)) - - call ESMF_GridGetCoord(fcstGrid(n), coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, & - totalLBound=tlb, totalUBound=tub, & - farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) - glatPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lat(tlb(1):tub(1),tlb(2):tub(2)) - - ! define "corner" coordinate values - call ESMF_GridGetCoord(fcstGrid(n), coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, & - totalLBound=tlb, totalUBound=tub, & - farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) - glonPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lon_bnd(tlb(1):tub(1),tlb(2):tub(2)) - - call ESMF_GridGetCoord(fcstGrid(n), coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, & - totalLBound=tlb, totalUBound=tub, & - farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) - glatPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lat_bnd(tlb(1):tub(1),tlb(2):tub(2)) - end if ! IsPetLocal - end do -! - !! FIXME - if ( .not. Atmos%nested ) then !! global only - call addLsmask2grid(fcstGrid(mygrid), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! print *,'call addLsmask2grid after fcstGrid, rc=',rc - endif - -!test to write out vtk file: -! if( cplprint_flag ) then -! call ESMF_GridWriteVTK(fcstGrid, staggerloc=ESMF_STAGGERLOC_CENTER, & -! filename='fv3cap_fv3Grid', rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! endif -! -! Write grid to netcdf file - if( cplprint_flag ) then - call wrt_fcst_grid(fcstGrid(mygrid), "diagnostic_FV3_fcstGrid.nc", & - regridArea=.TRUE., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif ! Add gridfile Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & @@ -759,21 +880,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name="top_parent_is_global", value=top_parent_is_global, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! Add dimension Attributes to Grid - do n=1,ngrids - if (ESMF_GridCompIsPetLocal(fcstGridComp(n), rc=rc)) then - - call ESMF_AttributeAdd(fcstGrid(n), convention="NetCDF", purpose="FV3", & - attrList=(/"ESMF:gridded_dim_labels"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fcstGrid(n), convention="NetCDF", purpose="FV3", & - name="ESMF:gridded_dim_labels", valueList=(/"grid_xt", "grid_yt"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - endif - end do - ! Add time Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & attrList=(/ "time ", & @@ -937,6 +1043,91 @@ end subroutine fcst_initialize !----------------------------------------------------------------------- !####################################################################### !----------------------------------------------------------------------- +! + subroutine fcst_advertise(fcst_comp, importState, exportState, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE FORECAST GRIDDED COMPONENT. +!----------------------------------------------------------------------- +! + type(esmf_GridComp) :: fcst_comp + type(ESMF_State) :: importState, exportState + type(esmf_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables + type(ESMF_VM) :: vm + integer :: mype + integer :: n + integer :: urc + +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + call ESMF_VMGetCurrent(vm=vm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm=vm, localPet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'fcst_advertise, cpl_grid_id=',cpl_grid_id + + call ESMF_GridCompInitialize(fcstGridComp(cpl_grid_id), importState=importState, & + exportState=exportState, phase=3, userrc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return +! +!----------------------------------------------------------------------- +! + end subroutine fcst_advertise +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine fcst_realize(fcst_comp, importState, exportState, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE FORECAST GRIDDED COMPONENT. +!----------------------------------------------------------------------- +! + type(esmf_GridComp) :: fcst_comp + type(ESMF_State) :: importState, exportState + type(esmf_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables + type(ESMF_VM) :: vm + integer :: mype + integer :: n + integer :: urc + +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + call ESMF_VMGetCurrent(vm=vm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm=vm, localPet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'fcst_realize, cpl_grid_id=',cpl_grid_id + + call ESMF_GridCompInitialize(fcstGridComp(cpl_grid_id), importState=importState, & + exportState=exportState, phase=4, userrc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return +! +! +!----------------------------------------------------------------------- +! + end subroutine fcst_realize +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- ! subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) ! @@ -979,7 +1170,8 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) call atmos_model_exchange_phase_1 (Atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (mype == 0) write(*,*)"PASS: fcstRUN phase 1, n_atmsteps = ",n_atmsteps, ' time is ', mpi_wtime()-tbeg1 + if (mype == 0) write(*,'(A,I16,A,F16.6)')'PASS: fcstRUN phase 1, n_atmsteps = ', & + n_atmsteps,' time is ',mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! @@ -1056,7 +1248,8 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) endif endif - if (mype == 0) write(*,*)"PASS: fcstRUN phase 2, n_atmsteps = ",n_atmsteps, ' time is ', mpi_wtime()-tbeg1 + if (mype == 0) write(*,'(A,I16,A,F16.6)')'PASS: fcstRUN phase 2, n_atmsteps = ', & + n_atmsteps,' time is ',mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! @@ -1100,8 +1293,9 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) if( restart_endfcst ) then call get_date (Atmos%Time, date(1), date(2), date(3), & date(4), date(5), date(6)) - call mpp_open( unit, 'RESTART/coupler.res', nohdrs=.TRUE. ) + call mpp_set_current_pelist() if (mpp_pe() == mpp_root_pe())then + call mpp_open( unit, 'RESTART/coupler.res', nohdrs=.TRUE. ) write( unit, '(i6,8x,a)' )calendar_type, & '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' @@ -1109,8 +1303,8 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) 'Model start time: year, month, day, hour, minute, second' write( unit, '(6i6,8x,a)' )date, & 'Current model time: year, month, day, hour, minute, second' + call mpp_close(unit) endif - call mpp_close(unit) endif call diag_manager_end (Atmos%Time) diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index 64522ec8e..bb3546772 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -17,6 +17,7 @@ module module_fv3_config integer :: first_kdt integer :: fcst_mpi_comm, fcst_ntasks ! + integer :: cpl_grid_id logical :: cplprint_flag logical :: quilting, output_1st_tstep_rst logical :: restart_endfcst