From 364b7fd9796f8e8e64d6fdcc135297d61fe0ece0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 10:01:21 -0500 Subject: [PATCH 01/26] add clam_varpar use statement --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index d28137c71..323467f15 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -6,6 +6,9 @@ module CatchmentCNRstMod use mpi use MAPL use CatchmentRstMod, only : CatchmentRst + use clm_varpar , only : nzone => NUM_ZON, nveg => NUM_VEG, & + VAR_COL, VAR_PFT, numpft + implicit none real, parameter :: ECCENTRICITY = 0.0167 @@ -13,8 +16,6 @@ module CatchmentCNRstMod real, parameter :: OBLIQUITY = 23.45 integer, parameter :: EQUINOX = 80 - integer, parameter :: nveg = 4 - integer, parameter :: nzone = 3 integer, parameter :: VAR_COL_CLM40 = 40 ! number of CN column restart variables integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column integer, parameter :: npft = 19 From ebb07390e55b2a5638549b42c5025d4bf2a20ab0 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 11:04:14 -0500 Subject: [PATCH 02/26] add dependencies for CLM directories --- .../GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt index 320bc3430..edfe68274 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt @@ -22,7 +22,7 @@ set (exe_srcs esma_add_library (${this} SRCS ${srcs} - DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran) + DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran CLM40 CLM45) foreach (src ${exe_srcs}) string (REGEX REPLACE ".F90" ".x" exe ${src}) From 6d5909665d4b74ee4ebd069e0ab7111ff07cebc4 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 7 Dec 2022 11:05:41 -0500 Subject: [PATCH 03/26] cleanup of CatchCN constants --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 22 +++++-------------- 1 file changed, 6 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 323467f15..f6cf36918 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -7,7 +7,8 @@ module CatchmentCNRstMod use MAPL use CatchmentRstMod, only : CatchmentRst use clm_varpar , only : nzone => NUM_ZON, nveg => NUM_VEG, & - VAR_COL, VAR_PFT, numpft + VAR_COL, VAR_PFT, npft => numpft + use nanMod , only : nan implicit none @@ -16,13 +17,6 @@ module CatchmentCNRstMod real, parameter :: OBLIQUITY = 23.45 integer, parameter :: EQUINOX = 80 - integer, parameter :: VAR_COL_CLM40 = 40 ! number of CN column restart variables - integer, parameter :: VAR_PFT_CLM40 = 74 ! number of CN PFT variables per column - integer, parameter :: npft = 19 - integer, parameter :: npft_clm45 = 19 - integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables - integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column - real, parameter :: nan = O'17760000000' real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) @@ -115,14 +109,12 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) catch%ntiles = ntiles catch%meta = meta catch%time = time + catch%VAR_COL = VAR_COL + catch%VAR_PFT = VAR_PFT if (index(cnclm, '40') /=0) then - catch%VAR_COL = VAR_COL_CLM40 - catch%VAR_PFT = VAR_PFT_CLM40 catch%isCLM40 = .true. endif if (index(cnclm, '45') /=0) then - catch%VAR_COL = VAR_COL_CLM45 - catch%VAR_PFT = VAR_PFT_CLM45 catch%isCLM45 = .true. endif @@ -206,14 +198,12 @@ function CatchmentCNRst_empty(meta, cnclm, time, rc) result (catch) catch%ntiles = meta%get_dimension('tile', __RC__) catch%time = time catch%meta = meta + catch%VAR_COL = VAR_COL + catch%VAR_PFT = VAR_PFT if (index(cnclm, '40') /=0) then - catch%VAR_COL = VAR_COL_CLM40 - catch%VAR_PFT = VAR_PFT_CLM40 catch%isCLM40 = .true. endif if (index(cnclm, '45') /=0) then - catch%VAR_COL = VAR_COL_CLM45 - catch%VAR_PFT = VAR_PFT_CLM45 catch%isCLM45 = .true. endif From 283a4ea3d6ea16e4684ed446f551760cd111e608 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 09:33:22 -0500 Subject: [PATCH 04/26] replace orbital and day length subroutines with MAPL versions --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 202 ++++-------------- 1 file changed, 41 insertions(+), 161 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index f6cf36918..70561bc15 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -4,6 +4,7 @@ module CatchmentCNRstMod use mk_restarts_getidsMod, ONLY: & GetIds use mpi + use ESMF use MAPL use CatchmentRstMod, only : CatchmentRst use clm_varpar , only : nzone => NUM_ZON, nveg => NUM_VEG, & @@ -12,11 +13,6 @@ module CatchmentCNRstMod implicit none - real, parameter :: ECCENTRICITY = 0.0167 - real, parameter :: PERIHELION = 102.0 - real, parameter :: OBLIQUITY = 23.45 - integer, parameter :: EQUINOX = 80 - real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value integer :: iclass(npft) = (/1,1,2,3,3,4,5,5,6,7,8,9,10,11,12,11,12,11,12/) @@ -547,12 +543,20 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) integer, allocatable, dimension (:) :: tid_offl, id_loc real, allocatable, dimension (:) :: CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2, & CLMC_pt1, CLMC_pt2,CLMC_st1,CLMC_st2 - integer :: AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR=0,AGCM_DATE + integer :: AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR=0,AGCM_DATE, & + AGCM_MI, AGCM_S, dofyr real, allocatable, dimension(:,:) :: fveg_offl, ityp_offl, tg_tmp real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:), var_out(:), var_psn(:,:,:) integer :: status, in_ntiles, out_ntiles, numprocs logical :: root_proc integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft + real,pointer,dimension(:) :: lats + real,pointer,dimension(:) :: lons + type(MAPL_SunOrbit) :: ORBIT + type(ESMF_Time) :: CURRENT_TIME + type(ESMF_State) :: INTERNAL + type(ESMF_Alarm) :: ALARM + character(*), parameter :: Iam = "CatchmentCN::Re_tile" @@ -609,10 +613,37 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) AGCM_YY = AGCM_DATE / 10000 AGCM_MM = (AGCM_DATE - AGCM_YY*10000) / 100 AGCM_DD = (AGCM_DATE - AGCM_YY*10000 - AGCM_MM*100) - - call compute_dayx ( & - out_NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - this%LATG, DAYX) + AGCM_MI = 0 + AGCM_S = 0 + + + ! get current date & time + ! ----------------------- + call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YY, & + MM = AGCM_MM, & + DD = AGCM_DD, & + H = AGCM_HR, & + M = AGCM_MI, & + S = AGCM_S , & + dayOfYear = dofyr , & + rc=status ) + VERIFY_(STATUS) + + ! Get parameters from generic state. + ! -------------------------------------------------------------------------- + + call MAPL_Get ( MAPL ,& + RUNALARM = ALARM ,& + ORBIT = ORBIT ,& + TILELATS = LATS ,& + TILELONS = LONS ,& + INTERNAL_ESMF_STATE = INTERNAL ,& + RC=STATUS ) + VERIFY_(STATUS) + + ! current daylight duration + call MAPL_SunGetDaylightDuration(ORBIT,lats,dayx,currTime=CURRENT_TIME,RC=STATUS) + VERIFY_(STATUS) ! save the old vaues dimension (in_ntiles, nv) ityp_offl = this%cnity @@ -1261,157 +1292,6 @@ SUBROUTINE regrid_carbon (NTILES, in_ntiles, id_glb, & end subroutine regrid_carbon - subroutine compute_dayx ( & - NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - LATT, DAYX) - - implicit none - - integer, intent (in) :: NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR - real, dimension (NTILES), intent (in) :: LATT - real, dimension (NTILES), intent (out) :: DAYX - integer, parameter :: DT = 900 - integer, parameter :: ncycle = 1461 ! number of days in a 4-year leap cycle (365*4 + 1) - real, dimension(ncycle) :: zc, zs - integer :: dofyr, sec,YEARS_PER_CYCLE, DAYS_PER_CYCLE, year, iday, idayp1, nn, n - real :: fac, YEARLEN, zsin, zcos, declin - - dofyr = AGCM_DD - if(AGCM_MM > 1) dofyr = dofyr + 31 - if(AGCM_MM > 2) then - dofyr = dofyr + 28 - if(mod(AGCM_YY,4) == 0) dofyr = dofyr + 1 - endif - if(AGCM_MM > 3) dofyr = dofyr + 31 - if(AGCM_MM > 4) dofyr = dofyr + 30 - if(AGCM_MM > 5) dofyr = dofyr + 31 - if(AGCM_MM > 6) dofyr = dofyr + 30 - if(AGCM_MM > 7) dofyr = dofyr + 31 - if(AGCM_MM > 8) dofyr = dofyr + 31 - if(AGCM_MM > 9) dofyr = dofyr + 30 - if(AGCM_MM > 10) dofyr = dofyr + 31 - if(AGCM_MM > 11) dofyr = dofyr + 30 - - sec = AGCM_HR * 3600 - DT ! subtract DT to get time of previous physics step - fac = real(sec) / 86400. - - - call orbit_create(zs,zc,ncycle) ! GEOS5 leap cycle routine - - YEARLEN = 365.25 - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - ! declination & daylength - ! ----------------------- - - YEAR = mod(AGCM_YY-1,YEARS_PER_CYCLE) - - IDAY = YEAR*int(YEARLEN)+dofyr - IDAYP1 = mod(IDAY,DAYS_PER_CYCLE) + 1 - - ZSin = ZS(IDAYP1)*FAC + ZS(IDAY)*(1.-FAC) ! sine of solar declination - ZCos = ZC(IDAYP1)*FAC + ZC(IDAY)*(1.-FAC) ! cosine of solar declination - - nn = 0 - do n = 1,days_per_cycle - nn = nn + 1 - if(nn > 365) nn = nn - 365 - ! print *, 'cycle:',n,nn,asin(ZS(n)) - end do - declin = asin(ZSin) - - ! compute daylength on input tile space (accounts for any change in physics time step) - ! do n = 1,ntiles_cn - ! fac = -(sin((latc(n)/zoom)*(MAPL_PI/180.))*zsin)/(cos((latc(n)/zoom)*(MAPL_PI/180.))*zcos) - ! fac = min(1.,max(-1.,fac)) - ! dayl(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - ! end do - - ! compute daylength on output tile space (accounts for lat shift due to split & change in time step) - - do n = 1,ntiles - fac = -(sin(latt(n)*(MAPL_PI/180.))*zsin)/(cos(latt(n)*(MAPL_PI/180.))*zcos) - fac = min(1.,max(-1.,fac)) - dayx(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - end do - - ! print *,'DAYX : ', minval(dayx),maxval(dayx), minval(latt), maxval(latt), zsin, zcos, dofyr, iday, idayp1, declin - - end subroutine compute_dayx - - ! ***************************************************************************** - - subroutine orbit_create(zs,zc,ncycle) - implicit none - - integer, intent(in) :: ncycle - real, intent(out), dimension(ncycle) :: zs, zc - - integer :: YEARS_PER_CYCLE, DAYS_PER_CYCLE - integer :: K, KP !, KM - real*8 :: T1, T2, T3, T4, FUN, Y, SOB, OMG, PRH, TT - real*8 :: YEARLEN - - ! STATEMENT FUNCTION - - FUN(Y) = OMG*(1.0-ECCENTRICITY*cos(Y-PRH))**2 - - YEARLEN = 365.25 - - ! Factors involving the orbital parameters - !------------------------------------------ - - OMG = (2.0*MAPL_PI/YEARLEN) / (sqrt(1.-ECCENTRICITY**2)**3) - PRH = PERIHELION*(MAPL_PI/180.) - SOB = sin(OBLIQUITY*(MAPL_PI/180.)) - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - if(days_per_cycle /= ncycle) stop 'bad cycle' - - ! ZS: Sine of declination - ! ZC: Cosine of declination - - ! Begin integration at vernal equinox - - KP = EQUINOX - TT = 0.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - - ! Integrate orbit for entire leap cycle using Runge-Kutta - - do K=2,DAYS_PER_CYCLE - T1 = FUN(TT ) - T2 = FUN(TT+T1*0.5) - T3 = FUN(TT+T2*0.5) - T4 = FUN(TT+T3 ) - KP = mod(KP,DAYS_PER_CYCLE) + 1 - TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - end do - end subroutine orbit_create end subroutine re_tile From 8835309b31fac38b01bc80e73c0b4240fd71f1d6 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 10:02:28 -0500 Subject: [PATCH 05/26] removing naming conflict --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 70561bc15..c1c23b41a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -552,6 +552,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft real,pointer,dimension(:) :: lats real,pointer,dimension(:) :: lons + type(MAPL_MetaComp),pointer :: MAPL_MC type(MAPL_SunOrbit) :: ORBIT type(ESMF_Time) :: CURRENT_TIME type(ESMF_State) :: INTERNAL @@ -632,7 +633,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) ! Get parameters from generic state. ! -------------------------------------------------------------------------- - call MAPL_Get ( MAPL ,& + call MAPL_Get ( MAPL_MC ,& RUNALARM = ALARM ,& ORBIT = ORBIT ,& TILELATS = LATS ,& From de9b2f412e4e64f298b7f9280a365e206e615743 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 11:17:27 -0500 Subject: [PATCH 06/26] replace orbital and daylength routines with MAPL functions and import CatchCN constants --- .../Utils/mk_restarts/mk_CatchCNRestarts.F90 | 224 ++++-------------- 1 file changed, 48 insertions(+), 176 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index c51462468..d187a6de8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -195,9 +195,12 @@ program mk_CatchCNRestarts ! 1104-1115: PSNSHAM (n,nz*nv) use MAPL + use ESMF use gFTL_StringVector use ieee_arithmetic, only: isnan => ieee_is_nan use mk_restarts_getidsMod, only: GetIDs, ReadTileFile_RealLatLon + use clm_varpar , only : nzone => NUM_ZON, nveg => NUM_VEG, & + VAR_COL, VAR_PFT, npft => numpft implicit none include 'mpif.h' @@ -208,20 +211,6 @@ program mk_CatchCNRestarts integer :: myid=0, numprocs=1, mpierr, mpistatus(MPI_STATUS_SIZE) logical :: root_proc=.true. - ! Carbon model specifics - ! ---------------------- - - real, parameter :: ECCENTRICITY = 0.0167 - real, parameter :: PERIHELION = 102.0 - real, parameter :: OBLIQUITY = 23.45 - integer, parameter :: EQUINOX = 80 - - integer, parameter :: nveg = 4 - integer, parameter :: nzone = 3 - integer, parameter :: VAR_COL = 40 ! number of CN column restart variables - integer, parameter :: VAR_PFT = 74 ! number of CN PFT variables per column - integer, parameter :: npft = 19 - real, parameter :: nan = O'17760000000' real, parameter :: fmin= 1.e-4 ! ignore vegetation fractions at or below this value integer, parameter :: OutUnit = 40, InUnit = 50 @@ -1108,7 +1097,16 @@ SUBROUTINE regrid_carbon_vars ( & real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:) real, allocatable :: var_col_out (:,:,:), var_pft_out (:,:,:,:) integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) - + integer :: AGCM_MI, AGCM_S, dofyr + real,pointer,dimension(:) :: lats + real,pointer,dimension(:) :: lons + type(MAPL_MetaComp),pointer :: MAPL_MC + type(MAPL_SunOrbit) :: ORBIT + type(ESMF_Time) :: CURRENT_TIME + type(ESMF_State) :: INTERNAL + type(ESMF_Alarm) :: ALARM + + allocate (tid_offl (ntiles_cn)) allocate (ityp_offl (ntiles_cn,nveg)) allocate (fveg_offl (ntiles_cn,nveg)) @@ -1159,12 +1157,41 @@ SUBROUTINE regrid_carbon_vars ( & call ReadTileFile_RealLatLon (OutTileFile, i, long, latg) - ! Compute DAYX - ! ------------ - - call compute_dayx ( & - NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - LATG, DAYX) + !----------------------- + ! COMPUTE DAYX + !----------------------- + + AGCM_MI = 0 + AGCM_S = 0 + + ! get current date & time + ! ----------------------- + call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YY, & + MM = AGCM_MM, & + DD = AGCM_DD, & + H = AGCM_HR, & + M = AGCM_MI, & + S = AGCM_S , & + dayOfYear = dofyr , & + rc=status ) + VERIFY_(STATUS) + + ! Get parameters from generic state. + ! ----------------------------------- + + call MAPL_Get ( MAPL_MC ,& + RUNALARM = ALARM ,& + ORBIT = ORBIT ,& + TILELATS = LATS ,& + TILELONS = LONS ,& + INTERNAL_ESMF_STATE = INTERNAL ,& + RC=STATUS ) + VERIFY_(STATUS) + + ! compute current daylight duration + !---------------------------------- + call MAPL_SunGetDaylightDuration(ORBIT,lats,dayx,currTime=CURRENT_TIME,RC=STATUS) + VERIFY_(STATUS) ! --------------------------------------------- ! Read exact lonc, latc from offline .til File @@ -1745,161 +1772,6 @@ SUBROUTINE regrid_carbon_vars ( & END SUBROUTINE regrid_carbon_vars - ! ***************************************************************************** - - subroutine compute_dayx ( & - NTILES, AGCM_YY, AGCM_MM, AGCM_DD, AGCM_HR, & - LATT, DAYX) - - implicit none - - integer, intent (in) :: NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR - real, dimension (NTILES), intent (in) :: LATT - real, dimension (NTILES), intent (out) :: DAYX - integer, parameter :: DT = 900 - integer, parameter :: ncycle = 1461 ! number of days in a 4-year leap cycle (365*4 + 1) - real, dimension(ncycle) :: zc, zs - integer :: dofyr, sec,YEARS_PER_CYCLE, DAYS_PER_CYCLE, year, iday, idayp1, nn - real :: fac, YEARLEN, zsin, zcos, declin - - dofyr = AGCM_DD - if(AGCM_MM > 1) dofyr = dofyr + 31 - if(AGCM_MM > 2) then - dofyr = dofyr + 28 - if(mod(AGCM_YY,4) == 0) dofyr = dofyr + 1 - endif - if(AGCM_MM > 3) dofyr = dofyr + 31 - if(AGCM_MM > 4) dofyr = dofyr + 30 - if(AGCM_MM > 5) dofyr = dofyr + 31 - if(AGCM_MM > 6) dofyr = dofyr + 30 - if(AGCM_MM > 7) dofyr = dofyr + 31 - if(AGCM_MM > 8) dofyr = dofyr + 31 - if(AGCM_MM > 9) dofyr = dofyr + 30 - if(AGCM_MM > 10) dofyr = dofyr + 31 - if(AGCM_MM > 11) dofyr = dofyr + 30 - - sec = AGCM_HR * 3600 - DT ! subtract DT to get time of previous physics step - fac = real(sec) / 86400. - - call orbit_create(zs,zc,ncycle) ! GEOS5 leap cycle routine - - YEARLEN = 365.25 - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - ! declination & daylength - ! ----------------------- - - YEAR = mod(AGCM_YY-1,YEARS_PER_CYCLE) - - IDAY = YEAR*int(YEARLEN)+dofyr - IDAYP1 = mod(IDAY,DAYS_PER_CYCLE) + 1 - - ZSin = ZS(IDAYP1)*FAC + ZS(IDAY)*(1.-FAC) ! sine of solar declination - ZCos = ZC(IDAYP1)*FAC + ZC(IDAY)*(1.-FAC) ! cosine of solar declination - - nn = 0 - do n = 1,days_per_cycle - nn = nn + 1 - if(nn > 365) nn = nn - 365 - ! print *, 'cycle:',n,nn,asin(ZS(n)) - end do - - declin = asin(ZSin) - - ! compute daylength on input tile space (accounts for any change in physics time step) - ! do n = 1,ntiles_cn - ! fac = -(sin((latc(n)/zoom)*(MAPL_PI/180.))*zsin)/(cos((latc(n)/zoom)*(MAPL_PI/180.))*zcos) - ! fac = min(1.,max(-1.,fac)) - ! dayl(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - ! end do - - ! compute daylength on output tile space (accounts for lat shift due to split & change in time step) - - do n = 1,ntiles - fac = -(sin(latt(n)*(MAPL_PI/180.))*zsin)/(cos(latt(n)*(MAPL_PI/180.))*zcos) - fac = min(1.,max(-1.,fac)) - dayx(n) = (86400./MAPL_PI) * acos(fac) ! daylength (seconds) - end do - - ! print *,'DAYX : ', minval(dayx),maxval(dayx), minval(latt), maxval(latt), zsin, zcos, dofyr, iday, idayp1, declin - - end subroutine compute_dayx - - ! ***************************************************************************** - - subroutine orbit_create(zs,zc,ncycle) - - implicit none - - integer, intent(in) :: ncycle - real, intent(out), dimension(ncycle) :: zs, zc - - integer :: YEARS_PER_CYCLE, DAYS_PER_CYCLE - integer :: K, KP !, KM - real*8 :: T1, T2, T3, T4, FUN, Y, SOB, OMG, PRH, TT - real*8 :: YEARLEN - - ! STATEMENT FUNCTION - - FUN(Y) = OMG*(1.0-ECCENTRICITY*cos(Y-PRH))**2 - - YEARLEN = 365.25 - - ! Factors involving the orbital parameters - !------------------------------------------ - - OMG = (2.0*MAPL_PI/YEARLEN) / (sqrt(1.-ECCENTRICITY**2)**3) - PRH = PERIHELION*(MAPL_PI/180.) - SOB = sin(OBLIQUITY*(MAPL_PI/180.)) - - ! Compute length of leap cycle - !------------------------------ - - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - if(days_per_cycle /= ncycle) stop 'bad cycle' - - ! ZS: Sine of declination - ! ZC: Cosine of declination - - ! Begin integration at vernal equinox - - KP = EQUINOX - TT = 0.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - - ! Integrate orbit for entire leap cycle using Runge-Kutta - - do K=2,DAYS_PER_CYCLE - T1 = FUN(TT ) - T2 = FUN(TT+T1*0.5) - T3 = FUN(TT+T2*0.5) - T4 = FUN(TT+T3 ) - KP = mod(KP,DAYS_PER_CYCLE) + 1 - TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 - ZS(KP) = sin(TT)*SOB - ZC(KP) = sqrt(1.0-ZS(KP)**2) - end do - - end subroutine orbit_create - ! ***************************************************************************** SUBROUTINE NCDF_reshape_getOput (NCFID,CID,col,pft, get_var) From db806a89475e497c4f758f22bc118613ae11e8cf Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 11:48:59 -0500 Subject: [PATCH 07/26] change variable names --- .../Utils/mk_restarts/mk_CatchCNRestarts.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index d187a6de8..413b3cfb2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -1097,7 +1097,7 @@ SUBROUTINE regrid_carbon_vars ( & real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:) real, allocatable :: var_col_out (:,:,:), var_pft_out (:,:,:,:) integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) - integer :: AGCM_MI, AGCM_S, dofyr + integer :: AGCM_YYY, AGCM_MMM, AGCM_DDD, AGCM_HRR, AGCM_MI, AGCM_S, dofyr real,pointer,dimension(:) :: lats real,pointer,dimension(:) :: lons type(MAPL_MetaComp),pointer :: MAPL_MC @@ -1161,6 +1161,10 @@ SUBROUTINE regrid_carbon_vars ( & ! COMPUTE DAYX !----------------------- + AGCM_YYY = AGCM_YY + AGCM_MMM = AGCM_MM + AGCM_DDD = AGCM_DD + AGCM_HRR = AGCM_HR AGCM_MI = 0 AGCM_S = 0 From bd0c61b2a254c4673b32e37f7f22c479b2c9f6ac Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 20 Dec 2022 13:00:56 -0500 Subject: [PATCH 08/26] changing variable names in function call --- .../Utils/mk_restarts/mk_CatchCNRestarts.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index 413b3cfb2..56afcbde0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -1170,10 +1170,10 @@ SUBROUTINE regrid_carbon_vars ( & ! get current date & time ! ----------------------- - call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YY, & - MM = AGCM_MM, & - DD = AGCM_DD, & - H = AGCM_HR, & + call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YYY, & + MM = AGCM_MMM, & + DD = AGCM_DDD, & + H = AGCM_HRR, & M = AGCM_MI, & S = AGCM_S , & dayOfYear = dofyr , & From 3d8d2683e8fc4ff8e7575fe5de3bcc56bb7c3daa Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:43:41 -0500 Subject: [PATCH 09/26] pointing to parameters in shared parameter file --- .../GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 index ff99b4d50..3bab4f385 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/CLM40/clm_varpar.F90 @@ -9,6 +9,11 @@ module clm_varpar ! Module containing CLM parameters ! ! !USES: + + use clm_varpar_shared, only : VAR_COL =>VAR_COL_40, VAR_PFT => VAR_PFT_40, & + numpft => numpft_CN, NUM_ZON => NUM_ZON_CN, & + NUM_VEG => NUM_VEG_CN + ! ! !PUBLIC TYPES: implicit none @@ -23,7 +28,6 @@ module clm_varpar ! Define indices used in surface file read ! maxpatch_pft = max number of plant functional types in naturally vegetated landunit - integer, parameter :: numpft = 19 ! actual # of pfts (without bare) integer :: maxpatch_pft ! clm_varpar_init seems to do something similar; less prone to error to move @@ -39,10 +43,6 @@ module clm_varpar ! CatchCN parameters ! ------------------ - integer, parameter, PUBLIC :: NUM_ZON=3 ! number of CN hydrology zones per tile - integer, parameter, PUBLIC :: NUM_VEG=4 ! number of CN PFTs per zone - integer, parameter, PUBLIC :: VAR_COL=40 ! number of CN column restart variables - integer, parameter, PUBLIC :: VAR_PFT=74 ! number of CN PFT variables per column real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 integer, parameter, PUBLIC :: map_cat(0:numpft) = (/4,3,3,3,1,1,2,2,2,5,5,5,6,4,4,4,4,4,4,4/) ! gkw: 0 -> 6, since 8 now gone From bbcc1a16cdcbf7dfa1f24fa0a29518af422c2083 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:43:50 -0500 Subject: [PATCH 10/26] pointing to parameters in shared parameter file --- .../GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 index a6c9bc66f..151eccc3a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varpar.F90 @@ -10,6 +10,9 @@ module clm_varpar ! ! !USES: ! + use clm_varpar_shared, only : VAR_COL =>VAR_COL_45, VAR_PFT => VAR_PFT_45, & + numpft => numpft_CN, NUM_ZON => NUM_ZON_CN, & + NUM_VEG => NUM_VEG_CN ! !PUBLIC TYPES: implicit none save @@ -26,7 +29,6 @@ module clm_varpar ! Define indices used in surface file read ! maxpatch_pft = max number of plant functional types in naturally vegetated landunit - integer, parameter :: numpft = 19 ! actual # of pfts (without bare), same as in Catchment-CN.clm4 integer :: maxpatch_pft ! clm_varpar_init seems to do something similar; less prone to error to move @@ -85,10 +87,6 @@ module clm_varpar ! 8: DESERT => 0 ! 9: ICE => n/a - integer, parameter, PUBLIC :: NUM_ZON=3 ! number of CN hydrology zones per tile - integer, parameter, PUBLIC :: NUM_VEG=4 ! number of CN PFTs per zone - integer, parameter, PUBLIC :: VAR_COL=35 ! number of CN column restart variables - integer, parameter, PUBLIC :: VAR_PFT=75 ! number of CN PFT variables per column real, parameter, PUBLIC, dimension(NUM_ZON) :: CN_zone_weight = (/0.10,0.45,0.45/) ! gkw: tunable; must sum to 1 integer, parameter, PUBLIC :: map_cat(0:numpft) = (/4,3,3,3,1,1,2,2,2,5,5,5,6,4,4,4,4,4,4,4/) From d4a0c6ec4dcf84d279f7d95f9197da553be1ea1d Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:44:16 -0500 Subject: [PATCH 11/26] importing CatchCN parameters from shared file --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index c1c23b41a..0e5f83052 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -7,8 +7,9 @@ module CatchmentCNRstMod use ESMF use MAPL use CatchmentRstMod, only : CatchmentRst - use clm_varpar , only : nzone => NUM_ZON, nveg => NUM_VEG, & - VAR_COL, VAR_PFT, npft => numpft + use clm_varpar_shared , only : nzone => NUM_ZON_CN, nveg => NUM_VEG_CN, & + VAR_COL_40, VAR_PFT_40, VAR_COL_45, VAR_PFT_45, & + npft => numpft_CN use nanMod , only : nan implicit none @@ -105,13 +106,15 @@ function CatchmentCNRst_create(filename, cnclm, time, rc) result (catch) catch%ntiles = ntiles catch%meta = meta catch%time = time - catch%VAR_COL = VAR_COL - catch%VAR_PFT = VAR_PFT if (index(cnclm, '40') /=0) then catch%isCLM40 = .true. + catch%VAR_COL = VAR_COL_40 + catch%VAR_PFT = VAR_PFT_40 endif if (index(cnclm, '45') /=0) then catch%isCLM45 = .true. + catch%VAR_COL = VAR_COL_45 + catch%VAR_PFT = VAR_PFT_45 endif if (myid == 0) then @@ -194,13 +197,15 @@ function CatchmentCNRst_empty(meta, cnclm, time, rc) result (catch) catch%ntiles = meta%get_dimension('tile', __RC__) catch%time = time catch%meta = meta - catch%VAR_COL = VAR_COL - catch%VAR_PFT = VAR_PFT if (index(cnclm, '40') /=0) then catch%isCLM40 = .true. + catch%VAR_COL = VAR_COL_40 + catch%VAR_PFT = VAR_PFT_40 endif if (index(cnclm, '45') /=0) then catch%isCLM45 = .true. + catch%VAR_COL = VAR_COL_45 + catch%VAR_PFT = VAR_PFT_45 endif call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) From 89c88b0276f514923932cc94c55e4584c404e75f Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:44:35 -0500 Subject: [PATCH 12/26] importing CatchCN parameters from shared file --- .../Utils/mk_restarts/mk_CatchCNRestarts.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index 56afcbde0..efbde185c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -199,8 +199,9 @@ program mk_CatchCNRestarts use gFTL_StringVector use ieee_arithmetic, only: isnan => ieee_is_nan use mk_restarts_getidsMod, only: GetIDs, ReadTileFile_RealLatLon - use clm_varpar , only : nzone => NUM_ZON, nveg => NUM_VEG, & - VAR_COL, VAR_PFT, npft => numpft + use clm_varpar_shared , only : nzone => NUM_ZON_CN, nveg => NUM_VEG_CN, & + VAR_COL => VAR_COL_40, VAR_PFT => VAR_PFT_40, & + npft => numpft_CN implicit none include 'mpif.h' From e336ad9d7e5178d569c86179a56d141242df6b72 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:45:06 -0500 Subject: [PATCH 13/26] new shared parameter file for CatchCN --- .../Shared/clm_varpar_shared.F90 | 29 +++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 new file mode 100644 index 000000000..c5d39f267 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/clm_varpar_shared.F90 @@ -0,0 +1,29 @@ +module clm_varpar_shared + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varpar_shared +! +! !DESCRIPTION: +! Module containing CLM parameters +! +! !USES: +! +! !PUBLIC TYPES: + implicit none + save +! +! Define number of levels + + integer, parameter :: numpft_CN = 19 ! actual # of pfts (without bare), same as in Catchment-CN.clm4 + + integer, parameter, PUBLIC :: NUM_ZON_CN=3 ! number of CN hydrology zones per tile + integer, parameter, PUBLIC :: NUM_VEG_CN=4 ! number of CN PFTs per zone + integer, parameter, PUBLIC :: VAR_COL_40=40 ! number of CN column restart variables + integer, parameter, PUBLIC :: VAR_PFT_40=74 ! number of CN PFT variables per column + integer, parameter, PUBLIC :: VAR_COL_45=35 ! number of CN column restart variables + integer, parameter, PUBLIC :: VAR_PFT_45=75 ! number of CN PFT variables per column + +!------------------------------------------------------------------------------ +end module clm_varpar_shared From 544bf08fcef3d922d155e1f5e70c0a5a696e96fc Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Thu, 22 Dec 2022 13:58:46 -0500 Subject: [PATCH 14/26] updating CMake file --- .../GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt index edfe68274..344f8ea0b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt @@ -22,14 +22,14 @@ set (exe_srcs esma_add_library (${this} SRCS ${srcs} - DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran CLM40 CLM45) + DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran GEOS_catchCNShared) foreach (src ${exe_srcs}) string (REGEX REPLACE ".F90" ".x" exe ${src}) ecbuild_add_executable ( TARGET ${exe} SOURCES ${src} - LIBS MAPL GFTL_SHARED::gftl-shared GEOS_SurfaceShared GEOSroute_GridComp GEOS_LandShared ${this}) + LIBS MAPL GFTL_SHARED::gftl-shared GEOS_SurfaceShared GEOSroute_GridComp GEOS_LandShared GEOS_catchCNShared ${this}) endforeach () install(PROGRAMS mk_Restarts DESTINATION bin) From ee643d66bd3a6eb60c63f00929a68487041d0e28 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 10:19:38 -0500 Subject: [PATCH 15/26] correct spelling --- .../GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt index 344f8ea0b..d073187a8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CMakeLists.txt @@ -22,14 +22,14 @@ set (exe_srcs esma_add_library (${this} SRCS ${srcs} - DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran GEOS_catchCNShared) + DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared esmf NetCDF::NetCDF_Fortran GEOS_CatchCNShared) foreach (src ${exe_srcs}) string (REGEX REPLACE ".F90" ".x" exe ${src}) ecbuild_add_executable ( TARGET ${exe} SOURCES ${src} - LIBS MAPL GFTL_SHARED::gftl-shared GEOS_SurfaceShared GEOSroute_GridComp GEOS_LandShared GEOS_catchCNShared ${this}) + LIBS MAPL GFTL_SHARED::gftl-shared GEOS_SurfaceShared GEOSroute_GridComp GEOS_LandShared GEOS_CatchCNShared ${this}) endforeach () install(PROGRAMS mk_Restarts DESTINATION bin) From 627703be012e2e1990149af31b3ee9e2682acc27 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Fri, 23 Dec 2022 11:02:04 -0500 Subject: [PATCH 16/26] adding share parameter file --- .../GEOScatchCN_GridComp/Shared/CMakeLists.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt index 2fcb3c483..decc7f7e7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/CMakeLists.txt @@ -3,7 +3,8 @@ esma_set_this(OVERRIDE GEOS_CatchCNShared) set (srcs nanMod.F90 catchmentCN.F90 - catchcn_iau.F90) + catchcn_iau.F90 + clm_varpar_shared.F90) esma_add_library (${this} SRCS ${srcs} From b7d3f5dc670798d9e4b3df1b8972d63901eb2508 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 4 Jan 2023 09:43:03 -0500 Subject: [PATCH 17/26] create orbit object --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 40 ++++++++++--------- 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 0e5f83052..6b68c284b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -557,11 +557,9 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft real,pointer,dimension(:) :: lats real,pointer,dimension(:) :: lons - type(MAPL_MetaComp),pointer :: MAPL_MC type(MAPL_SunOrbit) :: ORBIT type(ESMF_Time) :: CURRENT_TIME - type(ESMF_State) :: INTERNAL - type(ESMF_Alarm) :: ALARM + type(ESMF_TimeInterval) :: timeStep character(*), parameter :: Iam = "CatchmentCN::Re_tile" @@ -623,32 +621,38 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) AGCM_S = 0 - ! get current date & time + !1) Set current date & time ! ----------------------- - call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YY, & + call ESMF_TimeSet ( CURRENT_TIME, YY = AGCM_YY, & MM = AGCM_MM, & DD = AGCM_DD, & H = AGCM_HR, & M = AGCM_MI, & S = AGCM_S , & - dayOfYear = dofyr , & rc=status ) VERIFY_(STATUS) - ! Get parameters from generic state. - ! -------------------------------------------------------------------------- + !2) create a clock + ! time interval value is not critical here, just for a clock - call MAPL_Get ( MAPL_MC ,& - RUNALARM = ALARM ,& - ORBIT = ORBIT ,& - TILELATS = LATS ,& - TILELONS = LONS ,& - INTERNAL_ESMF_STATE = INTERNAL ,& - RC=STATUS ) + call ESMF_TimeIntervalSet(TimeStep, S=450, RC=status) + clock = ESMF_ClockCreate(TimeStep, startTime = CURRENT_TIME, RC=status) VERIFY_(STATUS) - - ! current daylight duration - call MAPL_SunGetDaylightDuration(ORBIT,lats,dayx,currTime=CURRENT_TIME,RC=STATUS) + call ESMFL_ClockSet ( clock, CurrTime=CURRENT_Time, rc=status ) + + !3) create an orbit + ORBIT = MAPL_SunOrbitCreate(CLOCK, ECC, OB, PER, EQNX, & + EOT, ORBIT_ANAL2B, ORB2B_YEARLEN, & + ORB2B_REF_YYYYMMDD, ORB2B_REF_HHMMSS, & + ORB2B_ECC_REF, ORB2B_ECC_RATE, & + ORB2B_OBQ_REF, ORB2B_OBQ_RATE, & + ORB2B_LAMBDAP_REF, ORB2B_LAMBDAP_RATE, & + ORB2B_EQUINOX_YYYYMMDD, ORB2B_EQUINOX_HHMMSS, & + FIX_SUN=FIX_SUN,RC=status) + VERIFY_(status) + + !4) current daylight duration + call MAPL_SunGetDaylightDuration(ORBIT, this%latg, dayx, currTime=CURRENT_TIME,RC=STATUS) VERIFY_(STATUS) ! save the old vaues dimension (in_ntiles, nv) From 9df6bfc47e871dcdedbdc169ddaeb722e818aeac Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 5 Jan 2023 10:32:41 -0500 Subject: [PATCH 18/26] get orbital constants from MAPL --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 6b68c284b..c5a08f3b8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -560,6 +560,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) type(MAPL_SunOrbit) :: ORBIT type(ESMF_Time) :: CURRENT_TIME type(ESMF_TimeInterval) :: timeStep + type(ESMF_Clock) :: CLOCK character(*), parameter :: Iam = "CatchmentCN::Re_tile" @@ -638,17 +639,18 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) call ESMF_TimeIntervalSet(TimeStep, S=450, RC=status) clock = ESMF_ClockCreate(TimeStep, startTime = CURRENT_TIME, RC=status) VERIFY_(STATUS) - call ESMFL_ClockSet ( clock, CurrTime=CURRENT_Time, rc=status ) + call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) !3) create an orbit - ORBIT = MAPL_SunOrbitCreate(CLOCK, ECC, OB, PER, EQNX, & - EOT, ORBIT_ANAL2B, ORB2B_YEARLEN, & + ORBIT = MAPL_SunOrbitCreate(CLOCK, ORBIT_ECCENTRICITY, ORBIT_OBLIQUITY, ORBIT_PERIHELION,& + ORBIT_EQUINOX, .false., .false., & + ORB2B_YEARLEN, & ORB2B_REF_YYYYMMDD, ORB2B_REF_HHMMSS, & ORB2B_ECC_REF, ORB2B_ECC_RATE, & ORB2B_OBQ_REF, ORB2B_OBQ_RATE, & ORB2B_LAMBDAP_REF, ORB2B_LAMBDAP_RATE, & ORB2B_EQUINOX_YYYYMMDD, ORB2B_EQUINOX_HHMMSS, & - FIX_SUN=FIX_SUN,RC=status) + FIX_SUN=.false., RC=status) VERIFY_(status) !4) current daylight duration From 339bcaf17457d01506a29d036d481189255efc8b Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Mon, 9 Jan 2023 10:31:47 -0500 Subject: [PATCH 19/26] adding ESMF calendar generation --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index c5a08f3b8..8d08abd46 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -624,6 +624,9 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) !1) Set current date & time ! ----------------------- + + call ESMF_CalendarSetDefault ( ESMF_CALKIND_GREGORIAN, rc=status ) + call ESMF_TimeSet ( CURRENT_TIME, YY = AGCM_YY, & MM = AGCM_MM, & DD = AGCM_DD, & From 7b41d298fb4a21033940b8c538d8faca1f9c0385 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 17 Jan 2023 09:48:00 -0500 Subject: [PATCH 20/26] simplifying MAPL orbit create call --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 8d08abd46..115a1460a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -561,6 +561,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) type(ESMF_Time) :: CURRENT_TIME type(ESMF_TimeInterval) :: timeStep type(ESMF_Clock) :: CLOCK + type(ESMF_Config) :: CF character(*), parameter :: Iam = "CatchmentCN::Re_tile" @@ -645,15 +646,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) !3) create an orbit - ORBIT = MAPL_SunOrbitCreate(CLOCK, ORBIT_ECCENTRICITY, ORBIT_OBLIQUITY, ORBIT_PERIHELION,& - ORBIT_EQUINOX, .false., .false., & - ORB2B_YEARLEN, & - ORB2B_REF_YYYYMMDD, ORB2B_REF_HHMMSS, & - ORB2B_ECC_REF, ORB2B_ECC_RATE, & - ORB2B_OBQ_REF, ORB2B_OBQ_RATE, & - ORB2B_LAMBDAP_REF, ORB2B_LAMBDAP_RATE, & - ORB2B_EQUINOX_YYYYMMDD, ORB2B_EQUINOX_HHMMSS, & - FIX_SUN=.false., RC=status) + ORBIT = MAPL_SunOrbitCreateFromConfig(CLOCK, CF, .false., RC=status) VERIFY_(status) !4) current daylight duration From bee4b01e3249352f0941fbfb496464612f905ef3 Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Tue, 17 Jan 2023 10:23:10 -0500 Subject: [PATCH 21/26] fix order of inputs in orbit create call --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 115a1460a..06a0842da 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -646,7 +646,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) !3) create an orbit - ORBIT = MAPL_SunOrbitCreateFromConfig(CLOCK, CF, .false., RC=status) + ORBIT = MAPL_SunOrbitCreateFromConfig(CF, CLOCK, .false., RC=status) VERIFY_(status) !4) current daylight duration From e992a8fc9d92fa02b143cf95da5f778b472b8c4a Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 18 Jan 2023 09:08:30 -0500 Subject: [PATCH 22/26] create config type --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 06a0842da..318964406 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -646,6 +646,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) !3) create an orbit + CF=ESMF_ConfigCreate(RC=STATUS) ORBIT = MAPL_SunOrbitCreateFromConfig(CF, CLOCK, .false., RC=status) VERIFY_(status) From 8235a21188f948bca2d4ef5d44de44fb70b9409a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 20 Jan 2023 11:27:36 -0500 Subject: [PATCH 23/26] initialize ESMF --- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 | 4 +++- .../Utils/mk_restarts/mk_catchANDcnRestarts.F90 | 4 ++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 318964406..25dd53829 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -646,7 +646,9 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) !3) create an orbit - CF=ESMF_ConfigCreate(RC=STATUS) + CF = ESMF_ConfigCreate(RC=STATUS) + VERIFY_(status) + ORBIT = MAPL_SunOrbitCreateFromConfig(CF, CLOCK, .false., RC=status) VERIFY_(status) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 index 931f97ffa..2d4789f59 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 @@ -5,6 +5,7 @@ PROGRAM mk_catchANDcnRestarts use mpi use MAPL + use ESMF use CatchmentRstMod use CatchmentCNRstMod @@ -22,6 +23,8 @@ PROGRAM mk_catchANDcnRestarts call MPI_COMM_RANK( MPI_COMM_WORLD, myid, mpierr ) call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, mpierr ) + call ESMF_Initialize(LogKindFlag=ESMF_LOGKIND_NONE) + call process_cmd() if (index(model, 'catchcn') /=0 ) then @@ -38,6 +41,7 @@ PROGRAM mk_catchANDcnRestarts call catch%write_nc4(out_file, __RC__) endif + call ESMF_Finalize() call MPI_FINALIZE(mpierr) contains From 686560b7a88e118a02d04ee4d54ec44450e52c5f Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 20 Jan 2023 12:22:23 -0500 Subject: [PATCH 24/26] finalize esmf right --- .../Utils/mk_restarts/mk_catchANDcnRestarts.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 index 2d4789f59..2e202a45b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 @@ -41,7 +41,8 @@ PROGRAM mk_catchANDcnRestarts call catch%write_nc4(out_file, __RC__) endif - call ESMF_Finalize() + call ESMF_Finalize(endflag=ESMF_END_KEEPMPI) + call MPI_FINALIZE(mpierr) contains From 121b984fad410fc3a695b78940b965679701b903 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 20 Jan 2023 12:34:27 -0500 Subject: [PATCH 25/26] more changes --- .../Utils/mk_restarts/mk_CatchCNRestarts.F90 | 41 +++++++++---------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index efbde185c..ea44b4cb9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -284,7 +284,7 @@ program mk_CatchCNRestarts ! availability. !----------------------------------------------------- - + call ESMF_Initialize(LogKindFlag=ESMF_LOGKIND_NONE) I = iargc() @@ -582,8 +582,8 @@ program mk_CatchCNRestarts ! call regrid_carbon_vars_omp (NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR, OutFileName, OutTileFile) endif - call MPI_BARRIER( MPI_COMM_WORLD, mpierr) +call ESMF_Finalize(endflag=ESMF_END_KEEPMPI) call MPI_FINALIZE(mpierr) contains @@ -1099,13 +1099,11 @@ SUBROUTINE regrid_carbon_vars ( & real, allocatable :: var_col_out (:,:,:), var_pft_out (:,:,:,:) integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) integer :: AGCM_YYY, AGCM_MMM, AGCM_DDD, AGCM_HRR, AGCM_MI, AGCM_S, dofyr - real,pointer,dimension(:) :: lats - real,pointer,dimension(:) :: lons - type(MAPL_MetaComp),pointer :: MAPL_MC type(MAPL_SunOrbit) :: ORBIT type(ESMF_Time) :: CURRENT_TIME - type(ESMF_State) :: INTERNAL - type(ESMF_Alarm) :: ALARM + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Clock) :: CLOCK + type(ESMF_Config) :: CF allocate (tid_offl (ntiles_cn)) @@ -1169,33 +1167,34 @@ SUBROUTINE regrid_carbon_vars ( & AGCM_MI = 0 AGCM_S = 0 + + call ESMF_CalendarSetDefault ( ESMF_CALKIND_GREGORIAN, rc=status ) + ! get current date & time ! ----------------------- - call ESMF_TimeGet ( CURRENT_TIME, YY = AGCM_YYY, & + call ESMF_TimeSet ( CURRENT_TIME, YY = AGCM_YYY, & MM = AGCM_MMM, & DD = AGCM_DDD, & H = AGCM_HRR, & M = AGCM_MI, & S = AGCM_S , & - dayOfYear = dofyr , & rc=status ) VERIFY_(STATUS) - ! Get parameters from generic state. - ! ----------------------------------- + call ESMF_TimeIntervalSet(TimeStep, S=450, RC=status) + clock = ESMF_ClockCreate(TimeStep, startTime = CURRENT_TIME, RC=status) + VERIFY_(STATUS) + call ESMF_ClockSet ( clock, CurrTime=CURRENT_TIME, rc=status ) - call MAPL_Get ( MAPL_MC ,& - RUNALARM = ALARM ,& - ORBIT = ORBIT ,& - TILELATS = LATS ,& - TILELONS = LONS ,& - INTERNAL_ESMF_STATE = INTERNAL ,& - RC=STATUS ) - VERIFY_(STATUS) + CF = ESMF_ConfigCreate(RC=STATUS) + VERIFY_(status) - ! compute current daylight duration + ORBIT = MAPL_SunOrbitCreateFromConfig(CF, CLOCK, .false., RC=status) + VERIFY_(status) + + ! compute current daylight duration !---------------------------------- - call MAPL_SunGetDaylightDuration(ORBIT,lats,dayx,currTime=CURRENT_TIME,RC=STATUS) + call MAPL_SunGetDaylightDuration(ORBIT,latg,dayx,currTime=CURRENT_TIME,RC=STATUS) VERIFY_(STATUS) ! --------------------------------------------- From f2b8eadb9d1e455d6f61f75574102c2bf50d90ca Mon Sep 17 00:00:00 2001 From: gmao-jkolassa Date: Wed, 25 Jan 2023 20:00:40 -0500 Subject: [PATCH 26/26] in daylength call pass latitudes in radians --- .../Utils/mk_restarts/CatchmentCNRst.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 index 25dd53829..905127189 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentCNRst.F90 @@ -555,8 +555,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) integer :: status, in_ntiles, out_ntiles, numprocs logical :: root_proc integer :: mpierr, n, i, k, tag, req, st, ed, myid, L, iv, nv,nz, var_col, var_pft - real,pointer,dimension(:) :: lats - real,pointer,dimension(:) :: lons + real, allocatable, dimension(:) :: lat_tmp type(MAPL_SunOrbit) :: ORBIT type(ESMF_Time) :: CURRENT_TIME type(ESMF_TimeInterval) :: timeStep @@ -607,6 +606,8 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) allocate (tid_offl(in_ntiles)) allocate (id_loc_cn (nt_local (myid + 1),nveg)) + allocate (lat_tmp(in_ntiles)) + do n = 1, in_ntiles tid_offl(n) = n enddo @@ -653,7 +654,8 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) VERIFY_(status) !4) current daylight duration - call MAPL_SunGetDaylightDuration(ORBIT, this%latg, dayx, currTime=CURRENT_TIME,RC=STATUS) + lat_tmp = this%latg*MAPL_PI/180. + call MAPL_SunGetDaylightDuration(ORBIT, lat_tmp, dayx, currTime=CURRENT_TIME,RC=STATUS) VERIFY_(STATUS) ! save the old vaues dimension (in_ntiles, nv) @@ -742,6 +744,7 @@ subroutine re_tile(this, InTileFile, OutBcsDir, OutTileFile, surflay, rc) allocate (id_loc (out_ntiles)) deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1, CLMC_sf2) deallocate (CLMC_pt1, CLMC_pt2, CLMC_st1, CLMC_st2) + deallocate (lat_tmp) do nv = 1, nveg call MPI_Barrier(MPI_COMM_WORLD, STATUS)