diff --git a/AdvCore_GridCompMod.F90 b/AdvCore_GridCompMod.F90 index c4ce159..922e45d 100755 --- a/AdvCore_GridCompMod.F90 +++ b/AdvCore_GridCompMod.F90 @@ -96,6 +96,18 @@ module AdvCore_GridCompMod public SetServices logical, allocatable, save :: grids_on_my_pe(:) +!! internal state + + type T_ETA_STATE + real(REAL8) :: ptop_r8 + real(REAL8) :: pint_r8 + real(REAL8), allocatable :: ak_r8(:) + real(REAL8), allocatable :: bk_r8(:) + end type T_ETA_STATE + + type ETA_WRAP + type (T_ETA_STATE), pointer :: eta_state + end type ETA_WRAP !EOP !------------------------------------------------------------------------------ @@ -130,6 +142,9 @@ subroutine SetServices(GC, rc) integer :: comm, ndt integer :: p_split=1 + type(T_ETA_STATE), pointer :: eta_state + type(ETA_wrap) :: EtaWrap + !============================================================================= ! Begin... @@ -137,12 +152,23 @@ subroutine SetServices(GC, rc) ! Get my name and set-up traceback handle ! --------------------------------------- - call ESMF_GridCompGet( GC, NAME=COMP_NAME, vm=vm, RC=STATUS ) - VERIFY_(STATUS) - Iam = trim(COMP_NAME) // 'SetServices' + call ESMF_GridCompGet( GC, NAME=COMP_NAME, vm=vm, RC=STATUS ) + VERIFY_(STATUS) + Iam = trim(COMP_NAME) // 'SetServices' -!BOS +! Allocate this instance of the internal state and put it in wrapper. +! ------------------------------------------------------------------- + allocate(eta_state, stat=status) + VERIFY_(STATUS) + EtaWrap%eta_state => eta_state +! Save pointer to the wrapped internal state in the GC +! ---------------------------------------------------- + + call ESMF_UserCompSetInternalState ( GC,'ETAstate',EtaWrap,status ) + VERIFY_(STATUS) + +!BOS ! !IMPORT STATE: ! call MAPL_AddImportSpec ( gc, & @@ -367,7 +393,11 @@ subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) integer :: IS, IE, JS, JE logical :: gridCreated type(ESMF_Grid) :: grid - + + character(len=ESMF_MAXSTR) :: eta_rc_file + type(T_ETA_STATE), pointer :: eta_state + type(ETA_wrap) :: EtaWrap + integer :: LM, ks ! Begin... ! Get the target components name and set-up traceback handle. @@ -414,6 +444,19 @@ subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) temp2d = FV_Atm(1)%gridstruct%area(IS:IE,JS:JE) endif + call ESMF_UserCompGetInternalState(gc, 'ETAstate', EtaWrap, status) + VERIFY_(STATUS) + eta_state => EtaWrap%eta_state + + call MAPL_Get( MAPL, LM=LM, RC = STATUS ) + allocate(eta_state%ak_r8(LM+1), eta_state%bk_r8(LM+1)) + call MAPL_GetResource(MAPL, eta_rc_file, label='ETA_RC_FILE:', default = 'None', rc = status) + if( trim(eta_rc_file) == 'None' ) then + call set_eta(LM,ks,eta_state%ptop_r8,eta_state%pint_r8,eta_state%ak_r8,eta_state%bk_r8) + else + call get_eta(trim(eta_rc_file), eta_state%ptop_r8,eta_state%pint_r8,eta_state%ak_r8,eta_state%bk_r8) + endif + call MAPL_TimerOff(MAPL,"INITIALIZE") call MAPL_TimerOff(MAPL,"TOTAL") @@ -473,7 +516,6 @@ subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) REAL(FVPRC), POINTER, DIMENSION(:,:,:) :: PLE1 REAL(FVPRC), POINTER, DIMENSION(:) :: AK REAL(FVPRC), POINTER, DIMENSION(:) :: BK - REAL(REAL8), allocatable :: ak_r8(:),bk_r8(:) REAL(FVPRC), POINTER, DIMENSION(:,:,:,:) :: TRACERS REAL(FVPRC) :: MASS1, TMASS1(ntracers) TYPE(AdvCoreTracers), POINTER :: advTracers(:) @@ -482,7 +524,8 @@ subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) type(ESMF_Array) :: array INTEGER :: IM, JM, LM, N, NQ, LS REAL(FVPRC) :: PTOP, PINT - REAL(REAL8) :: ptop_r8,pint_r8 + type(T_ETA_STATE), pointer :: eta_state + type(ETA_wrap) :: EtaWrap ! Temporaries for exports/tracers REAL, POINTER :: temp3D(:,:,:) real(REAL4), pointer :: tracer_r4 (:,:,:) @@ -535,15 +578,15 @@ subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) VERIFY_(STATUS) AllOCATE( BK(LM+1) ,stat=STATUS ) VERIFY_(STATUS) - AllOCATE( AK_r8(LM+1) ,stat=STATUS ) - VERIFY_(STATUS) - AllOCATE( BK_r8(LM+1) ,stat=STATUS ) + + call ESMF_UserCompGetInternalState(gc, 'ETAstate', EtaWrap, status) VERIFY_(STATUS) - call set_eta(LM,LS,ptop_r8,pint_r8,ak_r8,bk_r8) - ptop=ptop_r8 - pint=pint_r8 - ak=ak_r8 - bk=bk_r8 + eta_state => EtaWrap%eta_state + + ptop = eta_state%ptop_r8 + pint = eta_state%pint_r8 + ak = eta_state%ak_r8 + bk = eta_state%bk_r8 CALL MAPL_GetPointer(IMPORT, iPLE0, 'PLE0', ALLOC = .TRUE., RC=STATUS) VERIFY_(STATUS) diff --git a/DynCore_GridCompMod.F90 b/DynCore_GridCompMod.F90 index 80b31f4..2e41827 100644 --- a/DynCore_GridCompMod.F90 +++ b/DynCore_GridCompMod.F90 @@ -54,7 +54,7 @@ Module FVdycoreCubed_GridComp HYDROSTATIC => FV_HYDROSTATIC, & fv_getUpdraftHelicity, & ADIABATIC, SW_DYNAMICS, AdvCore_Advection - use m_topo_remap, only: dyn_topo_remap + use shared_topo_remap, only: dyn_topo_remap use CubeGridPrototype, only: register_grid_and_regridders ! !PUBLIC MEMBER FUNCTIONS: @@ -7455,6 +7455,7 @@ subroutine Coldstart(gc, import, export, clock, rc) type (ESMF_FieldBundle) :: TRADV_BUNDLE character(len=ESMF_MAXSTR) :: FIELDNAME character(len=ESMF_MAXSTR) :: STRING + character(len=ESMF_MAXSTR) :: eta_rc_file real(REAL8), parameter :: r0_6=0.6 real(REAL8), parameter :: r1_0=1.0 @@ -7578,7 +7579,14 @@ subroutine Coldstart(gc, import, export, clock, rc) bk_is_missing = .true. endif - if (ak_is_missing .or. bk_is_missing) call set_eta(km, ls, ptop, pint, AK, BK) + if (ak_is_missing .or. bk_is_missing) then + call MAPL_GetResource(MAPL, eta_rc_file, label='ETA_RC_FILE:', default = 'None', rc = status) + if( trim(eta_rc_file) == 'None' ) then + call set_eta(km, ls, ptop, pint, AK, BK) + else + call get_eta(trim(eta_rc_file), ptop, pint, AK, BK) + endif + endif _ASSERT(ANY(AK /= 0.0) .or. ANY(BK /= 0.0),'needs informative message') do L=lbound(PE,3),ubound(PE,3) diff --git a/interp_restarts.F90 b/interp_restarts.F90 index a8b74de..40a6eec 100755 --- a/interp_restarts.F90 +++ b/interp_restarts.F90 @@ -78,6 +78,7 @@ program interp_restarts integer :: p_split, npx, npy, npz, ivar, lcnt_var, iq0 integer :: n_args,n_files,nlevs,nedges,ifile,nlev,n_output,nfv_vars character(len=ESMF_MAXPATHLEN), allocatable :: extra_files(:),extra_output(:) + character(len=ESMF_MAXPATHLEN) :: eta_rc_file type(fv_rst), pointer :: rst_files(:) => null() type(ArrDescr) :: ArrDes integer :: info @@ -114,6 +115,7 @@ program interp_restarts n_readers=1 ihydro = 1 scale_rst = .true. + eta_rc_file = 'None' do i=1,n_args call get_command_argument(i,str) select case(trim(str)) @@ -177,6 +179,8 @@ program interp_restarts read(astr,*)schmidt_parameters(2) call get_command_argument(i+3,astr) read(astr,*)schmidt_parameters(3) + case('-eta_file') + call get_command_argument(i+1,eta_rc_file) end select end do @@ -326,7 +330,11 @@ program interp_restarts allocate ( r8_ak(npz+1) ) allocate ( r8_bk(npz+1) ) - call set_eta(npz,ks,ptop,pint,r8_ak,r8_bk) + if (trim(eta_rc_file) == 'None') then + call set_eta(npz,ks,ptop,pint,r8_ak,r8_bk) + else + call get_eta(trim(eta_rc_file), ptop,pint,r8_ak,r8_bk) + endif FV_Atm(1)%ak = r8_ak FV_Atm(1)%bk = r8_bk deallocate ( r8_ak,r8_bk )