`_.
-CTSM Tools Testing
-==================
-
-.. include:: ../../../../test/tools/README
- :literal:
-
CTSM Fortran Unit Tests
=======================
diff --git a/python/ctsm/modify_input_files/fsurdat_modifier.py b/python/ctsm/modify_input_files/fsurdat_modifier.py
index bd060cb9dc..1a45590872 100644
--- a/python/ctsm/modify_input_files/fsurdat_modifier.py
+++ b/python/ctsm/modify_input_files/fsurdat_modifier.py
@@ -254,8 +254,8 @@ def modify_optional(
"""Modify the dataset according to the optional settings"""
# Set fsurdat variables in a rectangle that could be global (default).
- # Note that the land/ocean mask gets specified in the domain file for
- # MCT or the ocean mesh files for NUOPC. Here the user may specify
+ # Note that the land/ocean mask gets specified in
+ # the ocean mesh files. Here the user may specify
# fsurdat variables inside a box but cannot change which points will
# run as land and which as ocean.
if idealized:
diff --git a/src/cpl/mct/ExcessIceStreamType.F90 b/src/cpl/mct/ExcessIceStreamType.F90
deleted file mode 100644
index 5c5394233c..0000000000
--- a/src/cpl/mct/ExcessIceStreamType.F90
+++ /dev/null
@@ -1,144 +0,0 @@
-module ExcessIceStreamType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Stub for ExcessIceStreams for the MCT driver. So that MCT can be used
- ! without excess ice streams.
- !
- ! !USES
- use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use spmdMod , only : mpicom, masterproc
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- use decompMod , only : bounds_type
-
- ! !PUBLIC TYPES:
- implicit none
- private
-
- public :: UseExcessIceStreams ! If streams will be used
-
- type, public :: excessicestream_type
- contains
-
- ! !PUBLIC MEMBER FUNCTIONS:
- procedure, public :: Init ! Initialize and read data in
- procedure, public :: CalcExcessIce ! Calculate excess ice ammount
-
- ! !PRIVATE MEMBER FUNCTIONS:
- procedure, private :: ReadNML ! Read in namelist
-
- end type excessicestream_type
- ! ! PRIVATE DATA:
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-!==============================================================================
-contains
-!==============================================================================
-
- subroutine Init(this, bounds, NLFilename)
- !
- !
- ! arguments
- implicit none
- class(excessicestream_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
-
- !
- ! local variables
-
- call this%ReadNML( bounds, NLFileName )
- end subroutine Init
-
- subroutine CalcExcessIce(this,bounds,exice_bulk_init)
-
- ! only transfers grid values to columns
- implicit none
- class(excessicestream_type) :: this
- type(bounds_type), intent(in) :: bounds
- real(r8) , intent(inout) :: exice_bulk_init(bounds%begc:bounds%endc)
- !
- ! !LOCAL VARIABLES:
-
- end subroutine CalcExcessIce
-
- logical function UseExcessIceStreams()
- !
- ! !DESCRIPTION:
- ! Return true if
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- implicit none
- !
- ! !LOCAL VARIABLES:
- UseExcessIceStreams = .false.
-end function UseExcessIceStreams
-
-subroutine ReadNML(this, bounds, NLFilename)
- !
- ! Read the namelist data stream information.
- !
- ! Uses:
- use shr_nl_mod , only : shr_nl_find_group_name
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_mpi_mod , only : shr_mpi_bcast
- !
- ! arguments
- implicit none
- class(excessicestream_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! local variables
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- logical :: use_excess_ice_streams = .false. ! logical to turn on use of excess ice streams
- character(len=CL) :: stream_fldFileName_exice = ' '
- character(len=CL) :: stream_mapalgo_exice = 'none'
- character(len=*), parameter :: namelist_name = 'exice_streams' ! MUST agree with name in namelist and read
- character(len=*), parameter :: subName = "('exice_streams::ReadNML')"
- !-----------------------------------------------------------------------
-
- namelist /exice_streams/ & ! MUST agree with namelist_name above
- stream_mapalgo_exice, stream_fldFileName_exice, use_excess_ice_streams
- !-----------------------------------------------------------------------
- ! Default values for namelist
-
- ! Read excess ice namelist
- if (masterproc) then
- open( newunit=nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call shr_nl_find_group_name(nu_nml, namelist_name, status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=exice_streams,iostat=nml_error) ! MUST agree with namelist_name above
- if (nml_error /= 0) then
- call endrun(msg=' ERROR reading '//namelist_name//' namelist'//errMsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg=' ERROR finding '//namelist_name//' namelist'//errMsg(sourcefile, __LINE__))
- end if
- close(nu_nml)
- endif
-
- call shr_mpi_bcast(use_excess_ice_streams , mpicom)
-
- if (masterproc) then
- if ( use_excess_ice_streams ) then
- call endrun(msg=' ERROR excess ice streams can NOT be on for the MCT driver'//errMsg(sourcefile, __LINE__))
- end if
- if ( trim(stream_fldFileName_exice) /= '' ) then
- call endrun(msg=' ERROR stream_fldFileName_exice can NOT be set for the MCT driver'//errMsg(sourcefile, __LINE__))
- end if
- if ( trim(stream_mapalgo_exice) /= 'none' ) then
- call endrun(msg=' ERROR stream_mapalgo_exice can only be none for the MCT driver'//errMsg(sourcefile, __LINE__))
- end if
- endif
-
-end subroutine ReadNML
-
-end module ExcessIceStreamType
diff --git a/src/cpl/mct/FireDataBaseType.F90 b/src/cpl/mct/FireDataBaseType.F90
deleted file mode 100644
index 0ee635b2fa..0000000000
--- a/src/cpl/mct/FireDataBaseType.F90
+++ /dev/null
@@ -1,561 +0,0 @@
-module FireDataBaseType
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! module for handling of fire data
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL
- use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create, shr_strdata_print
- use shr_strdata_mod , only : shr_strdata_advance
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varctl , only : iulog, inst_name
- use spmdMod , only : masterproc, mpicom, comp_id
- use fileutils , only : getavu, relavu
- use domainMod , only : ldomain
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use FireMethodType , only : fire_method_type
- use lnd_set_decomp_and_domain, only : gsmap_global
- use mct_mod
- !
- implicit none
- private
- !
- ! !PUBLIC TYPES:
- public :: fire_base_type
-
- !
- type, abstract, extends(fire_method_type) :: fire_base_type
- private
- ! !PRIVATE MEMBER DATA:
-
- real(r8), public, pointer :: forc_lnfm(:) ! Lightning frequency
- real(r8), public, pointer :: forc_hdm(:) ! Human population density
-
- real(r8), public, pointer :: gdp_lf_col(:) ! col global real gdp data (k US$/capita)
- real(r8), public, pointer :: peatf_lf_col(:) ! col global peatland fraction data (0-1)
- integer , public, pointer :: abm_lf_col(:) ! col global peak month of crop fire emissions
-
- type(shr_strdata_type) :: sdat_hdm ! Human population density input data stream
- type(shr_strdata_type) :: sdat_lnfm ! Lightning input data stream
-
- contains
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- procedure, public :: FireInit => BaseFireInit ! Initialization of Fire
- procedure, public :: BaseFireInit ! Initialization of Fire
- procedure(FireReadNML_interface), public, deferred :: FireReadNML ! Read in namelist for Fire
- procedure, public :: FireInterp ! Interpolate fire data
- procedure(need_lightning_and_popdens_interface), public, deferred :: &
- need_lightning_and_popdens ! Returns true if need lightning & popdens
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- procedure, private :: hdm_init ! position datasets for dynamic human population density
- procedure, private :: hdm_interp ! interpolates between two years of human pop. density file data
- procedure, private :: lnfm_init ! position datasets for Lightning
- procedure, private :: lnfm_interp ! interpolates between two years of Lightning file data
- procedure, private :: surfdataread ! read fire related data from surface data set
- end type fire_base_type
- !-----------------------------------------------------------------------
-
- abstract interface
- !-----------------------------------------------------------------------
- function need_lightning_and_popdens_interface(this) result(need_lightning_and_popdens)
- !
- ! !DESCRIPTION:
- ! Returns true if need lightning and popdens, false otherwise
- !
- ! USES
- import :: fire_base_type
- !
- ! !ARGUMENTS:
- class(fire_base_type), intent(in) :: this
- logical :: need_lightning_and_popdens ! function result
- !-----------------------------------------------------------------------
- end function need_lightning_and_popdens_interface
- end interface
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine FireReadNML_interface( this, NLFilename )
- !
- ! !DESCRIPTION:
- ! Read the namelist for Fire
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(fire_base_type) :: this
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- end subroutine FireReadNML_interface
-
- !-----------------------------------------------------------------------
- subroutine BaseFireInit( this, bounds, NLFilename )
- !
- ! !DESCRIPTION:
- ! Initialize CN Fire module
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(fire_base_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename
- !-----------------------------------------------------------------------
-
- if ( this%need_lightning_and_popdens() ) then
- ! Allocate lightning forcing data
- allocate( this%forc_lnfm(bounds%begg:bounds%endg) )
- this%forc_lnfm(bounds%begg:) = nan
- ! Allocate pop dens forcing data
- allocate( this%forc_hdm(bounds%begg:bounds%endg) )
- this%forc_hdm(bounds%begg:) = nan
-
- ! Allocate real gdp data
- allocate(this%gdp_lf_col(bounds%begc:bounds%endc))
- ! Allocate peatland fraction data
- allocate(this%peatf_lf_col(bounds%begc:bounds%endc))
- ! Allocates peak month of crop fire emissions
- allocate(this%abm_lf_col(bounds%begc:bounds%endc))
-
-
- call this%hdm_init(bounds, NLFilename)
- call this%hdm_interp(bounds)
- call this%lnfm_init(bounds, NLFilename)
- call this%lnfm_interp(bounds)
- call this%surfdataread(bounds)
- end if
-
- end subroutine BaseFireInit
-
- !-----------------------------------------------------------------------
- subroutine FireInterp(this,bounds)
- !
- ! !DESCRIPTION:
- ! Interpolate CN Fire datasets
- !
- ! !ARGUMENTS:
- class(fire_base_type) :: this
- type(bounds_type), intent(in) :: bounds
- !-----------------------------------------------------------------------
-
- if ( this%need_lightning_and_popdens() ) then
- call this%hdm_interp(bounds)
- call this%lnfm_interp(bounds)
- end if
-
- end subroutine FireInterp
-
- !-----------------------------------------------------------------------
- subroutine hdm_init( this, bounds, NLFilename )
- !
- ! !DESCRIPTION:
- ! Initialize data stream information for population density.
- !
- ! !USES:
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use clm_nlUtilsMod , only : find_nlgroup_name
- use ndepStreamMod , only : clm_domain_mct
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- implicit none
- class(fire_base_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: stream_year_first_popdens ! first year in pop. dens. stream to use
- integer :: stream_year_last_popdens ! last year in pop. dens. stream to use
- integer :: model_year_align_popdens ! align stream_year_first_hdm with
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- type(mct_ggrid) :: dom_clm ! domain information
- character(len=CL) :: stream_fldFileName_popdens ! population density streams filename
- character(len=CL) :: popdensmapalgo = 'bilinear' ! mapping alogrithm for population density
- character(len=CL) :: popdens_tintalgo = 'nearest'! time interpolation alogrithm for population density
- character(len=CL) :: stream_meshfile_popdens ! not used
- character(*), parameter :: subName = "('hdmdyn_init')"
- character(*), parameter :: F00 = "('(hdmdyn_init) ',4a)"
- !-----------------------------------------------------------------------
-
- namelist /popd_streams/ &
- stream_year_first_popdens, &
- stream_year_last_popdens, &
- model_year_align_popdens, &
- popdensmapalgo, &
- stream_fldFileName_popdens, &
- stream_meshfile_popdens , &
- popdens_tintalgo
-
- ! Default values for namelist
- stream_year_first_popdens = 1 ! first year in stream to use
- stream_year_last_popdens = 1 ! last year in stream to use
- model_year_align_popdens = 1 ! align stream_year_first_popdens with this model year
- stream_fldFileName_popdens = ' '
-
- ! Read popd_streams namelist
- if (masterproc) then
- nu_nml = getavu()
- open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'popd_streams', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=popd_streams,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(msg='ERROR reading popd_streams namelist'//errMsg(sourcefile, __LINE__))
- end if
- end if
- close(nu_nml)
- call relavu( nu_nml )
- endif
-
- call shr_mpi_bcast(stream_year_first_popdens, mpicom)
- call shr_mpi_bcast(stream_year_last_popdens, mpicom)
- call shr_mpi_bcast(model_year_align_popdens, mpicom)
- call shr_mpi_bcast(stream_fldFileName_popdens, mpicom)
- call shr_mpi_bcast(popdens_tintalgo, mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) 'popdens_streams settings:'
- write(iulog,*) ' stream_year_first_popdens = ',stream_year_first_popdens
- write(iulog,*) ' stream_year_last_popdens = ',stream_year_last_popdens
- write(iulog,*) ' model_year_align_popdens = ',model_year_align_popdens
- write(iulog,*) ' stream_fldFileName_popdens = ',stream_fldFileName_popdens
- write(iulog,*) ' popdens_tintalgo = ',popdens_tintalgo
- write(iulog,*) ' '
- endif
-
- call clm_domain_mct (bounds, dom_clm)
-
- call shr_strdata_create(this%sdat_hdm,name="clmhdm", &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsmap_global, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- yearFirst=stream_year_first_popdens, &
- yearLast=stream_year_last_popdens, &
- yearAlign=model_year_align_popdens, &
- offset=0, &
- domFilePath='', &
- domFileName=trim(stream_fldFileName_popdens), &
- domTvarName='time', &
- domXvarName='lon' , &
- domYvarName='lat' , &
- domAreaName='area', &
- domMaskName='mask', &
- filePath='', &
- filename=(/trim(stream_fldFileName_popdens)/) , &
- fldListFile='hdm', &
- fldListModel='hdm', &
- fillalgo='none', &
- mapalgo=popdensmapalgo, &
- calendar=get_calendar(), &
- tintalgo=popdens_tintalgo, &
- taxmode='extend' )
-
- if (masterproc) then
- call shr_strdata_print(this%sdat_hdm,'population density data')
- endif
-
- ! Add history fields
- call hist_addfld1d (fname='HDM', units='counts/km^2', &
- avgflag='A', long_name='human population density', &
- ptr_lnd=this%forc_hdm, default='inactive')
-
- end subroutine hdm_init
-
- !-----------------------------------------------------------------------
- subroutine hdm_interp( this, bounds)
- !
- ! !DESCRIPTION:
- ! Interpolate data stream information for population density.
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- !
- ! !ARGUMENTS:
- class(fire_base_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g, ig
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- !-----------------------------------------------------------------------
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(this%sdat_hdm, mcdate, sec, mpicom, 'hdmdyn')
-
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- this%forc_hdm(g) = this%sdat_hdm%avs(1)%rAttr(1,ig)
- end do
-
- end subroutine hdm_interp
-
- !-----------------------------------------------------------------------
- subroutine lnfm_init( this, bounds, NLFilename )
- !
- ! !DESCRIPTION:
- !
- ! Initialize data stream information for Lightning.
- !
- ! !USES:
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use clm_nlUtilsMod , only : find_nlgroup_name
- use ndepStreamMod , only : clm_domain_mct
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- implicit none
- class(fire_base_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename
- !
- ! !LOCAL VARIABLES:
- integer :: stream_year_first_lightng ! first year in Lightning stream to use
- integer :: stream_year_last_lightng ! last year in Lightning stream to use
- integer :: model_year_align_lightng ! align stream_year_first_lnfm with
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- type(mct_ggrid) :: dom_clm ! domain information
- character(len=CL) :: stream_fldFileName_lightng ! lightning stream filename to read
- character(len=CL) :: lightng_tintalgo = 'linear'! time interpolation alogrithm
- character(len=CL) :: lightngmapalgo = 'bilinear'! Mapping alogrithm
- character(*), parameter :: subName = "('lnfmdyn_init')"
- character(*), parameter :: F00 = "('(lnfmdyn_init) ',4a)"
- !-----------------------------------------------------------------------
-
- namelist /light_streams/ &
- stream_year_first_lightng, &
- stream_year_last_lightng, &
- model_year_align_lightng, &
- lightngmapalgo, &
- stream_fldFileName_lightng, &
- lightng_tintalgo
-
- ! Default values for namelist
- stream_year_first_lightng = 1 ! first year in stream to use
- stream_year_last_lightng = 1 ! last year in stream to use
- model_year_align_lightng = 1 ! align stream_year_first_lnfm with this model year
- stream_fldFileName_lightng = ' '
-
- ! Read light_streams namelist
- if (masterproc) then
- nu_nml = getavu()
- open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'light_streams', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=light_streams,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(msg='ERROR reading light_streams namelist'//errMsg(sourcefile, __LINE__))
- end if
- end if
- close(nu_nml)
- call relavu( nu_nml )
- endif
-
- call shr_mpi_bcast(stream_year_first_lightng, mpicom)
- call shr_mpi_bcast(stream_year_last_lightng, mpicom)
- call shr_mpi_bcast(model_year_align_lightng, mpicom)
- call shr_mpi_bcast(stream_fldFileName_lightng, mpicom)
- call shr_mpi_bcast(lightng_tintalgo, mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) 'light_stream settings:'
- write(iulog,*) ' stream_year_first_lightng = ',stream_year_first_lightng
- write(iulog,*) ' stream_year_last_lightng = ',stream_year_last_lightng
- write(iulog,*) ' model_year_align_lightng = ',model_year_align_lightng
- write(iulog,*) ' stream_fldFileName_lightng = ',stream_fldFileName_lightng
- write(iulog,*) ' lightng_tintalgo = ',lightng_tintalgo
- write(iulog,*) ' '
- endif
-
- call clm_domain_mct (bounds, dom_clm)
-
- call shr_strdata_create(this%sdat_lnfm,name="clmlnfm", &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsmap_global, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- yearFirst=stream_year_first_lightng, &
- yearLast=stream_year_last_lightng, &
- yearAlign=model_year_align_lightng, &
- offset=0, &
- domFilePath='', &
- domFileName=trim(stream_fldFileName_lightng), &
- domTvarName='time', &
- domXvarName='lon' , &
- domYvarName='lat' , &
- domAreaName='area', &
- domMaskName='mask', &
- filePath='', &
- filename=(/trim(stream_fldFileName_lightng)/), &
- fldListFile='lnfm', &
- fldListModel='lnfm', &
- fillalgo='none', &
- tintalgo=lightng_tintalgo, &
- mapalgo=lightngmapalgo, &
- calendar=get_calendar(), &
- taxmode='cycle' )
-
- if (masterproc) then
- call shr_strdata_print(this%sdat_lnfm,'Lightning data')
- endif
-
- ! Add history fields
- call hist_addfld1d (fname='LNFM', units='counts/km^2/hr', &
- avgflag='A', long_name='Lightning frequency', &
- ptr_lnd=this%forc_lnfm, default='inactive')
-
- end subroutine lnfm_init
-
- !-----------------------------------------------------------------------
- subroutine lnfm_interp(this, bounds )
- !
- ! !DESCRIPTION:
- ! Interpolate data stream information for Lightning.
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- !
- ! !ARGUMENTS:
- class(fire_base_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g, ig
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- !-----------------------------------------------------------------------
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(this%sdat_lnfm, mcdate, sec, mpicom, 'lnfmdyn')
-
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- this%forc_lnfm(g) = this%sdat_lnfm%avs(1)%rAttr(1,ig)
- end do
-
- end subroutine lnfm_interp
-
- !-----------------------------------------------------------------------
- subroutine surfdataread(this, bounds)
- !
- ! !DESCRIPTION:
- ! Read surface data set to populate relevant fire-related variables
- !
- ! !USES:
- use spmdMod , only : masterproc
- use clm_varctl , only : nsrest, nsrStartup, fsurdat
- use clm_varcon , only : grlnd
- use ColumnType , only : col
- use fileutils , only : getfil
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class(fire_base_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g,c ! indices
- type(file_desc_t) :: ncid ! netcdf id
- logical :: readvar ! true => variable is on initial dataset
- character(len=256) :: locfn ! local filename
- real(r8), pointer :: gdp(:) ! global gdp data (needs to be a pointer for use in ncdio)
- real(r8), pointer :: peatf(:) ! global peatf data (needs to be a pointer for use in ncdio)
- integer, pointer :: abm(:) ! global abm data (needs to be a pointer for use in ncdio)
- !-----------------------------------------------------------------------
-
- ! --------------------------------------------------------------------
- ! Open surface dataset
- ! --------------------------------------------------------------------
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- ! --------------------------------------------------------------------
- ! Read in GDP data
- ! --------------------------------------------------------------------
-
- allocate(gdp(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='gdp', flag='read', data=gdp, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: gdp NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%gdp_lf_col(c) = gdp(g)
- end do
- deallocate(gdp)
-
- ! --------------------------------------------------------------------
- ! Read in peatf data
- ! --------------------------------------------------------------------
-
- allocate(peatf(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='peatf', flag='read', data=peatf, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: peatf NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%peatf_lf_col(c) = peatf(g)
- end do
- deallocate(peatf)
-
- ! --------------------------------------------------------------------
- ! Read in ABM data
- ! --------------------------------------------------------------------
-
- allocate(abm(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='abm', flag='read', data=abm, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: abm NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%abm_lf_col(c) = abm(g)
- end do
- deallocate(abm)
-
- ! Close file
-
- call ncd_pio_closefile(ncid)
-
- if (masterproc) then
- write(iulog,*) 'Successfully read fmax, soil color, sand and clay boundary data'
- write(iulog,*)
- endif
-
- end subroutine surfdataread
-
-
-end module FireDataBaseType
diff --git a/src/cpl/mct/SoilMoistureStreamMod.F90 b/src/cpl/mct/SoilMoistureStreamMod.F90
deleted file mode 100644
index 8b366d6c8e..0000000000
--- a/src/cpl/mct/SoilMoistureStreamMod.F90
+++ /dev/null
@@ -1,418 +0,0 @@
-module SoilMoistureStreamMod
-
- ! **********************************************************************
- ! --------------------------- IMPORTANT NOTE ---------------------------
- !
- ! In cases using the NUOPC driver/mediator, we use a different version of this module,
- ! based on CDEPS, which resides in src/cpl/nuopc/. Changes to the science here should
- ! also be made in the similar file in src/cpl/nuopc. Once we start using CDEPS by
- ! default, we can remove this version and move the CDEPS-based version into its place.
- ! **********************************************************************
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Read in soil moisture from data stream
- !
- ! !USES:
- use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create
- use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_kind_mod , only : CL => shr_kind_CL, CXX => shr_kind_CXX
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type, subgrid_level_column
- use abortutils , only : endrun
- use clm_varctl , only : iulog, use_soil_moisture_streams, inst_name
- use clm_varcon , only : grlnd
- use controlMod , only : NLFilename
- use domainMod , only : ldomain
- use LandunitType , only : lun
- use ColumnType , only : col
- use SoilStateType , only : soilstate_type
- use WaterStateBulkType , only : waterstatebulk_type
- use perf_mod , only : t_startf, t_stopf
- use spmdMod , only : masterproc, mpicom, comp_id
- use lnd_set_decomp_and_domain , only : gsMap_lnd2Dsoi_gdc2glo
- use mct_mod
- use ncdio_pio
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: PrescribedSoilMoistureInit ! position datasets for soil moisture
- public :: PrescribedSoilMoistureAdvance ! Advance the soil moisture stream (outside of Open-MP loops)
- public :: PrescribedSoilMoistureInterp ! interpolates between two periods of soil moisture data
-
- ! !PRIVATE MEMBER DATA:
- type(shr_strdata_type) :: sdat_soilm ! soil moisture input data stream
- integer :: ism ! Soil moisture steram index
- integer, allocatable :: g_to_ig(:) ! Array matching gridcell index to data index
- logical :: soilm_ignore_data_if_missing ! If should ignore overridding a point with soil moisture data
- ! from the streams file, if the streams file shows that point
- ! as missing (namelist item)
- !
- ! !PRIVATE TYPES:
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- !
- ! soil_moisture_init
- !
- !-----------------------------------------------------------------------
- subroutine PrescribedSoilMoistureInit(bounds)
- !
- ! Initialize data stream information for soil moisture.
- !
- !
- ! !USES:
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use clm_nlUtilsMod , only : find_nlgroup_name
- use ndepStreamMod , only : clm_domain_mct
- use shr_stream_mod , only : shr_stream_file_null
- use shr_string_mod , only : shr_string_listCreateField
- use clm_varpar , only : nlevsoi
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
- integer :: i ! index
- integer :: stream_year_first_soilm ! first year in Ustar stream to use
- integer :: stream_year_last_soilm ! last year in Ustar stream to use
- integer :: model_year_align_soilm ! align stream_year_first_soilm with
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- integer :: soilm_offset ! Offset in time for dataset (sec)
- type(mct_ggrid) :: dom_clm ! domain information
- character(len=CL) :: stream_fldfilename_soilm ! ustar stream filename to read
- character(len=CL) :: soilm_tintalgo = 'linear' ! Time interpolation alogrithm
-
- character(*), parameter :: subName = "('PrescribedSoilMoistureInit')"
- character(*), parameter :: F00 = "('(PrescribedSoilMoistureInit) ',4a)"
- character(*), parameter :: soilmString = "H2OSOI" ! base string for field string
- character(CXX) :: fldList ! field string
- !-----------------------------------------------------------------------
- !
- ! deal with namelist variables here in init
- !
- namelist /soil_moisture_streams/ &
- stream_year_first_soilm, &
- stream_year_last_soilm, &
- model_year_align_soilm, &
- soilm_tintalgo, &
- soilm_offset, &
- soilm_ignore_data_if_missing, &
- stream_fldfilename_soilm
-
- ! Default values for namelist
- stream_year_first_soilm = 1 ! first year in stream to use
- stream_year_last_soilm = 1 ! last year in stream to use
- model_year_align_soilm = 1 ! align stream_year_first_soilm with this model year
- stream_fldfilename_soilm = shr_stream_file_null
- soilm_offset = 0
- soilm_ignore_data_if_missing = .false.
-
- ! Read soilm_streams namelist
- if (masterproc) then
- open( newunit=nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'soil_moisture_streams', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=soil_moisture_streams,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(subname // ':: ERROR reading soil_moisture_streams namelist')
- end if
- else
- call endrun(subname // ':: ERROR finding soilm_streams namelist')
- end if
- close(nu_nml)
- endif
-
- call shr_mpi_bcast(stream_year_first_soilm, mpicom)
- call shr_mpi_bcast(stream_year_last_soilm, mpicom)
- call shr_mpi_bcast(model_year_align_soilm, mpicom)
- call shr_mpi_bcast(stream_fldfilename_soilm, mpicom)
- call shr_mpi_bcast(soilm_tintalgo, mpicom)
- call shr_mpi_bcast(soilm_offset, mpicom)
- call shr_mpi_bcast(soilm_ignore_data_if_missing, mpicom)
-
- if (masterproc) then
-
- write(iulog,*) ' '
- write(iulog,*) 'soil_moisture_stream settings:'
- write(iulog,*) ' stream_year_first_soilm = ',stream_year_first_soilm
- write(iulog,*) ' stream_year_last_soilm = ',stream_year_last_soilm
- write(iulog,*) ' model_year_align_soilm = ',model_year_align_soilm
- write(iulog,*) ' stream_fldfilename_soilm = ',trim(stream_fldfilename_soilm)
- write(iulog,*) ' soilm_tintalgo = ',trim(soilm_tintalgo)
- write(iulog,*) ' soilm_offset = ',soilm_offset
- if ( soilm_ignore_data_if_missing )then
- write(iulog,*) ' Do NOT override a point with streams data if the streams data is missing'
- else
- write(iulog,*) ' Abort, if you find a model point where the input streams data is set to missing value'
- end if
-
- endif
-
- call clm_domain_mct (bounds, dom_clm, nlevels=nlevsoi)
-
- ! create the field list for these fields...use in shr_strdata_create
- fldList = trim(soilmString)
- if (masterproc) write(iulog,*) 'fieldlist: ', trim(fldList)
-
- call shr_strdata_create(sdat_soilm,name="soil_moisture", &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsMap_lnd2Dsoi_gdc2glo, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- nzg=nlevsoi, &
- yearFirst=stream_year_first_soilm, &
- yearLast=stream_year_last_soilm, &
- yearAlign=model_year_align_soilm, &
- offset=soilm_offset, &
- domFilePath='', &
- domFileName=trim(stream_fldFileName_soilm), &
- domTvarName='time', &
- domXvarName='lon' , &
- domYvarName='lat' , &
- domZvarName='levsoi' , &
- domAreaName='area', &
- domMaskName='mask', &
- filePath='', &
- filename=(/stream_fldFileName_soilm/), &
- fldListFile=fldList, &
- fldListModel=fldList, &
- fillalgo='none', &
- mapalgo='none', &
- tintalgo=soilm_tintalgo, &
- calendar=get_calendar(), &
- dtlimit = 15._r8, &
- taxmode='cycle' )
-
- if (masterproc) then
- call shr_strdata_print(sdat_soilm,'soil moisture data')
- endif
-
- end subroutine PrescribedSoilMoistureInit
-
-
- !-----------------------------------------------------------------------
- !
- ! PrescribedSoilMoistureAdvance
- !
- !-----------------------------------------------------------------------
- subroutine PrescribedSoilMoistureAdvance( bounds )
- !
- ! Advanace the prescribed soil moisture stream
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- character(len=CL) :: stream_var_name
- integer :: g, ig
- integer :: ier ! error code
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- stream_var_name = 'H2OSOI'
-
- ! Determine variable index
- ism = mct_aVect_indexRA(sdat_soilm%avs(1),trim(stream_var_name))
-
- call shr_strdata_advance(sdat_soilm, mcdate, sec, mpicom, trim(stream_var_name))
-
- ! Map gridcell to AV index
- ier = 0
- if ( .not. allocated(g_to_ig) )then
- allocate (g_to_ig(bounds%begg:bounds%endg), stat=ier)
- if (ier /= 0) then
- write(iulog,*) 'Prescribed soil moisture allocation error'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- g_to_ig(g) = ig
- end do
- end if
-
- end subroutine PrescribedSoilMoistureAdvance
-
- !-----------------------------------------------------------------------
- !
- ! PrescribedSoilMoistureInterp
- !
- !-----------------------------------------------------------------------
- subroutine PrescribedSoilMoistureInterp(bounds, soilstate_inst, &
- waterstatebulk_inst)
- !
- ! Assign data stream information for prescribed soil moisture.
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- use clm_varpar , only : nlevsoi
- use clm_varcon , only : denh2o, denice, watmin, spval
- use landunit_varcon , only : istsoil, istcrop
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c, g, j, ig, n
- real(r8) :: soilm_liq_frac ! liquid fraction of soil moisture
- real(r8) :: soilm_ice_frac ! ice fraction of soil moisture
- real(r8) :: moisture_increment ! soil moisture adjustment increment
- real(r8) :: h2osoi_vol_initial ! initial vwc value
- character(*), parameter :: subName = "('PrescribedSoilMoistureInterp')"
-
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_FL( (lbound(sdat_soilm%avs(1)%rAttr,1) == ism ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(sdat_soilm%avs(1)%rAttr,1) == ism ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(g_to_ig,1) <= bounds%begg ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(g_to_ig,1) >= bounds%endg ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(sdat_soilm%avs(1)%rAttr,2) <= g_to_ig(bounds%begg) ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(sdat_soilm%avs(1)%rAttr,2) >= g_to_ig(bounds%endg)+(nlevsoi-1)*size(g_to_ig) ), sourcefile, __LINE__)
- associate( &
- dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m)
- watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity)
- h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input/Output: [real(r8) (:,:) ] liquid water (kg/m2)
- h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input/Output: [real(r8) (:,:) ] ice water (kg/m2)
- h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Output: volumetric soil water (m3/m3)
- h2osoi_vol_prs => waterstatebulk_inst%h2osoi_vol_prs_grc & ! Output: prescribed volumetric soil water (m3/m3)
- )
- SHR_ASSERT_FL( (lbound(h2osoi_vol,1) <= bounds%begc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_vol,1) >= bounds%endc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(h2osoi_vol,2) == 1 ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_vol,2) >= nlevsoi ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(dz,1) <= bounds%begc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(dz,1) >= bounds%endc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(dz,2) <= 1 ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(dz,2) >= nlevsoi ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(watsat,1) <= bounds%begc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(watsat,1) >= bounds%endc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(watsat,2) <= 1 ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(watsat,2) >= nlevsoi ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(h2osoi_liq,1) <= bounds%begc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_liq,1) >= bounds%endc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(h2osoi_liq,2) <= 1 ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_liq,2) >= nlevsoi ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(h2osoi_ice,1) <= bounds%begc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_ice,1) >= bounds%endc ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(h2osoi_ice,2) <= 1 ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_ice,2) >= nlevsoi ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(h2osoi_vol_prs,1) <= bounds%begg ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_vol_prs,1) >= bounds%endg ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(h2osoi_vol_prs,2) == 1 ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(h2osoi_vol_prs,2) >= nlevsoi ), sourcefile, __LINE__)
- !
- ! Set the prescribed soil moisture read from the file everywhere
- !
- do g = bounds%begg, bounds%endg
- ig = g_to_ig(g)
- do j = 1, nlevsoi
-
- !n = ig + (j-1)*size(g_to_ig)
- n = ig + (j-1)*size(g_to_ig)
-
- h2osoi_vol_prs(g,j) = sdat_soilm%avs(1)%rAttr(ism,n)
-
- ! If soil moiture is being interpolated in time and the result is
- ! large that probably means one of the two data points is missing (set to spval)
- if ( h2osoi_vol_prs(g,j) > 10.0_r8 .and. (h2osoi_vol_prs(g,j) /= spval) )then
- h2osoi_vol_prs(g,j) = spval
- end if
-
- end do
- end do
-
- do c = bounds%begc, bounds%endc
- !
- ! Set variable for each gridcell/column combination
- !
- g = col%gridcell(c)
- ig = g_to_ig(g)
-
- ! EBK Jan/2020, also check weights on gridcell (See https://github.com/ESCOMP/CTSM/issues/847)
- if ( (lun%itype(col%landunit(c)) == istsoil) .or. (lun%itype(col%landunit(c)) == istcrop) .and. &
- (col%wtgcell(c) /= 0._r8) ) then
- ! this is a 2d field (gridcell/nlevsoi) !
- do j = 1, nlevsoi
-
- n = ig + (j-1)*size(g_to_ig)
-
- ! if soil water is zero, liq/ice fractions cannot be calculated
- if((h2osoi_liq(c, j) + h2osoi_ice(c, j)) > 0._r8) then
-
- ! save original soil moisture value
- h2osoi_vol_initial = h2osoi_vol(c,j)
-
- ! Check if the vegetated land mask from the dataset on the
- ! file is different
- if ( (h2osoi_vol_prs(g,j) == spval) .and. (h2osoi_vol_initial /= spval) )then
- if ( soilm_ignore_data_if_missing )then
- cycle
- else
- write(iulog,*) 'Input soil moisture dataset is not vegetated as expected: gridcell=', &
- g, ' active = ', col%active(c)
- call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, &
- msg = subname // &
- ' ERROR:: The input soil moisture stream is NOT vegetated for one of the land points' )
- end if
- end if
-
- ! update volumetric soil moisture from data prescribed from the file
- h2osoi_vol(c,j) = h2osoi_vol_prs(g,j)
-
-
- ! calculate liq/ice mass fractions
- soilm_liq_frac = h2osoi_liq(c, j) /(h2osoi_liq(c, j) + h2osoi_ice(c, j))
- soilm_ice_frac = h2osoi_ice(c, j) /(h2osoi_liq(c, j) + h2osoi_ice(c, j))
-
- ! calculate moisture increment
- moisture_increment = h2osoi_vol(c,j) - h2osoi_vol_initial
- ! add limitation check
- moisture_increment = min((watsat(c,j) - h2osoi_vol_initial),max(-(h2osoi_vol_initial-watmin),moisture_increment))
-
- ! update liq/ice water mass due to (volumetric) moisture increment
- h2osoi_liq(c,j) = h2osoi_liq(c,j) + (soilm_liq_frac * moisture_increment * dz(c, j) * denh2o)
- h2osoi_ice(c,j) = h2osoi_ice(c,j) + (soilm_ice_frac * moisture_increment * dz(c, j) * denice)
-
- else
- call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, &
- msg = subname // ':: ERROR h2osoil liquid plus ice is zero')
- endif
- enddo
- endif
- end do
-
- end associate
-
- end subroutine PrescribedSoilMoistureInterp
-
-end module SoilMoistureStreamMod
diff --git a/src/cpl/mct/UrbanTimeVarType.F90 b/src/cpl/mct/UrbanTimeVarType.F90
deleted file mode 100644
index 805ac47fbf..0000000000
--- a/src/cpl/mct/UrbanTimeVarType.F90
+++ /dev/null
@@ -1,314 +0,0 @@
-module UrbanTimeVarType
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Urban Time Varying Data
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use abortutils , only : endrun
- use decompMod , only : bounds_type, subgrid_level_landunit
- use clm_varctl , only : iulog, inst_name
- use landunit_varcon , only : isturb_MIN, isturb_MAX
- use clm_varcon , only : spval
- use LandunitType , only : lun
- use GridcellType , only : grc
- use mct_mod
- use shr_strdata_mod , only : shr_strdata_type
- !
- implicit none
- save
- private
- !
- !
-
- ! !PUBLIC TYPE
- type, public :: urbantv_type
-
- real(r8), public, pointer :: t_building_max(:) ! lun maximum internal building air temperature (K)
- type(shr_strdata_type) :: sdat_urbantv ! urban time varying input data stream
- contains
-
- ! !PUBLIC MEMBER FUNCTIONS:
- procedure, public :: Init ! Allocate and initialize urbantv
- procedure, public :: urbantv_init ! Initialize urban time varying stream
- procedure, public :: urbantv_interp ! Interpolate urban time varying stream
-
- end type urbantv_type
-
- !-----------------------------------------------------------------------
- character(15), private :: stream_var_name(isturb_MIN:isturb_MAX)
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds, NLFilename)
- !
- ! Allocate module variables and data structures
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(urbantv_type) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=*) , intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: begl, endl
- !---------------------------------------------------------------------
-
- begl = bounds%begl; endl = bounds%endl
-
- ! Allocate urbantv data structure
-
- allocate(this%t_building_max (begl:endl)) ; this%t_building_max (:) = nan
-
- call this%urbantv_init(bounds, NLFilename)
- call this%urbantv_interp(bounds)
-
- ! Add history fields
- call hist_addfld1d (fname='TBUILD_MAX', units='K', &
- avgflag='A', long_name='prescribed maximum interior building temperature', &
- ptr_lunit=this%t_building_max, default='inactive', set_nourb=spval, &
- l2g_scale_type='unity')
-
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- subroutine urbantv_init(this, bounds, NLFilename)
- !
- ! !DESCRIPTION:
- ! Initialize data stream information for urban time varying data
- !
- ! !USES:
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use clm_nlUtilsMod , only : find_nlgroup_name
- use ndepStreamMod , only : clm_domain_mct
- use spmdMod , only : masterproc, mpicom, comp_id
- use fileutils , only : getavu, relavu
- use shr_mpi_mod , only : shr_mpi_bcast
- use shr_string_mod , only : shr_string_listAppend
- use shr_strdata_mod , only : shr_strdata_create, shr_strdata_print
- use domainMod , only : ldomain
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use landunit_varcon , only : isturb_TBD, isturb_HD, isturb_MD
- use lnd_set_decomp_and_domain , only : gsmap_global
- !
- ! !ARGUMENTS:
- implicit none
- class(urbantv_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: begl, endl ! landunits
- integer :: ifield ! field index
- integer :: stream_year_first_urbantv ! first year in urban tv stream to use
- integer :: stream_year_last_urbantv ! last year in urban tv stream to use
- integer :: model_year_align_urbantv ! align stream_year_first_urbantv
- ! with this model year
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- type(mct_ggrid) :: dom_clm ! domain information
- character(len=CL) :: stream_fldFileName_urbantv ! urban tv streams filename
- character(len=CL) :: urbantvmapalgo = 'nn' ! mapping alogrithm for urban ac
- character(len=CL) :: urbantv_tintalgo = 'linear' ! time interpolation alogrithm
- character(len=CL) :: fldList ! field string
- character(*), parameter :: urbantvString = "tbuildmax_" ! base string for field string
- character(*), parameter :: subName = "('urbantv_init')"
- character(*), parameter :: F00 = "('(urbantv_init) ',4a)"
- !-----------------------------------------------------------------------
- namelist /urbantv_streams/ &
- stream_year_first_urbantv, &
- stream_year_last_urbantv, &
- model_year_align_urbantv, &
- urbantvmapalgo, &
- stream_fldFileName_urbantv, &
- urbantv_tintalgo
- !-----------------------------------------------------------------------
-
- begl = bounds%begl; endl = bounds%endl
-
- ! Default values for namelist
- stream_year_first_urbantv = 1 ! first year in stream to use
- stream_year_last_urbantv = 1 ! last year in stream to use
- model_year_align_urbantv = 1 ! align stream_year_first_urbantv with this model year
- stream_fldFileName_urbantv = ' '
-
- ! Read urbantv_streams namelist
- if (masterproc) then
- nu_nml = getavu()
- open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'urbantv_streams', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=urbantv_streams,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(msg='ERROR reading urbantv_streams namelist'//errMsg(sourcefile, __LINE__))
- end if
- end if
- close(nu_nml)
- call relavu( nu_nml )
- endif
-
- call shr_mpi_bcast(stream_year_first_urbantv, mpicom)
- call shr_mpi_bcast(stream_year_last_urbantv, mpicom)
- call shr_mpi_bcast(model_year_align_urbantv, mpicom)
- call shr_mpi_bcast(stream_fldFileName_urbantv, mpicom)
- call shr_mpi_bcast(urbantv_tintalgo, mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) 'urbantv_streams settings:'
- write(iulog,*) ' stream_year_first_urbantv = ',stream_year_first_urbantv
- write(iulog,*) ' stream_year_last_urbantv = ',stream_year_last_urbantv
- write(iulog,*) ' model_year_align_urbantv = ',model_year_align_urbantv
- write(iulog,*) ' stream_fldFileName_urbantv = ',stream_fldFileName_urbantv
- write(iulog,*) ' urbantv_tintalgo = ',urbantv_tintalgo
- write(iulog,*) ' '
- endif
-
- call clm_domain_mct (bounds, dom_clm)
-
- ! create the field list for these urbantv fields...use in shr_strdata_create
- stream_var_name(:) = "NOT_SET"
- stream_var_name(isturb_TBD) = urbantvString//"TBD"
- stream_var_name(isturb_HD) = urbantvString//"HD"
- stream_var_name(isturb_MD) = urbantvString//"MD"
- fldList = ""
- do ifield = isturb_MIN, isturb_MAX
- call shr_string_listAppend( fldList, stream_var_name(ifield) )
- end do
-
- call shr_strdata_create(this%sdat_urbantv,name="clmurbantv", &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsmap_global, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- yearFirst=stream_year_first_urbantv, &
- yearLast=stream_year_last_urbantv, &
- yearAlign=model_year_align_urbantv, &
- offset=0, &
- domFilePath='', &
- domFileName=trim(stream_fldFileName_urbantv), &
- domTvarName='time', &
- domXvarName='lon' , &
- domYvarName='lat' , &
- domAreaName='area', &
- domMaskName='LANDMASK', &
- filePath='', &
- filename=(/trim(stream_fldFileName_urbantv)/) , &
- fldListFile=fldList, &
- fldListModel=fldList, &
- fillalgo='none', &
- mapalgo=urbantvmapalgo, &
- calendar=get_calendar(), &
- tintalgo=urbantv_tintalgo, &
- taxmode='extend' )
-
- if (masterproc) then
- call shr_strdata_print(this%sdat_urbantv,'urban time varying data')
- endif
-
-
- end subroutine urbantv_init
-
- !-----------------------------------------------------------------------
- subroutine urbantv_interp(this, bounds)
- !
- ! !DESCRIPTION:
- ! Interpolate data stream information for urban time varying data.
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- use spmdMod , only : mpicom
- use shr_strdata_mod , only : shr_strdata_advance
- use clm_instur , only : urban_valid
- !
- ! !ARGUMENTS:
- class(urbantv_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- logical :: found
- integer :: l, glun, ig, g, ip
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- integer :: lindx ! landunit index
- integer :: gindx ! gridcell index
- !-----------------------------------------------------------------------
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(this%sdat_urbantv, mcdate, sec, mpicom, 'urbantvdyn')
-
- do l = bounds%begl,bounds%endl
- if (lun%urbpoi(l)) then
- glun = lun%gridcell(l)
- ip = mct_aVect_indexRA(this%sdat_urbantv%avs(1),trim(stream_var_name(lun%itype(l))))
- !
- ! Determine vector index corresponding to glun
- !
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- if (g == glun) exit
- end do
-
- this%t_building_max(l) = this%sdat_urbantv%avs(1)%rAttr(ip,ig)
- else
- this%t_building_max(l) = spval
- end if
- end do
-
- found = .false.
- do l = bounds%begl,bounds%endl
- if (lun%urbpoi(l)) then
- glun = lun%gridcell(l)
- !
- ! Determine vector index corresponding to glun
- !
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- if (g == glun) exit
- end do
-
- if ( .not. urban_valid(g) .or. (this%t_building_max(l) <= 0._r8)) then
- found = .true.
- gindx = g
- lindx = l
- exit
- end if
- end if
- end do
- if ( found ) then
- write(iulog,*)'ERROR: no valid urban data for g= ',gindx
- write(iulog,*)'landunit type: ',lun%itype(lindx)
- write(iulog,*)'urban_valid: ',urban_valid(gindx)
- write(iulog,*)'t_building_max: ',this%t_building_max(lindx)
- call endrun(subgrid_index=lindx, subgrid_level=subgrid_level_landunit, &
- msg=errmsg(sourcefile, __LINE__))
- end if
-
-
- end subroutine urbantv_interp
-
- !-----------------------------------------------------------------------
-
-end module UrbanTimeVarType
diff --git a/src/cpl/mct/ch4FInundatedStreamType.F90 b/src/cpl/mct/ch4FInundatedStreamType.F90
deleted file mode 100644
index 3c26f4d109..0000000000
--- a/src/cpl/mct/ch4FInundatedStreamType.F90
+++ /dev/null
@@ -1,389 +0,0 @@
-module ch4FInundatedStreamType
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Contains methods for reading in finundated streams file for methane code.
- !
- ! !USES
- use shr_kind_mod , only: r8 => shr_kind_r8, CL => shr_kind_cl
- use spmdMod , only: mpicom, masterproc
- use clm_varctl , only: iulog, inst_name
- use abortutils , only: endrun
- use decompMod , only: bounds_type
- use ch4varcon , only: finundation_mtd
-
- ! !PUBLIC TYPES:
- implicit none
- private
- save
-
- type, public :: ch4finundatedstream_type
- real(r8), pointer, private :: zwt0_gdc (:) ! col coefficient for determining finundated (m)
- real(r8), pointer, private :: f0_gdc (:) ! col maximum inundated fraction for a gridcell (for methane code)
- real(r8), pointer, private :: p3_gdc (:) ! col coefficient for determining finundated (m)
- real(r8), pointer, private :: fws_slope_gdc (:) ! col slope in fws = slope * tws + intercept (A coefficient)
- real(r8), pointer, private :: fws_intercept_gdc (:) ! col slope in fws = slope * tws + intercept (B coefficient)
- contains
-
- ! !PUBLIC MEMBER FUNCTIONS:
- procedure, public :: Init ! Initialize and read data in
- procedure, public :: CalcFinundated ! Calculate finundated based on input streams
- procedure, public :: UseStreams ! If streams will be used
-
- ! !PRIVATE MEMBER FUNCTIONS:
- procedure, private :: InitAllocate ! Allocate data
-
- end type ch4finundatedstream_type
-
-
- ! ! PRIVATE DATA:
-
- type, private :: streamcontrol_type
- character(len=CL) :: stream_fldFileName_ch4finundated ! Filename
- character(len=CL) :: ch4finundatedmapalgo ! map algo
- character(len=CL) :: fldList ! List of fields to read
- contains
- procedure, private :: ReadNML ! Read in namelist
- end type streamcontrol_type
-
- type(streamcontrol_type), private :: control ! Stream control data
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !==============================================================================
-
-contains
-
- !==============================================================================
-
- subroutine Init(this, bounds, NLFilename)
- !
- ! Initialize the ch4 finundated stream object
- !
- ! Uses:
- use clm_time_manager , only : get_calendar, get_curr_date
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use shr_nl_mod , only : shr_nl_find_group_name
- use shr_mpi_mod , only : shr_mpi_bcast
- use ndepStreamMod , only : clm_domain_mct
- use domainMod , only : ldomain
- use decompMod , only : bounds_type
- use mct_mod , only : mct_ggrid, mct_avect_indexra
- use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create
- use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance
- use spmdMod , only : comp_id, iam
- use ch4varcon , only : finundation_mtd_h2osfc
- use ch4varcon , only : finundation_mtd_ZWT_inversion, finundation_mtd_TWS_inversion
- use lnd_set_decomp_and_domain , only : gsmap_global
- !
- ! arguments
- implicit none
- class(ch4finundatedstream_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! local variables
- integer :: ig, g ! Indices
- type(mct_ggrid) :: dom_clm ! domain information
- type(shr_strdata_type) :: sdat ! input data stream
- integer :: index_ZWT0 = 0 ! Index of ZWT0 field
- integer :: index_F0 = 0 ! Index of F0 field
- integer :: index_P3 = 0 ! Index of P3 field
- integer :: index_FWS_TWS_A = 0 ! Index of FWS_TWS_A field
- integer :: index_FWS_TWS_B = 0 ! Index of FWS_TWS_B field
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- character(len=*), parameter :: stream_name = 'ch4finundated'
- character(*), parameter :: subName = "('ch4finundatedstream::Init')"
- !-----------------------------------------------------------------------
- if ( finundation_mtd /= finundation_mtd_h2osfc )then
- call this%InitAllocate( bounds )
- call control%ReadNML( bounds, NLFileName )
-
- if ( this%useStreams() )then
- call clm_domain_mct (bounds, dom_clm)
-
- call shr_strdata_create(sdat,name=stream_name, &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsmap_global, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- yearFirst=1996, &
- yearLast=1996, &
- yearAlign=1, &
- offset=0, &
- domFilePath='', &
- domFileName=trim(control%stream_fldFileName_ch4finundated), &
- domTvarName='time', &
- domXvarName='LONGXY' , &
- domYvarName='LATIXY' , &
- domAreaName='AREA', &
- domMaskName='LANDMASK', &
- filePath='', &
- filename=(/trim(control%stream_fldFileName_ch4finundated)/), &
- fldListFile=control%fldList, &
- fldListModel=control%fldList, &
- fillalgo='none', &
- mapalgo=control%ch4finundatedmapalgo, &
- calendar=get_calendar(), &
- taxmode='extend' )
-
- if (masterproc) then
- call shr_strdata_print(sdat,'CLM '//stream_name//' data')
- endif
-
- if( finundation_mtd == finundation_mtd_ZWT_inversion )then
- index_ZWT0 = mct_avect_indexra(sdat%avs(1),'ZWT0')
- index_F0 = mct_avect_indexra(sdat%avs(1),'F0' )
- index_P3 = mct_avect_indexra(sdat%avs(1),'P3' )
- else if( finundation_mtd == finundation_mtd_TWS_inversion )then
- index_FWS_TWS_A = mct_avect_indexra(sdat%avs(1),'FWS_TWS_A')
- index_FWS_TWS_B = mct_avect_indexra(sdat%avs(1),'FWS_TWS_B')
- end if
-
-
- ! Explicitly set current date to a hardcoded constant value. Otherwise
- ! using the real date can cause roundoff differences that are
- ! detrected as issues with exact restart. EBK M05/20/2017
- !call get_curr_date(year, mon, day, sec)
- year = 1996
- mon = 12
- day = 31
- sec = 0
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ch4finundated')
-
- ! Get the data
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- if ( index_ZWT0 > 0 )then
- this%zwt0_gdc(g) = sdat%avs(1)%rAttr(index_ZWT0,ig)
- end if
- if ( index_F0 > 0 )then
- this%f0_gdc(g) = sdat%avs(1)%rAttr(index_F0,ig)
- end if
- if ( index_P3 > 0 )then
- this%p3_gdc(g) = sdat%avs(1)%rAttr(index_P3,ig)
- end if
- if ( index_FWS_TWS_A > 0 )then
- this%fws_slope_gdc(g) = sdat%avs(1)%rAttr(index_FWS_TWS_A,ig)
- end if
- if ( index_FWS_TWS_B > 0 )then
- this%fws_intercept_gdc(g) = sdat%avs(1)%rAttr(index_FWS_TWS_B,ig)
- end if
- end do
- end if
- end if
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- logical function UseStreams(this)
- !
- ! !DESCRIPTION:
- ! Return true if
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- implicit none
- class(ch4finundatedstream_type) :: this
- !
- ! !LOCAL VARIABLES:
- if ( trim(control%stream_fldFileName_ch4finundated) == '' )then
- UseStreams = .false.
- else
- UseStreams = .true.
- end if
- end function UseStreams
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Allocate module variables and data structures
- !
- ! !USES:
- use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=)
- use ch4varcon , only: finundation_mtd_ZWT_inversion, finundation_mtd_TWS_inversion
- !
- ! !ARGUMENTS:
- implicit none
- class(ch4finundatedstream_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: begg, endg
- !---------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- if( finundation_mtd == finundation_mtd_ZWT_inversion )then
- allocate(this%zwt0_gdc (begg:endg)) ; this%zwt0_gdc (:) = nan
- allocate(this%f0_gdc (begg:endg)) ; this%f0_gdc (:) = nan
- allocate(this%p3_gdc (begg:endg)) ; this%p3_gdc (:) = nan
- else if( finundation_mtd == finundation_mtd_TWS_inversion )then
- allocate(this%fws_slope_gdc (begg:endg)) ; this%fws_slope_gdc (:) = nan
- allocate(this%fws_intercept_gdc(begg:endg)) ; this%fws_intercept_gdc(:) = nan
- end if
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine CalcFinundated(this, bounds, num_soilc, filter_soilc, soilhydrology_inst, &
- waterdiagnosticbulk_inst, qflx_surf_lag_col, finundated )
- !
- ! !DESCRIPTION:
- !
- ! Calculate finundated according to the appropriate methodology
- !
- ! !USES:
- use ColumnType , only : col
- use ch4varcon , only : finundation_mtd_h2osfc, finundation_mtd_ZWT_inversion
- use ch4varcon , only : finundation_mtd_TWS_inversion
- use clm_varpar , only : nlevsoi
- use SoilHydrologyType, only : soilhydrology_type
- use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type
- !
- ! !ARGUMENTS:
- implicit none
- class(ch4finundatedstream_type) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilc ! number of column soil points in column filter
- integer , intent(in) :: filter_soilc(:) ! column filter for soil points
- type(soilhydrology_type) , intent(in) :: soilhydrology_inst
- type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst
- real(r8) , intent(in) :: qflx_surf_lag_col(bounds%begc:) !time-lagged surface runoff (mm H2O /s)
- real(r8) , intent(inout) :: finundated(bounds%begc:) ! fractional inundated area in soil column (excluding dedicated wetland columns)
- !
- ! !LOCAL VARIABLES:
- integer :: g, c, fc ! Indices
- real(r8) :: zwt_actual ! Total water storage (ZWT) to use either perched or total depending on conditions
-
- SHR_ASSERT_ALL_FL((ubound(qflx_surf_lag_col) == (/bounds%endc/)), sourcefile, __LINE__)
- SHR_ASSERT_ALL_FL((ubound(finundated) == (/bounds%endc/)), sourcefile, __LINE__)
-
- associate( &
- z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) (-nlevsno+1:nlevsoi)
- zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m)
- zwt_perched => soilhydrology_inst%zwt_perched_col , & ! Input: [real(r8) (:) ] perched water table depth (m)
- tws => waterdiagnosticbulk_inst%tws_grc , & ! Input: [real(r8) (:) ] total water storage (kg m-2)
- frac_h2osfc => waterdiagnosticbulk_inst%frac_h2osfc_col & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1)
- )
-
- ! Calculate finundated
- do fc = 1, num_soilc
- c = filter_soilc(fc)
- g = col%gridcell(c)
- select case( finundation_mtd )
- case ( finundation_mtd_h2osfc )
- finundated(c) = frac_h2osfc(c)
- case ( finundation_mtd_ZWT_inversion )
- if (this%zwt0_gdc(g) > 0._r8) then
- if (zwt_perched(c) < z(c,nlevsoi)-1.e-5_r8 .and. zwt_perched(c) < zwt(c)) then
- zwt_actual = zwt_perched(c)
- else
- zwt_actual = zwt(c)
- end if
- finundated(c) = this%f0_gdc(g) * exp(-zwt_actual/this%zwt0_gdc(g)) + this%p3_gdc(g)*qflx_surf_lag_col(c)
- else
- finundated(c) = this%p3_gdc(g)*qflx_surf_lag_col(c)
- end if
- case ( finundation_mtd_TWS_inversion )
- finundated(c) = this%fws_slope_gdc(g) * tws(g) + this%fws_intercept_gdc(g)
- end select
- finundated(c) = min( 1.0_r8, max( 0.0_r8, finundated(c) ) )
- end do
- end associate
-
- end subroutine CalcFinundated
- !==============================================================================
-
- subroutine ReadNML(this, bounds, NLFilename)
- !
- ! Read the namelist data stream information.
- !
- ! Uses:
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use shr_nl_mod , only : shr_nl_find_group_name
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_mpi_mod , only : shr_mpi_bcast
- use fileutils , only : getavu, relavu
- use ch4varcon , only : finundation_mtd_ZWT_inversion, finundation_mtd_TWS_inversion
- !
- ! arguments
- implicit none
- class(streamcontrol_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! local variables
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- character(len=CL) :: stream_fldFileName_ch4finundated = ' '
- character(len=CL) :: ch4finundatedmapalgo = 'bilinear'
- character(len=*), parameter :: namelist_name = 'ch4finundated' ! MUST agree with name in namelist and read
- character(len=*), parameter :: shr_strdata_unset = 'NOT_SET'
- character(len=*), parameter :: subName = "('ch4finundated::ReadNML')"
- character(len=*), parameter :: F00 = "('(ch4finundated_readnml) ',4a)"
- !-----------------------------------------------------------------------
-
- namelist /ch4finundated/ & ! MUST agree with namelist_name above
- ch4finundatedmapalgo, stream_fldFileName_ch4finundated
-
- ! Default values for namelist
-
- ! Read ch4finundated namelist
- if (masterproc) then
- nu_nml = getavu()
- open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call shr_nl_find_group_name(nu_nml, namelist_name, status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=ch4finundated,iostat=nml_error) ! MUST agree with namelist_name above
- if (nml_error /= 0) then
- call endrun(msg=' ERROR reading '//namelist_name//' namelist'//errMsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg=' ERROR finding '//namelist_name//' namelist'//errMsg(sourcefile, __LINE__))
- end if
- close(nu_nml)
- call relavu( nu_nml )
- endif
-
- call shr_mpi_bcast(stream_fldFileName_ch4finundated, mpicom)
- call shr_mpi_bcast(ch4finundatedmapalgo , mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) namelist_name, ' stream settings:'
- write(iulog,*) ' stream_fldFileName_ch4finundated = ',stream_fldFileName_ch4finundated
- write(iulog,*) ' ch4finundatedmapalgo = ',ch4finundatedmapalgo
- write(iulog,*) ' '
- endif
- this%stream_fldFileName_ch4finundated = stream_fldFileName_ch4finundated
- this%ch4finundatedmapalgo = ch4finundatedmapalgo
- if ( finundation_mtd == finundation_mtd_ZWT_inversion )then
- this%fldList = "ZWT0:F0:P3"
- else if ( finundation_mtd == finundation_mtd_TWS_inversion )then
- this%fldList = "FWS_TWS_A:FWS_TWS_B"
- else
- call endrun(msg=' ERROR do NOT know what list of variables to read for this finundation_mtd type'// &
- errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine ReadNML
-
-end module ch4FInundatedStreamType
diff --git a/src/cpl/mct/clm_cpl_indices.F90 b/src/cpl/mct/clm_cpl_indices.F90
deleted file mode 100644
index 09ed89e92d..0000000000
--- a/src/cpl/mct/clm_cpl_indices.F90
+++ /dev/null
@@ -1,330 +0,0 @@
-module clm_cpl_indices
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module containing the indices for the fields passed between CLM and
- ! the driver. Includes the River Transport Model fields (RTM) and the
- ! fields needed by the land-ice component (sno).
- !
- ! !USES:
-
- use shr_sys_mod, only : shr_sys_abort
- implicit none
-
- SAVE
- private ! By default make data private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: clm_cpl_indices_set ! Set the coupler indices
- !
- ! !PUBLIC DATA MEMBERS:
- !
- integer , public :: glc_nec ! number of elevation classes for glacier_mec landunits
- ! (from coupler) - must equal maxpatch_glc from namelist
-
- ! lnd -> drv (required)
-
- integer, public ::index_l2x_Flrl_rofsur ! lnd->rtm input liquid surface fluxes
- integer, public ::index_l2x_Flrl_rofgwl ! lnd->rtm input liquid gwl fluxes
- integer, public ::index_l2x_Flrl_rofsub ! lnd->rtm input liquid subsurface fluxes
- integer, public ::index_l2x_Flrl_rofi ! lnd->rtm input frozen fluxes
- integer, public ::index_l2x_Flrl_irrig ! irrigation withdrawal
-
- integer, public ::index_l2x_Sl_t ! temperature
- integer, public ::index_l2x_Sl_tref ! 2m reference temperature
- integer, public ::index_l2x_Sl_qref ! 2m reference specific humidity
- integer, public ::index_l2x_Sl_avsdr ! albedo: direct , visible
- integer, public ::index_l2x_Sl_anidr ! albedo: direct , near-ir
- integer, public ::index_l2x_Sl_avsdf ! albedo: diffuse, visible
- integer, public ::index_l2x_Sl_anidf ! albedo: diffuse, near-ir
- integer, public ::index_l2x_Sl_snowh ! snow height
- integer, public ::index_l2x_Sl_u10 ! 10m wind
- integer, public ::index_l2x_Sl_ddvel ! dry deposition velocities (optional)
- integer, public ::index_l2x_Sl_fv ! friction velocity
- integer, public ::index_l2x_Sl_ram1 ! aerodynamical resistance
- integer, public ::index_l2x_Sl_soilw ! volumetric soil water
- integer, public ::index_l2x_Fall_taux ! wind stress, zonal
- integer, public ::index_l2x_Fall_tauy ! wind stress, meridional
- integer, public ::index_l2x_Fall_lat ! latent heat flux
- integer, public ::index_l2x_Fall_sen ! sensible heat flux
- integer, public ::index_l2x_Fall_lwup ! upward longwave heat flux
- integer, public ::index_l2x_Fall_evap ! evaporation water flux
- integer, public ::index_l2x_Fall_swnet ! heat flux shortwave net
- integer, public ::index_l2x_Fall_fco2_lnd ! co2 flux **For testing set to 0
- integer, public ::index_l2x_Fall_flxdst1 ! dust flux size bin 1
- integer, public ::index_l2x_Fall_flxdst2 ! dust flux size bin 2
- integer, public ::index_l2x_Fall_flxdst3 ! dust flux size bin 3
- integer, public ::index_l2x_Fall_flxdst4 ! dust flux size bin 4
- integer, public ::index_l2x_Fall_flxvoc ! MEGAN fluxes
- integer, public ::index_l2x_Fall_flxfire ! Fire fluxes
- integer, public ::index_l2x_Sl_ztopfire ! Top of fire emissions (m)
-
- ! In the following, index 0 is bare land, other indices are glc elevation classes
- integer, allocatable, public ::index_l2x_Sl_tsrf(:) ! glc MEC temperature
- integer, allocatable, public ::index_l2x_Sl_topo(:) ! glc MEC topo height
- integer, allocatable, public ::index_l2x_Flgl_qice(:) ! glc MEC ice flux
-
- integer, public ::index_x2l_Sa_methane
- integer, public ::index_l2x_Fall_methane
-
- integer, public :: nflds_l2x = 0
-
- ! drv -> lnd (required)
-
- integer, public ::index_x2l_Sa_z ! bottom atm level height
- integer, public ::index_x2l_Sa_topo ! atm surface height (m)
- integer, public ::index_x2l_Sa_u ! bottom atm level zon wind
- integer, public ::index_x2l_Sa_v ! bottom atm level mer wind
- integer, public ::index_x2l_Sa_ptem ! bottom atm level pot temp
- integer, public ::index_x2l_Sa_shum ! bottom atm level spec hum
- integer, public ::index_x2l_Sa_pbot ! bottom atm level pressure
- integer, public ::index_x2l_Sa_tbot ! bottom atm level temp
- integer, public ::index_x2l_Faxa_lwdn ! downward lw heat flux
- integer, public ::index_x2l_Faxa_rainc ! prec: liquid "convective"
- integer, public ::index_x2l_Faxa_rainl ! prec: liquid "large scale"
- integer, public ::index_x2l_Faxa_snowc ! prec: frozen "convective"
- integer, public ::index_x2l_Faxa_snowl ! prec: frozen "large scale"
- integer, public ::index_x2l_Faxa_swndr ! sw: nir direct downward
- integer, public ::index_x2l_Faxa_swvdr ! sw: vis direct downward
- integer, public ::index_x2l_Faxa_swndf ! sw: nir diffuse downward
- integer, public ::index_x2l_Faxa_swvdf ! sw: vis diffuse downward
- integer, public ::index_x2l_Sa_co2prog ! bottom atm level prognostic co2
- integer, public ::index_x2l_Sa_co2diag ! bottom atm level diagnostic co2
- integer, public ::index_x2l_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition
- integer, public ::index_x2l_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition
- integer, public ::index_x2l_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition
- integer, public ::index_x2l_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition
- integer, public ::index_x2l_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition
- integer, public ::index_x2l_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition
- integer, public ::index_x2l_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition
- integer, public ::index_x2l_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition
- integer, public ::index_x2l_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition
- integer, public ::index_x2l_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition
- integer, public ::index_x2l_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition
- integer, public ::index_x2l_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition
- integer, public ::index_x2l_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition
- integer, public ::index_x2l_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition
-
- integer, public ::index_x2l_Faxa_nhx ! flux nhx from atm
- integer, public ::index_x2l_Faxa_noy ! flux noy from atm
-
- integer, public ::index_x2l_Flrr_flood ! rtm->lnd rof flood flux
- integer, public ::index_x2l_Flrr_volr ! rtm->lnd rof volr total volume
- integer, public ::index_x2l_Flrr_volrmch ! rtm->lnd rof volr main channel volume
-
- ! In the following, index 0 is bare land, other indices are glc elevation classes
- integer, allocatable, public ::index_x2l_Sg_ice_covered(:) ! Fraction of glacier from glc model
- integer, allocatable, public ::index_x2l_Sg_topo(:) ! Topo height from glc model
- integer, allocatable, public ::index_x2l_Flgg_hflx(:) ! Heat flux from glc model
-
- integer, public ::index_x2l_Sg_icemask
- integer, public ::index_x2l_Sg_icemask_coupled_fluxes
-
- integer, public :: nflds_x2l = 0
-
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine clm_cpl_indices_set( )
- !
- ! !DESCRIPTION:
- ! Set the coupler indices needed by the land model coupler
- ! interface.
- !
- ! !USES:
- use seq_flds_mod , only: seq_flds_x2l_fields, seq_flds_l2x_fields
- use mct_mod , only: mct_aVect, mct_aVect_init, mct_avect_indexra
- use mct_mod , only: mct_aVect_clean, mct_avect_nRattr
- use shr_drydep_mod , only: drydep_fields_token, n_drydep
- use shr_megan_mod , only: shr_megan_fields_token, shr_megan_mechcomps_n
- use shr_fire_emis_mod,only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, shr_fire_emis_mechcomps_n
- use clm_varctl , only: ndep_from_cpl
- use glc_elevclass_mod, only: glc_get_num_elevation_classes, glc_elevclass_as_string
- !
- ! !ARGUMENTS:
- implicit none
- !
- ! !REVISION HISTORY:
- ! Author: Mariana Vertenstein
- ! 01/2011, Erik Kluzek: Added protex headers
- !
- ! !LOCAL VARIABLES:
- type(mct_aVect) :: l2x ! temporary, land to coupler
- type(mct_aVect) :: x2l ! temporary, coupler to land
- integer :: num
- character(len=:), allocatable :: nec_str ! string version of glc elev. class number
- character(len=64) :: name
- character(len=32) :: subname = 'clm_cpl_indices_set' ! subroutine name
- !-----------------------------------------------------------------------
-
- ! Determine attribute vector indices
-
- ! create temporary attribute vectors
- call mct_aVect_init(x2l, rList=seq_flds_x2l_fields, lsize=1)
- nflds_x2l = mct_avect_nRattr(x2l)
-
- call mct_aVect_init(l2x, rList=seq_flds_l2x_fields, lsize=1)
- nflds_l2x = mct_avect_nRattr(l2x)
-
- !-------------------------------------------------------------
- ! clm -> drv
- !-------------------------------------------------------------
-
- index_l2x_Flrl_rofsur = mct_avect_indexra(l2x,'Flrl_rofsur')
- index_l2x_Flrl_rofgwl = mct_avect_indexra(l2x,'Flrl_rofgwl')
- index_l2x_Flrl_rofsub = mct_avect_indexra(l2x,'Flrl_rofsub')
- index_l2x_Flrl_rofi = mct_avect_indexra(l2x,'Flrl_rofi')
- index_l2x_Flrl_irrig = mct_avect_indexra(l2x,'Flrl_irrig')
-
- index_l2x_Sl_t = mct_avect_indexra(l2x,'Sl_t')
- index_l2x_Sl_snowh = mct_avect_indexra(l2x,'Sl_snowh')
- index_l2x_Sl_avsdr = mct_avect_indexra(l2x,'Sl_avsdr')
- index_l2x_Sl_anidr = mct_avect_indexra(l2x,'Sl_anidr')
- index_l2x_Sl_avsdf = mct_avect_indexra(l2x,'Sl_avsdf')
- index_l2x_Sl_anidf = mct_avect_indexra(l2x,'Sl_anidf')
- index_l2x_Sl_tref = mct_avect_indexra(l2x,'Sl_tref')
- index_l2x_Sl_qref = mct_avect_indexra(l2x,'Sl_qref')
- index_l2x_Sl_u10 = mct_avect_indexra(l2x,'Sl_u10')
- index_l2x_Sl_ram1 = mct_avect_indexra(l2x,'Sl_ram1')
- index_l2x_Sl_fv = mct_avect_indexra(l2x,'Sl_fv')
- index_l2x_Sl_soilw = mct_avect_indexra(l2x,'Sl_soilw',perrwith='quiet')
-
- if ( n_drydep>0 )then
- index_l2x_Sl_ddvel = mct_avect_indexra(l2x, trim(drydep_fields_token))
- else
- index_l2x_Sl_ddvel = 0
- end if
-
- index_l2x_Fall_taux = mct_avect_indexra(l2x,'Fall_taux')
- index_l2x_Fall_tauy = mct_avect_indexra(l2x,'Fall_tauy')
- index_l2x_Fall_lat = mct_avect_indexra(l2x,'Fall_lat')
- index_l2x_Fall_sen = mct_avect_indexra(l2x,'Fall_sen')
- index_l2x_Fall_lwup = mct_avect_indexra(l2x,'Fall_lwup')
- index_l2x_Fall_evap = mct_avect_indexra(l2x,'Fall_evap')
- index_l2x_Fall_swnet = mct_avect_indexra(l2x,'Fall_swnet')
- index_l2x_Fall_flxdst1 = mct_avect_indexra(l2x,'Fall_flxdst1')
- index_l2x_Fall_flxdst2 = mct_avect_indexra(l2x,'Fall_flxdst2')
- index_l2x_Fall_flxdst3 = mct_avect_indexra(l2x,'Fall_flxdst3')
- index_l2x_Fall_flxdst4 = mct_avect_indexra(l2x,'Fall_flxdst4')
-
- index_l2x_Fall_fco2_lnd = mct_avect_indexra(l2x,'Fall_fco2_lnd',perrwith='quiet')
-
- index_l2x_Fall_methane = mct_avect_indexra(l2x,'Fall_methane',perrWith='quiet')
-
- ! MEGAN fluxes
- if (shr_megan_mechcomps_n>0) then
- index_l2x_Fall_flxvoc = mct_avect_indexra(l2x,trim(shr_megan_fields_token))
- else
- index_l2x_Fall_flxvoc = 0
- endif
-
- ! Fire fluxes
- if (shr_fire_emis_mechcomps_n>0) then
- index_l2x_Fall_flxfire = mct_avect_indexra(l2x,trim(shr_fire_emis_fields_token))
- index_l2x_Sl_ztopfire = mct_avect_indexra(l2x,trim(shr_fire_emis_ztop_token))
- else
- index_l2x_Fall_flxfire = 0
- index_l2x_Sl_ztopfire = 0
- endif
-
- !-------------------------------------------------------------
- ! drv -> clm
- !-------------------------------------------------------------
-
- index_x2l_Sa_z = mct_avect_indexra(x2l,'Sa_z')
- index_x2l_Sa_topo = mct_avect_indexra(x2l,'Sa_topo')
- index_x2l_Sa_u = mct_avect_indexra(x2l,'Sa_u')
- index_x2l_Sa_v = mct_avect_indexra(x2l,'Sa_v')
- index_x2l_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem')
- index_x2l_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot')
- index_x2l_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot')
- index_x2l_Sa_shum = mct_avect_indexra(x2l,'Sa_shum')
- index_x2l_Sa_co2prog = mct_avect_indexra(x2l,'Sa_co2prog',perrwith='quiet')
- index_x2l_Sa_co2diag = mct_avect_indexra(x2l,'Sa_co2diag',perrwith='quiet')
-
- index_x2l_Sa_methane = mct_avect_indexra(x2l,'Sa_methane',perrWith='quiet')
-
- index_x2l_Flrr_volr = mct_avect_indexra(x2l,'Flrr_volr')
- index_x2l_Flrr_volrmch = mct_avect_indexra(x2l,'Flrr_volrmch')
-
- index_x2l_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn')
- index_x2l_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc')
- index_x2l_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl')
- index_x2l_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc')
- index_x2l_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl')
- index_x2l_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr')
- index_x2l_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr')
- index_x2l_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf')
- index_x2l_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf')
- index_x2l_Faxa_bcphidry = mct_avect_indexra(x2l,'Faxa_bcphidry')
- index_x2l_Faxa_bcphodry = mct_avect_indexra(x2l,'Faxa_bcphodry')
- index_x2l_Faxa_bcphiwet = mct_avect_indexra(x2l,'Faxa_bcphiwet')
- index_x2l_Faxa_ocphidry = mct_avect_indexra(x2l,'Faxa_ocphidry')
- index_x2l_Faxa_ocphodry = mct_avect_indexra(x2l,'Faxa_ocphodry')
- index_x2l_Faxa_ocphiwet = mct_avect_indexra(x2l,'Faxa_ocphiwet')
- index_x2l_Faxa_dstdry1 = mct_avect_indexra(x2l,'Faxa_dstdry1')
- index_x2l_Faxa_dstdry2 = mct_avect_indexra(x2l,'Faxa_dstdry2')
- index_x2l_Faxa_dstdry3 = mct_avect_indexra(x2l,'Faxa_dstdry3')
- index_x2l_Faxa_dstdry4 = mct_avect_indexra(x2l,'Faxa_dstdry4')
- index_x2l_Faxa_dstwet1 = mct_avect_indexra(x2l,'Faxa_dstwet1')
- index_x2l_Faxa_dstwet2 = mct_avect_indexra(x2l,'Faxa_dstwet2')
- index_x2l_Faxa_dstwet3 = mct_avect_indexra(x2l,'Faxa_dstwet3')
- index_x2l_Faxa_dstwet4 = mct_avect_indexra(x2l,'Faxa_dstwet4')
-
- index_x2l_Faxa_nhx = mct_avect_indexra(x2l,'Faxa_nhx', perrWith='quiet')
- index_x2l_Faxa_noy = mct_avect_indexra(x2l,'Faxa_noy', perrWith='quiet')
-
- if (index_x2l_Faxa_nhx > 0 .and. index_x2l_Faxa_noy > 0) then
- ndep_from_cpl = .true.
- end if
-
- index_x2l_Flrr_flood = mct_avect_indexra(x2l,'Flrr_flood')
-
- !-------------------------------------------------------------
- ! glc coupling
- !-------------------------------------------------------------
-
- index_x2l_Sg_icemask = mct_avect_indexra(x2l,'Sg_icemask')
- index_x2l_Sg_icemask_coupled_fluxes = mct_avect_indexra(x2l,'Sg_icemask_coupled_fluxes')
-
- glc_nec = glc_get_num_elevation_classes()
- if (glc_nec < 1) then
- call shr_sys_abort('ERROR: In CLM4.5 and later, glc_nec must be at least 1.')
- end if
-
- ! Create coupling fields for all glc elevation classes (1:glc_nec) plus bare land
- ! (index 0).
- allocate(index_l2x_Sl_tsrf(0:glc_nec))
- allocate(index_l2x_Sl_topo(0:glc_nec))
- allocate(index_l2x_Flgl_qice(0:glc_nec))
- allocate(index_x2l_Sg_ice_covered(0:glc_nec))
- allocate(index_x2l_Sg_topo(0:glc_nec))
- allocate(index_x2l_Flgg_hflx(0:glc_nec))
-
- do num = 0,glc_nec
- nec_str = glc_elevclass_as_string(num)
-
- name = 'Sg_ice_covered' // nec_str
- index_x2l_Sg_ice_covered(num) = mct_avect_indexra(x2l,trim(name))
- name = 'Sg_topo' // nec_str
- index_x2l_Sg_topo(num) = mct_avect_indexra(x2l,trim(name))
- name = 'Flgg_hflx' // nec_str
- index_x2l_Flgg_hflx(num) = mct_avect_indexra(x2l,trim(name))
-
- name = 'Sl_tsrf' // nec_str
- index_l2x_Sl_tsrf(num) = mct_avect_indexra(l2x,trim(name))
- name = 'Sl_topo' // nec_str
- index_l2x_Sl_topo(num) = mct_avect_indexra(l2x,trim(name))
- name = 'Flgl_qice' // nec_str
- index_l2x_Flgl_qice(num) = mct_avect_indexra(l2x,trim(name))
- end do
-
- call mct_aVect_clean(x2l)
- call mct_aVect_clean(l2x)
-
- end subroutine clm_cpl_indices_set
-
-!=======================================================================
-
-end module clm_cpl_indices
diff --git a/src/cpl/mct/laiStreamMod.F90 b/src/cpl/mct/laiStreamMod.F90
deleted file mode 100644
index 47d25287b7..0000000000
--- a/src/cpl/mct/laiStreamMod.F90
+++ /dev/null
@@ -1,241 +0,0 @@
-module laiStreamMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Read LAI from stream
- !
- ! !USES:
- use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create
- use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance
- use shr_kind_mod , only : r8=>shr_kind_r8, CL=>shr_kind_CL, CS=>shr_kind_CS, CXX=>shr_kind_CXX
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use clm_varctl , only : iulog, inst_name
- use perf_mod , only : t_startf, t_stopf
- use spmdMod , only : masterproc, mpicom, comp_id
- use ncdio_pio
- use mct_mod
- !
- ! !PUBLIC TYPES:
- implicit none
- private
-
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: lai_init ! position datasets for LAI
- public :: lai_advance ! Advance the LAI streams (outside of a Open-MP threading loop)
- public :: lai_interp ! interpolates between two years of LAI data (when LAI streams
-
- ! !PRIVATE MEMBER DATA:
- integer, allocatable :: g_to_ig(:) ! Array matching gridcell index to data index
- type(shr_strdata_type) :: sdat_lai ! LAI input data stream
-
- character(len=*), parameter :: sourcefile = &
- __FILE__
-
-!==============================================================================
-contains
-!==============================================================================
-
- subroutine lai_init(bounds)
- !
- ! Initialize data stream information for LAI.
- !
- ! !USES:
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use shr_stream_mod , only : shr_stream_file_null
- use shr_string_mod , only : shr_string_listCreateField
- use clm_nlUtilsMod , only : find_nlgroup_name
- use ndepStreamMod , only : clm_domain_mct
- use histFileMod , only : hist_addfld1d
- use domainMod , only : ldomain
- use controlMod , only : NLFilename
- use lnd_set_decomp_and_domain , only : gsmap_global
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
- integer :: stream_year_first_lai ! first year in Lai stream to use
- integer :: stream_year_last_lai ! last year in Lai stream to use
- integer :: model_year_align_lai ! align stream_year_first_lai with
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- type(mct_ggrid) :: dom_clm ! domain information
- character(len=CL) :: stream_fldFileName_lai ! lai stream filename to read
- character(len=CL) :: lai_mapalgo = 'bilinear' ! Mapping alogrithm
- character(len=CL) :: lai_tintalgo = 'linear' ! Time interpolation alogrithm
- character(len=CXX) :: fldList ! field string
- character(*), parameter :: laiString = "LAI" ! base string for field string
- integer , parameter :: numLaiFields = 16 ! number of fields to build field string
- character(*), parameter :: subName = "('laidyn_init')"
- !-----------------------------------------------------------------------
- !
- ! deal with namelist variables here in init
- !
- namelist /lai_streams/ &
- stream_year_first_lai, &
- stream_year_last_lai, &
- model_year_align_lai, &
- lai_mapalgo, &
- stream_fldFileName_lai, &
- lai_tintalgo
-
- ! Default values for namelist
- stream_year_first_lai = 1 ! first year in stream to use
- stream_year_last_lai = 1 ! last year in stream to use
- model_year_align_lai = 1 ! align stream_year_first_lai with this model year
- stream_fldFileName_lai = shr_stream_file_null
-
- ! Read lai_streams namelist
- if (masterproc) then
- open( newunit=nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'lai_streams', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=lai_streams,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(subname // ':: ERROR reading lai_streams namelist')
- end if
- else
- call endrun(subname // ':: ERROR finding lai_streams namelist')
- end if
- close(nu_nml)
- endif
- call shr_mpi_bcast(stream_year_first_lai , mpicom)
- call shr_mpi_bcast(stream_year_last_lai , mpicom)
- call shr_mpi_bcast(model_year_align_lai , mpicom)
- call shr_mpi_bcast(stream_fldFileName_lai , mpicom)
- call shr_mpi_bcast(lai_tintalgo , mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) 'lai_stream settings:'
- write(iulog,*) ' stream_year_first_lai = ',stream_year_first_lai
- write(iulog,*) ' stream_year_last_lai = ',stream_year_last_lai
- write(iulog,*) ' model_year_align_lai = ',model_year_align_lai
- write(iulog,*) ' stream_fldFileName_lai = ',trim(stream_fldFileName_lai)
- write(iulog,*) ' lai_tintalgo = ',trim(lai_tintalgo)
- endif
-
- call clm_domain_mct (bounds, dom_clm)
-
- ! create the field list for these lai fields...use in shr_strdata_create
- fldList = shr_string_listCreateField( numLaiFields, laiString )
-
- call shr_strdata_create(sdat_lai,name="laidyn", &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsmap_global, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- yearFirst=stream_year_first_lai, &
- yearLast=stream_year_last_lai, &
- yearAlign=model_year_align_lai, &
- offset=0, &
- domFilePath='', &
- domFileName=trim(stream_fldFileName_lai), &
- domTvarName='time', &
- domXvarName='lon' , &
- domYvarName='lat' , &
- domAreaName='area', &
- domMaskName='mask', &
- filePath='', &
- filename=(/stream_fldFileName_lai/), &
- fldListFile=fldList, &
- fldListModel=fldList, &
- fillalgo='none', &
- mapalgo=lai_mapalgo, &
- tintalgo=lai_tintalgo, &
- calendar=get_calendar(), &
- taxmode='cycle' )
-
- if (masterproc) then
- call shr_strdata_print(sdat_lai,'LAI data')
- endif
-
- end subroutine lai_init
-
- !==============================================================================
- subroutine lai_advance( bounds )
- !
- ! Advance LAI streams
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g, ig ! Indices
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- !-----------------------------------------------------------------------
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(sdat_lai, mcdate, sec, mpicom, 'laidyn')
- if ( .not. allocated(g_to_ig) )then
- allocate (g_to_ig(bounds%begg:bounds%endg) )
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- g_to_ig(g) = ig
- end do
- end if
-
- end subroutine lai_advance
-
- !==============================================================================
- subroutine lai_interp(bounds, canopystate_inst)
- !
- ! Interpolate data stream information for Lai.
- !
- ! !USES:
- use pftconMod , only : noveg
- use CanopyStateType , only : canopystate_type
- use PatchType , only : patch
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds
- type(canopystate_type) , intent(inout) :: canopystate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: ivt, p, ip, ig
- character(len=CL) :: stream_var_name
- !-----------------------------------------------------------------------
- SHR_ASSERT_FL( (lbound(g_to_ig,1) <= bounds%begg ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(g_to_ig,1) >= bounds%endg ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (lbound(sdat_lai%avs(1)%rAttr,2) <= g_to_ig(bounds%begg) ), sourcefile, __LINE__)
- SHR_ASSERT_FL( (ubound(sdat_lai%avs(1)%rAttr,2) >= g_to_ig(bounds%endg) ), sourcefile, __LINE__)
-
- do p = bounds%begp, bounds%endp
- ivt = patch%itype(p)
- ! Set lai for each gridcell/patch combination
- if (ivt /= noveg) then
- ! vegetated pft
- write(stream_var_name,"(i6)") ivt
- stream_var_name = 'LAI_'//trim(adjustl(stream_var_name))
- ip = mct_aVect_indexRA(sdat_lai%avs(1),trim(stream_var_name))
- ig = g_to_ig(patch%gridcell(p))
- canopystate_inst%tlai_patch(p) = sdat_lai%avs(1)%rAttr(ip,ig)
- else
- ! non-vegetated pft
- canopystate_inst%tlai_patch(p) = 0._r8
- endif
- end do
-
- end subroutine lai_interp
-
-end module LaiStreamMod
diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90
deleted file mode 100644
index e50602a378..0000000000
--- a/src/cpl/mct/lnd_comp_mct.F90
+++ /dev/null
@@ -1,632 +0,0 @@
-module lnd_comp_mct
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Interface of the active land model component of CESM the CLM (Community Land Model)
- ! with the main CESM driver. This is a thin interface taking CESM driver information
- ! in MCT (Model Coupling Toolkit) format and converting it to use by CLM.
- !
- ! !uses:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_sys_mod , only : shr_sys_flush
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use mct_mod , only : mct_avect, mct_gsmap, mct_gGrid
- use decompmod , only : bounds_type
- use lnd_import_export, only : lnd_import, lnd_export
- !
- ! !public member functions:
- implicit none
- private ! by default make data private
- !
- ! !public member functions:
- public :: lnd_init_mct ! clm initialization
- public :: lnd_run_mct ! clm run phase
- public :: lnd_final_mct ! clm finalization/cleanup
- !
- ! !private member functions:
- private :: lnd_domain_mct ! set the land model domain information
- private :: lnd_handle_resume ! handle pause/resume signals from the coupler
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-!====================================================================================
-contains
-!====================================================================================
-
- subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename )
- !
- ! !DESCRIPTION:
- ! Initialize land surface model and obtain relevant atmospheric model arrays
- ! back from (i.e. albedos, surface temperature and snow cover over land).
- !
- ! !USES:
- use shr_kind_mod , only : shr_kind_cl
- use abortutils , only : endrun
- use clm_time_manager , only : get_nstep, set_timemgr_init
- use clm_initializeMod, only : initialize1, initialize2
- use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst
- use clm_varctl , only : finidat, single_column, clm_varctl_set, iulog
- use clm_varctl , only : inst_index, inst_suffix, inst_name
- use clm_varorb , only : eccen, obliqr, lambm0, mvelpp
- use controlMod , only : control_setNL
- use decompMod , only : get_proc_bounds
- use domainMod , only : ldomain
- use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel
- use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel
- use shr_file_mod , only : shr_file_getUnit, shr_file_setIO
- use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs
- use seq_timemgr_mod , only : seq_timemgr_EClockGetData
- use seq_infodata_mod , only : seq_infodata_type, seq_infodata_GetData, seq_infodata_PutData, &
- seq_infodata_start_type_start, seq_infodata_start_type_cont, &
- seq_infodata_start_type_brnch
- use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name
- use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields
- use spmdMod , only : masterproc, spmd_init
- use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch
- use clm_cpl_indices , only : clm_cpl_indices_set
- use mct_mod , only : mct_aVect_init, mct_aVect_zero, mct_gsMap, mct_gsMap_init
- use decompMod , only : gindex_global
- use lnd_set_decomp_and_domain, only : lnd_set_decomp_and_domain_from_surfrd, gsmap_global
- use ESMF
- !
- ! !ARGUMENTS:
- type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock
- type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data
- type(mct_aVect), intent(inout) :: x2l_l, l2x_l ! land model import and export states
- character(len=*), optional, intent(in) :: NLFilename ! Namelist filename to read
- !
- ! !LOCAL VARIABLES:
- integer :: LNDID ! Land identifyer
- integer :: mpicom_lnd ! MPI communicator
- type(mct_gsMap), pointer :: GSMap_lnd ! Land model MCT GS map
- type(mct_gGrid), pointer :: dom_l ! Land model domain
- type(seq_infodata_type), pointer :: infodata ! CESM driver level info data
- integer :: lsize ! size of attribute vector
- integer :: gsize ! global size
- integer :: g,i,j ! indices
- integer :: dtime_sync ! coupling time-step from the input synchronization clock
- logical :: exists ! true if file exists
- logical :: atm_aero ! Flag if aerosol data sent from atm model
- real(r8) :: scmlat ! single-column latitude
- real(r8) :: scmlon ! single-column longitude
- character(len=SHR_KIND_CL) :: caseid ! case identifier name
- character(len=SHR_KIND_CL) :: ctitle ! case description title
- character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid)
- character(len=SHR_KIND_CL) :: calendar ! calendar type name
- character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on
- character(len=SHR_KIND_CL) :: version ! Model version
- character(len=SHR_KIND_CL) :: username ! user running the model
- integer :: nsrest ! clm restart type
- integer :: ref_ymd ! reference date (YYYYMMDD)
- integer :: ref_tod ! reference time of day (sec)
- integer :: start_ymd ! start date (YYYYMMDD)
- integer :: start_tod ! start time of day (sec)
- logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type
- integer :: lbnum ! input to memory diagnostic
- integer :: shrlogunit,shrloglev ! old values for log unit and log level
- type(bounds_type) :: bounds ! bounds
- logical :: noland
- integer :: ni,nj
- real(r8) , parameter :: rundef = -9999999._r8
- character(len=32), parameter :: sub = 'lnd_init_mct'
- character(len=*), parameter :: format = "('("//trim(sub)//") :',A)"
- !-----------------------------------------------------------------------
-
- ! Set cdata data
- call seq_cdata_setptrs(cdata_l, ID=LNDID, mpicom=mpicom_lnd, &
- gsMap=GSMap_lnd, dom=dom_l, infodata=infodata)
-
- ! Determine attriute vector indices
- call clm_cpl_indices_set()
-
- ! Initialize clm MPI communicator
- call spmd_init( mpicom_lnd, LNDID )
-
-#if (defined _MEMTRACE)
- if(masterproc) then
- lbnum=1
- call memmon_dump_fort('memmon.out','lnd_init_mct:start::',lbnum)
- endif
-#endif
-
- inst_name = seq_comm_name(LNDID)
- inst_index = seq_comm_inst(LNDID)
- inst_suffix = seq_comm_suffix(LNDID)
- ! Initialize io log unit
-
- call shr_file_getLogUnit (shrlogunit)
- if (masterproc) then
- inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists)
- if (exists) then
- iulog = shr_file_getUnit()
- call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog)
- end if
- write(iulog,format) "CLM land model initialization"
- else
- iulog = shrlogunit
- end if
-
- call shr_file_getLogLevel(shrloglev)
- call shr_file_setLogUnit (iulog)
-
- ! Use infodata to set orbital values
- call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, &
- orb_lambm0=lambm0, orb_obliqr=obliqr )
-
- ! Consistency check on namelist filename
- call control_setNL("lnd_in"//trim(inst_suffix))
-
- ! Initialize clm
- ! initialize1 reads namelists
- ! decomp and domain are set in lnd_set_decomp_and_domain_from_surfrd
- ! initialize2 performs the rest of initialization
- call seq_timemgr_EClockGetData(EClock, &
- start_ymd=start_ymd, &
- start_tod=start_tod, ref_ymd=ref_ymd, &
- ref_tod=ref_tod, &
- calendar=calendar, &
- dtime=dtime_sync)
- if (masterproc) then
- write(iulog,*)'dtime = ',dtime_sync
- end if
- call seq_infodata_GetData(infodata, case_name=caseid, &
- case_desc=ctitle, single_column=single_column, &
- scmlat=scmlat, scmlon=scmlon, &
- brnch_retain_casename=brnch_retain_casename, &
- start_type=starttype, model_version=version, &
- hostname=hostname, username=username )
-
- ! Single Column
- if ( single_column .and. (scmlat == rundef .or. scmlon == rundef ) ) then
- call endrun(msg=' ERROR:: single column mode on -- but scmlat and scmlon are NOT set'//&
- errMsg(sourcefile, __LINE__))
- end if
-
- ! Note that we assume that CTSM's internal dtime matches the coupling time step.
- ! i.e., we currently do NOT allow sub-cycling within a coupling time step.
- call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, &
- ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, dtime_in=dtime_sync)
-
- if ( trim(starttype) == trim(seq_infodata_start_type_start)) then
- nsrest = nsrStartup
- else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then
- nsrest = nsrContinue
- else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then
- nsrest = nsrBranch
- else
- call endrun( sub//' ERROR: unknown starttype' )
- end if
-
- ! set default values for run control variables
- call clm_varctl_set(caseid_in=caseid, ctitle_in=ctitle, &
- brnch_retain_casename_in=brnch_retain_casename, &
- single_column_in=single_column, scmlat_in=scmlat, &
- scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, &
- hostname_in=hostname, username_in=username)
-
- ! Read namelists
- call initialize1(dtime=dtime_sync)
-
- ! Initialize decomposition and domain (ldomain) type
- call lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj)
-
- ! If no land then exit out of initialization
- if ( noland ) then
-
- call seq_infodata_PutData( infodata, lnd_present =.false.)
- call seq_infodata_PutData( infodata, lnd_prognostic=.false.)
-
- else
-
- ! Determine if aerosol and dust deposition come from atmosphere component
- call seq_infodata_GetData(infodata, atm_aero=atm_aero )
- if ( .not. atm_aero )then
- call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' )
- end if
-
- ! Initialize clm gsMap, clm domain and clm attribute vectors
- call get_proc_bounds( bounds )
- lsize = bounds%endg - bounds%begg + 1
- gsize = ldomain%ni * ldomain%nj
- call mct_gsMap_init( gsMap_lnd, gindex_global, mpicom_lnd, LNDID, lsize, gsize )
- gsmap_global => gsmap_lnd ! module variable in lnd_set_decomp_and_domain
- call lnd_domain_mct( bounds, lsize, gsMap_lnd, dom_l )
- call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsize)
- call mct_aVect_zero(x2l_l)
- call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsize)
- call mct_aVect_zero(l2x_l)
-
- ! Finish initializing clm
- call initialize2(ni,nj)
-
- ! Create land export state
- call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr)
-
- ! Fill in infodata settings
- call seq_infodata_PutData(infodata, lnd_prognostic=.true.)
- call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj)
- call lnd_handle_resume( cdata_l )
-
- ! Reset shr logging to original values
- call shr_file_setLogUnit (shrlogunit)
- call shr_file_setLogLevel(shrloglev)
-
-#if (defined _MEMTRACE)
- if(masterproc) then
- write(iulog,*) TRIM(Sub) // ':end::'
- lbnum=1
- call memmon_dump_fort('memmon.out','lnd_int_mct:end::',lbnum)
- call memmon_reset_addr()
- endif
-#endif
- end if
-
- end subroutine lnd_init_mct
-
- !====================================================================================
- subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l)
- !
- ! !DESCRIPTION:
- ! Run clm model
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use clm_instMod , only : water_inst, lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst
- use clm_driver , only : clm_drv
- use clm_time_manager, only : get_curr_date, get_nstep, get_curr_calday, get_step_size
- use clm_time_manager, only : advance_timestep, update_rad_dtime
- use decompMod , only : get_proc_bounds
- use abortutils , only : endrun
- use clm_varctl , only : iulog
- use clm_varorb , only : eccen, obliqr, lambm0, mvelpp
- use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel
- use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel
- use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs
- use seq_timemgr_mod , only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn
- use seq_timemgr_mod , only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync
- use seq_infodata_mod, only : seq_infodata_type, seq_infodata_GetData
- use spmdMod , only : masterproc, mpicom
- use perf_mod , only : t_startf, t_stopf, t_barrierf
- use shr_orb_mod , only : shr_orb_decl
- use ESMF
- !
- ! !ARGUMENTS:
- type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver
- type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model
- type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model
- type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model
- !
- ! !LOCAL VARIABLES:
- integer :: ymd_sync ! Sync date (YYYYMMDD)
- integer :: yr_sync ! Sync current year
- integer :: mon_sync ! Sync current month
- integer :: day_sync ! Sync current day
- integer :: tod_sync ! Sync current time of day (sec)
- integer :: ymd ! CLM current date (YYYYMMDD)
- integer :: yr ! CLM current year
- integer :: mon ! CLM current month
- integer :: day ! CLM current day
- integer :: tod ! CLM current time of day (sec)
- integer :: dtime ! time step increment (sec)
- integer :: nstep ! time step index
- logical :: rstwr_sync ! .true. ==> write restart file before returning
- logical :: rstwr ! .true. ==> write restart file before returning
- logical :: nlend_sync ! Flag signaling last time-step
- logical :: nlend ! .true. ==> last time-step
- logical :: dosend ! true => send data back to driver
- logical :: doalb ! .true. ==> do albedo calculation on this time step
- logical :: rof_prognostic ! .true. => running with a prognostic ROF model
- logical :: glc_present ! .true. => running with a non-stub GLC model
- real(r8) :: nextsw_cday ! calday from clock of next radiation computation
- real(r8) :: caldayp1 ! clm calday plus dtime offset
- integer :: shrlogunit,shrloglev ! old values for share log unit and log level
- integer :: lbnum ! input to memory diagnostic
- integer :: g,i,lsize ! counters
- real(r8) :: calday ! calendar day for nstep
- real(r8) :: declin ! solar declination angle in radians for nstep
- real(r8) :: declinp1 ! solar declination angle in radians for nstep+1
- real(r8) :: eccf ! earth orbit eccentricity factor
- real(r8) :: recip ! reciprical
- logical,save :: first_call = .true. ! first call work
- type(seq_infodata_type),pointer :: infodata ! CESM information from the driver
- type(mct_gGrid), pointer :: dom_l ! Land model domain data
- type(bounds_type) :: bounds ! bounds
- character(len=32) :: rdate ! date char string for restart file names
- character(len=32), parameter :: sub = "lnd_run_mct"
- !---------------------------------------------------------------------------
-
- ! Determine processor bounds
-
- call get_proc_bounds(bounds)
-
-#if (defined _MEMTRACE)
- if(masterproc) then
- lbnum=1
- call memmon_dump_fort('memmon.out','lnd_run_mct:start::',lbnum)
- endif
-#endif
-
- ! Reset shr logging to my log file
- call shr_file_getLogUnit (shrlogunit)
- call shr_file_getLogLevel(shrloglev)
- call shr_file_setLogUnit (iulog)
-
- ! Determine time of next atmospheric shortwave calculation
- call seq_cdata_setptrs(cdata_l, infodata=infodata, dom=dom_l)
- call seq_timemgr_EClockGetData(EClock, &
- curr_ymd=ymd, curr_tod=tod_sync, &
- curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync)
- call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday )
-
- dtime = get_step_size()
-
- ! Handle pause/resume signals from coupler
- call lnd_handle_resume( cdata_l )
-
- write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync
- nlend_sync = seq_timemgr_StopAlarmIsOn( EClock )
- rstwr_sync = seq_timemgr_RestartAlarmIsOn( EClock )
-
- ! Determine if we're running with a prognostic ROF model, and if we're running with a
- ! non-stub GLC model. These won't change throughout the run, but we can't count on
- ! their being set in initialization, so need to get them in the run method.
-
- call seq_infodata_GetData( infodata, &
- rof_prognostic=rof_prognostic, &
- glc_present=glc_present)
-
- ! Map MCT to land data type
- ! Perform downscaling if appropriate
-
-
- ! Map to clm (only when state and/or fluxes need to be updated)
-
- call t_startf ('lc_lnd_import')
- call lnd_import( bounds, &
- x2l = x2l_l%rattr, &
- glc_present = glc_present, &
- atm2lnd_inst = atm2lnd_inst, &
- glc2lnd_inst = glc2lnd_inst, &
- wateratm2lndbulk_inst = water_inst%wateratm2lndbulk_inst)
- call t_stopf ('lc_lnd_import')
-
- ! Use infodata to set orbital values if updated mid-run
-
- call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, &
- orb_lambm0=lambm0, orb_obliqr=obliqr )
-
- ! Loop over time steps in coupling interval
-
- dosend = .false.
- do while(.not. dosend)
-
- ! Determine if dosend
- ! When time is not updated at the beginning of the loop - then return only if
- ! are in sync with clock before time is updated
- !
- ! NOTE(wjs, 2020-03-09) I think the do while (.not. dosend) loop only is important
- ! for the first time step (when we run 2 steps). After that, we now assume that we
- ! run one time step per coupling interval (based on setting the model's dtime from
- ! the driver). (According to Mariana Vertenstein, sub-cycling (running multiple
- ! land model time steps per coupling interval) used to be supported, but hasn't
- ! been fully supported for a long time.) We may want to rework this logic to make
- ! this more explicit, or - ideally - get rid of this extra time step at the start
- ! of the run, at which point I think we could do away with this looping entirely.
-
- call get_curr_date( yr, mon, day, tod )
- ymd = yr*10000 + mon*100 + day
- tod = tod
- dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod))
-
- ! Determine doalb based on nextsw_cday sent from atm model
-
- nstep = get_nstep()
- caldayp1 = get_curr_calday(offset=dtime, reuse_day_365_for_day_366=.true.)
- if (nstep == 0) then
- doalb = .false.
- else if (nstep == 1) then
- doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8)
- else
- doalb = (nextsw_cday >= -0.5_r8)
- end if
- call update_rad_dtime(doalb)
-
- ! Determine if time to write restart and stop
-
- rstwr = .false.
- if (rstwr_sync .and. dosend) rstwr = .true.
- nlend = .false.
- if (nlend_sync .and. dosend) nlend = .true.
-
- ! Run clm
-
- call t_barrierf('sync_clm_run1', mpicom)
- call t_startf ('clm_run')
- call t_startf ('shr_orb_decl')
- calday = get_curr_calday(reuse_day_365_for_day_366=.true.)
- call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf )
- call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf )
- call t_stopf ('shr_orb_decl')
- call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)
- call t_stopf ('clm_run')
-
- ! Create l2x_l export state - add river runoff input to l2x_l if appropriate
-
- call t_startf ('lc_lnd_export')
- call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr)
- call t_stopf ('lc_lnd_export')
-
- ! Advance clm time step
-
- call t_startf ('lc_clm2_adv_timestep')
- call advance_timestep()
- call t_stopf ('lc_clm2_adv_timestep')
-
- end do
-
- ! Check that internal clock is in sync with master clock
-
- call get_curr_date( yr, mon, day, tod, offset=-dtime )
- ymd = yr*10000 + mon*100 + day
- tod = tod
- if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then
- call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync )
- write(iulog,*)' clm ymd=',ymd ,' clm tod= ',tod
- write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync
- call endrun( sub//":: CLM clock not in sync with Master Sync clock" )
- end if
-
- ! Reset shr logging to my original values
-
- call shr_file_setLogUnit (shrlogunit)
- call shr_file_setLogLevel(shrloglev)
-
-#if (defined _MEMTRACE)
- if(masterproc) then
- lbnum=1
- call memmon_dump_fort('memmon.out','lnd_run_mct:end::',lbnum)
- call memmon_reset_addr()
- endif
-#endif
-
- first_call = .false.
-
- end subroutine lnd_run_mct
-
- !====================================================================================
- subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l)
- !
- ! !DESCRIPTION:
- ! Finalize land surface model
-
- use seq_cdata_mod ,only : seq_cdata, seq_cdata_setptrs
- use seq_timemgr_mod ,only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn
- use seq_timemgr_mod ,only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync
- use esmf
- !
- ! !ARGUMENTS:
- type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver
- type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model
- type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model
- type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model
- !---------------------------------------------------------------------------
-
- ! fill this in
- end subroutine lnd_final_mct
-
- !====================================================================================
- subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l )
- !
- ! !DESCRIPTION:
- ! Send the land model domain information to the coupler
- !
- ! !USES:
- use clm_varcon , only: re
- use domainMod , only: ldomain
- use spmdMod , only: iam
- use mct_mod , only: mct_gGrid_importIAttr
- use mct_mod , only: mct_gGrid_importRAttr, mct_gGrid_init, mct_gsMap_orderedPoints
- use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds ! bounds
- integer , intent(in) :: lsize ! land model domain data size
- type(mct_gsMap), intent(inout) :: gsMap_l ! Output land model MCT GS map
- type(mct_ggrid), intent(out) :: dom_l ! Output domain information for land model
- !
- ! Local Variables
- integer :: g,i,j ! index
- real(r8), pointer :: data(:) ! temporary
- integer , pointer :: idata(:) ! temporary
- !---------------------------------------------------------------------------
- !
- ! Initialize mct domain type
- ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land)
- ! Note that in addition land carries around landfrac for the purposes of domain checking
- !
- call mct_gGrid_init( GGrid=dom_l, CoordChars=trim(seq_flds_dom_coord), &
- OtherChars=trim(seq_flds_dom_other), lsize=lsize )
- !
- ! Allocate memory
- !
- allocate(data(lsize))
- !
- ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT
- !
- call mct_gsMap_orderedPoints(gsMap_l, iam, idata)
- call mct_gGrid_importIAttr(dom_l,'GlobGridNum',idata,lsize)
- !
- ! Determine domain (numbering scheme is: West to East and South to North to South pole)
- ! Initialize attribute vector with special value
- !
- data(:) = -9999.0_R8
- call mct_gGrid_importRAttr(dom_l,"lat" ,data,lsize)
- call mct_gGrid_importRAttr(dom_l,"lon" ,data,lsize)
- call mct_gGrid_importRAttr(dom_l,"area" ,data,lsize)
- call mct_gGrid_importRAttr(dom_l,"aream",data,lsize)
- data(:) = 0.0_R8
- call mct_gGrid_importRAttr(dom_l,"mask" ,data,lsize)
- !
- ! Fill in correct values for domain components
- ! Note aream will be filled in in the atm-lnd mapper
- !
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%lonc(g)
- end do
- call mct_gGrid_importRattr(dom_l,"lon",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%latc(g)
- end do
- call mct_gGrid_importRattr(dom_l,"lat",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%area(g)/(re*re)
- end do
- call mct_gGrid_importRattr(dom_l,"area",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = real(ldomain%mask(g), r8)
- end do
- call mct_gGrid_importRattr(dom_l,"mask",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = real(ldomain%frac(g), r8)
- end do
- call mct_gGrid_importRattr(dom_l,"frac",data,lsize)
-
- deallocate(data)
- deallocate(idata)
-
- end subroutine lnd_domain_mct
-
- !====================================================================================
- subroutine lnd_handle_resume( cdata_l )
- !
- ! !DESCRIPTION:
- ! Handle resume signals for Data Assimilation (DA)
- !
- ! !USES:
- use clm_time_manager , only : update_DA_nstep
- use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs
- implicit none
- ! !ARGUMENTS:
- type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data
- ! !LOCAL VARIABLES:
- logical :: resume_from_data_assim ! flag if we are resuming after data assimulation was done
- !---------------------------------------------------------------------------
-
- ! Check to see if restart was modified and we are resuming from data
- ! assimilation
- call seq_cdata_setptrs(cdata_l, post_assimilation=resume_from_data_assim)
- if ( resume_from_data_assim ) call update_DA_nstep()
-
- end subroutine lnd_handle_resume
-
-end module lnd_comp_mct
diff --git a/src/cpl/mct/lnd_import_export.F90 b/src/cpl/mct/lnd_import_export.F90
deleted file mode 100644
index 537abd49d9..0000000000
--- a/src/cpl/mct/lnd_import_export.F90
+++ /dev/null
@@ -1,354 +0,0 @@
-module lnd_import_export
-
- use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl
- use abortutils , only: endrun
- use decompmod , only: bounds_type, subgrid_level_gridcell
- use lnd2atmType , only: lnd2atm_type
- use lnd2glcMod , only: lnd2glc_type
- use atm2lndType , only: atm2lnd_type
- use glc2lndMod , only: glc2lnd_type
- use Waterlnd2atmBulkType , only: waterlnd2atmbulk_type
- use Wateratm2lndBulkType , only: wateratm2lndbulk_type
- use clm_cpl_indices
- use GridcellType , only : grc
- !
- implicit none
- !===============================================================================
-
-contains
-
- !===============================================================================
- subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst, wateratm2lndbulk_inst)
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Convert the input data from the coupler to the land model
- !
- ! !USES:
- use seq_flds_mod , only: seq_flds_x2l_fields
- use clm_varctl , only: co2_type, co2_ppmv, iulog, use_c13
- use clm_varctl , only: ndep_from_cpl
- use clm_varcon , only: c13ratio
- use domainMod , only: ldomain
- use lnd_import_export_utils, only : derive_quantities, check_for_errors, check_for_nans
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! bounds
- real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model
- logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model
- type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type
- type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type
- type(wateratm2lndbulk_type), intent(inout) :: wateratm2lndbulk_inst ! clm internal input data type
- !
- ! !LOCAL VARIABLES:
- integer :: begg, endg ! bounds
- integer :: g,i,k,nstep,ier ! indices, number of steps, and error code
- real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg)
- real(r8) :: forc_pbot ! atmospheric pressure (Pa)
- real(r8) :: forc_rainc(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s
- real(r8) :: forc_rainl(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s
- real(r8) :: forc_snowc(bounds%begg:bounds%endg) ! snowfxy Atm flux mm/s
- real(r8) :: forc_snowl(bounds%begg:bounds%endg) ! snowfxl Atm flux mm/s
- real(r8) :: co2_ppmv_diag ! temporary
- real(r8) :: co2_ppmv_prog ! temporary
- real(r8) :: co2_ppmv_val ! temporary
- integer :: co2_type_idx ! integer flag for co2_type options
- character(len=32) :: fname ! name of field that is NaN
- character(len=32), parameter :: sub = 'lnd_import'
-
- !---------------------------------------------------------------------------
-
- ! Set bounds
- begg = bounds%begg; endg = bounds%endg
-
- co2_type_idx = 0
- if (co2_type == 'prognostic') then
- co2_type_idx = 1
- else if (co2_type == 'diagnostic') then
- co2_type_idx = 2
- end if
- if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then
- call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' )
- else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then
- call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' )
- end if
-
- ! Note that the precipitation fluxes received from the coupler
- ! are in units of kg/s/m^2. To convert these precipitation rates
- ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply
- ! by 1000 mm/m resulting in an overall factor of unity.
- ! Below the units are therefore given in mm/s.
-
- do g = begg,endg
- i = 1 + (g - begg)
-
- ! Determine flooding input, sign convention is positive downward and
- ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative,
- ! change the sign to indicate addition of water to system.
-
- wateratm2lndbulk_inst%forc_flood_grc(g) = -x2l(index_x2l_Flrr_flood,i)
-
- wateratm2lndbulk_inst%volr_grc(g) = x2l(index_x2l_Flrr_volr,i) * (ldomain%area(g) * 1.e6_r8)
- wateratm2lndbulk_inst%volrmch_grc(g)= x2l(index_x2l_Flrr_volrmch,i) * (ldomain%area(g) * 1.e6_r8)
-
- ! Determine required receive fields
-
- atm2lnd_inst%forc_hgt_grc(g) = x2l(index_x2l_Sa_z,i) ! zgcmxy Atm state m
- atm2lnd_inst%forc_topo_grc(g) = x2l(index_x2l_Sa_topo,i) ! Atm surface height (m)
- atm2lnd_inst%forc_u_grc(g) = x2l(index_x2l_Sa_u,i) ! forc_uxy Atm state m/s
- atm2lnd_inst%forc_v_grc(g) = x2l(index_x2l_Sa_v,i) ! forc_vxy Atm state m/s
- atm2lnd_inst%forc_solad_not_downscaled_grc(g,2) = x2l(index_x2l_Faxa_swndr,i) ! forc_sollxy Atm flux W/m^2
- atm2lnd_inst%forc_solad_not_downscaled_grc(g,1) = x2l(index_x2l_Faxa_swvdr,i) ! forc_solsxy Atm flux W/m^2
- atm2lnd_inst%forc_solai_grc(g,2) = x2l(index_x2l_Faxa_swndf,i) ! forc_solldxy Atm flux W/m^2
- atm2lnd_inst%forc_solai_grc(g,1) = x2l(index_x2l_Faxa_swvdf,i) ! forc_solsdxy Atm flux W/m^2
-
- atm2lnd_inst%forc_th_not_downscaled_grc(g) = x2l(index_x2l_Sa_ptem,i) ! forc_thxy Atm state K
- wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = x2l(index_x2l_Sa_shum,i) ! forc_qxy Atm state kg/kg
- atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = x2l(index_x2l_Sa_pbot,i) ! ptcmxy Atm state Pa
- atm2lnd_inst%forc_t_not_downscaled_grc(g) = x2l(index_x2l_Sa_tbot,i) ! forc_txy Atm state K
- atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) = x2l(index_x2l_Faxa_lwdn,i) ! flwdsxy Atm flux W/m^2
-
- forc_rainc(g) = x2l(index_x2l_Faxa_rainc,i) ! mm/s
- forc_rainl(g) = x2l(index_x2l_Faxa_rainl,i) ! mm/s
- forc_snowc(g) = x2l(index_x2l_Faxa_snowc,i) ! mm/s
- forc_snowl(g) = x2l(index_x2l_Faxa_snowl,i) ! mm/s
-
- ! atmosphere coupling, for prognostic/prescribed aerosols
- atm2lnd_inst%forc_aer_grc(g,1) = x2l(index_x2l_Faxa_bcphidry,i)
- atm2lnd_inst%forc_aer_grc(g,2) = x2l(index_x2l_Faxa_bcphodry,i)
- atm2lnd_inst%forc_aer_grc(g,3) = x2l(index_x2l_Faxa_bcphiwet,i)
- atm2lnd_inst%forc_aer_grc(g,4) = x2l(index_x2l_Faxa_ocphidry,i)
- atm2lnd_inst%forc_aer_grc(g,5) = x2l(index_x2l_Faxa_ocphodry,i)
- atm2lnd_inst%forc_aer_grc(g,6) = x2l(index_x2l_Faxa_ocphiwet,i)
- atm2lnd_inst%forc_aer_grc(g,7) = x2l(index_x2l_Faxa_dstwet1,i)
- atm2lnd_inst%forc_aer_grc(g,8) = x2l(index_x2l_Faxa_dstdry1,i)
- atm2lnd_inst%forc_aer_grc(g,9) = x2l(index_x2l_Faxa_dstwet2,i)
- atm2lnd_inst%forc_aer_grc(g,10) = x2l(index_x2l_Faxa_dstdry2,i)
- atm2lnd_inst%forc_aer_grc(g,11) = x2l(index_x2l_Faxa_dstwet3,i)
- atm2lnd_inst%forc_aer_grc(g,12) = x2l(index_x2l_Faxa_dstdry3,i)
- atm2lnd_inst%forc_aer_grc(g,13) = x2l(index_x2l_Faxa_dstwet4,i)
- atm2lnd_inst%forc_aer_grc(g,14) = x2l(index_x2l_Faxa_dstdry4,i)
-
- if (index_x2l_Sa_methane /= 0) then
- atm2lnd_inst%forc_pch4_grc(g) = x2l(index_x2l_Sa_methane,i)
- endif
-
- !--------------------------
- ! Check for nans from coupler
- !--------------------------
-
- call check_for_nans(x2l(:,i), fname, begg, "x2l")
-
- end do
-
- !--------------------------
- ! Derived quantities for required fields
- ! and corresponding error checks
- !--------------------------
-
- call derive_quantities(bounds, atm2lnd_inst, wateratm2lndbulk_inst, &
- forc_rainc, forc_rainl, forc_snowc, forc_snowl)
-
- call check_for_errors(bounds, atm2lnd_inst, wateratm2lndbulk_inst)
-
- ! Determine derived quantities for optional fields
- ! Note that the following does unit conversions from ppmv to partial pressures (Pa)
- ! Note that forc_pbot is in Pa
-
- do g = begg,endg
- i = 1 + (g - begg)
-
- forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g)
-
- ! Determine optional receive fields
- if (index_x2l_Sa_co2prog /= 0) then
- co2_ppmv_prog = x2l(index_x2l_Sa_co2prog,i) ! co2 atm state prognostic
- else
- co2_ppmv_prog = co2_ppmv
- end if
- if (index_x2l_Sa_co2diag /= 0) then
- co2_ppmv_diag = x2l(index_x2l_Sa_co2diag,i) ! co2 atm state diagnostic
- else
- co2_ppmv_diag = co2_ppmv
- end if
-
- if (co2_type_idx == 1) then
- co2_ppmv_val = co2_ppmv_prog
- else if (co2_type_idx == 2) then
- co2_ppmv_val = co2_ppmv_diag
- else
- co2_ppmv_val = co2_ppmv
- end if
- if ( (co2_ppmv_val < 10.0_r8) .or. (co2_ppmv_val > 15000.0_r8) )then
- call endrun(subgrid_index=g, subgrid_level=subgrid_level_gridcell, &
- msg = sub//' ERROR: CO2 is outside of an expected range' )
- end if
- atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot
- if (use_c13) then
- atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot
- end if
-
- if (ndep_from_cpl) then
- ! The coupler is sending ndep in units if kgN/m2/s - and clm uses units of gN/m2/sec - so the
- ! following conversion needs to happen
- atm2lnd_inst%forc_ndep_grc(g) = (x2l(index_x2l_Faxa_nhx, i) + x2l(index_x2l_faxa_noy, i))*1000._r8
- end if
-
- end do
-
- call glc2lnd_inst%set_glc2lnd_fields_mct( &
- bounds = bounds, &
- glc_present = glc_present, &
- ! NOTE(wjs, 2017-12-13) the x2l argument doesn't have the typical bounds
- ! subsetting (bounds%begg:bounds%endg). This mirrors the lack of these bounds in
- ! the call to lnd_import from lnd_run_mct. This is okay as long as this code is
- ! outside a clump loop.
- x2l = x2l, &
- index_x2l_Sg_ice_covered = index_x2l_Sg_ice_covered, &
- index_x2l_Sg_topo = index_x2l_Sg_topo, &
- index_x2l_Flgg_hflx = index_x2l_Flgg_hflx, &
- index_x2l_Sg_icemask = index_x2l_Sg_icemask, &
- index_x2l_Sg_icemask_coupled_fluxes = index_x2l_Sg_icemask_coupled_fluxes)
-
- end subroutine lnd_import
-
- !===============================================================================
-
- subroutine lnd_export( bounds, waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x)
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Convert the data to be sent from the clm model to the coupler
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use seq_flds_mod , only : seq_flds_l2x_fields
- use clm_varctl , only : iulog
- use shr_drydep_mod , only : n_drydep
- use shr_megan_mod , only : shr_megan_mechcomps_n
- use shr_fire_emis_mod , only : shr_fire_emis_mechcomps_n
- use lnd_import_export_utils, only : check_for_nans
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds ! bounds
- type(lnd2atm_type), intent(inout) :: lnd2atm_inst ! clm land to atmosphere exchange data type
- type(lnd2glc_type), intent(inout) :: lnd2glc_inst ! clm land to atmosphere exchange data type
- type(waterlnd2atmbulk_type), intent(in) :: waterlnd2atmbulk_inst
- real(r8) , intent(out) :: l2x(:,:)! land to coupler export state on land grid
- !
- ! !LOCAL VARIABLES:
- integer :: begg, endg ! bounds
- integer :: g,i,k ! indices
- integer :: ier ! error status
- integer :: nstep ! time step index
- integer :: dtime ! time step
- integer :: num ! counter
- character(len=32) :: fname ! name of field that is NaN
- character(len=32), parameter :: sub = 'lnd_export'
- !---------------------------------------------------------------------------
-
- ! Set bounds
- begg = bounds%begg; endg = bounds%endg
-
- ! cesm sign convention is that fluxes are positive downward
-
- l2x(:,:) = 0.0_r8
-
- do g = begg,endg
- i = 1 + (g-begg)
- l2x(index_l2x_Sl_t,i) = lnd2atm_inst%t_rad_grc(g)
- l2x(index_l2x_Sl_snowh,i) = waterlnd2atmbulk_inst%h2osno_grc(g)
- l2x(index_l2x_Sl_avsdr,i) = lnd2atm_inst%albd_grc(g,1)
- l2x(index_l2x_Sl_anidr,i) = lnd2atm_inst%albd_grc(g,2)
- l2x(index_l2x_Sl_avsdf,i) = lnd2atm_inst%albi_grc(g,1)
- l2x(index_l2x_Sl_anidf,i) = lnd2atm_inst%albi_grc(g,2)
- l2x(index_l2x_Sl_tref,i) = lnd2atm_inst%t_ref2m_grc(g)
- l2x(index_l2x_Sl_qref,i) = waterlnd2atmbulk_inst%q_ref2m_grc(g)
- l2x(index_l2x_Sl_u10,i) = lnd2atm_inst%u_ref10m_grc(g)
- l2x(index_l2x_Fall_taux,i) = -lnd2atm_inst%taux_grc(g)
- l2x(index_l2x_Fall_tauy,i) = -lnd2atm_inst%tauy_grc(g)
- l2x(index_l2x_Fall_lat,i) = -lnd2atm_inst%eflx_lh_tot_grc(g)
- l2x(index_l2x_Fall_sen,i) = -lnd2atm_inst%eflx_sh_tot_grc(g)
- l2x(index_l2x_Fall_lwup,i) = -lnd2atm_inst%eflx_lwrad_out_grc(g)
- l2x(index_l2x_Fall_evap,i) = -waterlnd2atmbulk_inst%qflx_evap_tot_grc(g)
- l2x(index_l2x_Fall_swnet,i) = lnd2atm_inst%fsa_grc(g)
- if (index_l2x_Fall_fco2_lnd /= 0) then
- l2x(index_l2x_Fall_fco2_lnd,i) = -lnd2atm_inst%net_carbon_exchange_grc(g)
- end if
-
- ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC
- ! These are now standard fields, but the check on the index makes sure the driver handles them
- if (index_l2x_Sl_ram1 /= 0 ) l2x(index_l2x_Sl_ram1,i) = lnd2atm_inst%ram1_grc(g)
- if (index_l2x_Sl_fv /= 0 ) l2x(index_l2x_Sl_fv,i) = lnd2atm_inst%fv_grc(g)
- if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = waterlnd2atmbulk_inst%h2osoi_vol_grc(g,1)
- if (index_l2x_Fall_flxdst1 /= 0 ) l2x(index_l2x_Fall_flxdst1,i)= -lnd2atm_inst%flxdst_grc(g,1)
- if (index_l2x_Fall_flxdst2 /= 0 ) l2x(index_l2x_Fall_flxdst2,i)= -lnd2atm_inst%flxdst_grc(g,2)
- if (index_l2x_Fall_flxdst3 /= 0 ) l2x(index_l2x_Fall_flxdst3,i)= -lnd2atm_inst%flxdst_grc(g,3)
- if (index_l2x_Fall_flxdst4 /= 0 ) l2x(index_l2x_Fall_flxdst4,i)= -lnd2atm_inst%flxdst_grc(g,4)
-
-
- ! for dry dep velocities
- if (index_l2x_Sl_ddvel /= 0 ) then
- l2x(index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1,i) = &
- lnd2atm_inst%ddvel_grc(g,:n_drydep)
- end if
-
- ! for MEGAN VOC emis fluxes
- if (index_l2x_Fall_flxvoc /= 0 ) then
- l2x(index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1,i) = &
- -lnd2atm_inst%flxvoc_grc(g,:shr_megan_mechcomps_n)
- end if
-
-
- ! for fire emis fluxes
- if (index_l2x_Fall_flxfire /= 0 ) then
- l2x(index_l2x_Fall_flxfire:index_l2x_Fall_flxfire+shr_fire_emis_mechcomps_n-1,i) = &
- -lnd2atm_inst%fireflx_grc(g,:shr_fire_emis_mechcomps_n)
- l2x(index_l2x_Sl_ztopfire,i) = lnd2atm_inst%fireztop_grc(g)
- end if
-
- if (index_l2x_Fall_methane /= 0) then
- l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%ch4_surf_flux_tot_grc(g)
- endif
-
- ! sign convention is positive downward with
- ! hierarchy of atm/glc/lnd/rof/ice/ocn.
- ! I.e. water sent from land to rof is positive
-
- l2x(index_l2x_Flrl_rofsur,i) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g)
-
- ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain
- l2x(index_l2x_Flrl_rofsub,i) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) &
- + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g)
-
- ! qgwl sent individually to coupler
- l2x(index_l2x_Flrl_rofgwl,i) = waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g)
-
- ! ice sent individually to coupler
- l2x(index_l2x_Flrl_rofi,i) = waterlnd2atmbulk_inst%qflx_rofice_grc(g)
-
- ! irrigation flux to be removed from main channel storage (negative)
- l2x(index_l2x_Flrl_irrig,i) = - waterlnd2atmbulk_inst%qirrig_grc(g)
-
- ! glc coupling
- ! We could avoid setting these fields if glc_present is .false., if that would
- ! help with performance. (The downside would be that we wouldn't have these fields
- ! available for diagnostic purposes or to force a later T compset with dlnd.)
- do num = 0,glc_nec
- l2x(index_l2x_Sl_tsrf(num),i) = lnd2glc_inst%tsrf_grc(g,num)
- l2x(index_l2x_Sl_topo(num),i) = lnd2glc_inst%topo_grc(g,num)
- l2x(index_l2x_Flgl_qice(num),i) = lnd2glc_inst%qice_grc(g,num)
- end do
-
- !--------------------------
- ! Check for nans to coupler
- !--------------------------
-
- call check_for_nans(l2x(:,i), fname, begg, "l2x")
-
- end do
-
- end subroutine lnd_export
-
-end module lnd_import_export
diff --git a/src/cpl/mct/lnd_set_decomp_and_domain.F90 b/src/cpl/mct/lnd_set_decomp_and_domain.F90
deleted file mode 100644
index 0a37554313..0000000000
--- a/src/cpl/mct/lnd_set_decomp_and_domain.F90
+++ /dev/null
@@ -1,352 +0,0 @@
-module lnd_set_decomp_and_domain
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use spmdMod , only : masterproc
- use clm_varctl , only : iulog
- use mct_mod , only : mct_gsMap
-
- implicit none
- private ! except
-
- ! public member routines
- public :: lnd_set_decomp_and_domain_from_surfrd
-
- ! private member routines
- private :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp)
- private :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp)
-
- ! translation between local and global indices at gridcell level
- type(mct_gsmap), pointer, public :: gsmap_global
-
- ! translation between local and global indices at gridcell level for multiple levels
- ! needed for 3d soil moisture stream
- type(mct_gsmap), target , public :: gsMap_lnd2Dsoi_gdc2glo
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-!===============================================================================
-contains
-!===============================================================================
-
- subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj)
-
- ! Initialize ldomain data types
-
- use clm_varpar , only: nlevsoi
- use clm_varctl , only: fatmlndfrc, use_soil_moisture_streams
- use decompInitMod , only: decompInit_lnd
- use decompMod , only: bounds_type, get_proc_bounds
- use domainMod , only: ldomain, domain_check
-
- ! input/output variables
- logical, intent(out) :: noland
- integer, intent(out) :: ni, nj ! global grid sizes
-
- ! local variables
- integer ,pointer :: amask(:) ! global land mask
- integer :: begg, endg ! processor bounds
- type(bounds_type) :: bounds ! bounds
- character(len=32) :: subname = 'lnd_set_decomp_and_domain_from_surfrd'
- !-----------------------------------------------------------------------
-
- ! Read in global land grid and land mask (amask)- needed to set decomposition
- ! global memory for amask is allocate in surfrd_get_glomask - must be deallocated below
- if (masterproc) then
- write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc)
- endif
-
- ! Get global mask, ni and nj
- call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj)
-
- ! Exit early if no valid land points
- if ( all(amask == 0) )then
- if (masterproc) write(iulog,*) trim(subname)//': no valid land points do NOT run clm'
- noland = .true.
- return
- else
- noland = .false.
- end if
-
- ! Determine ctsm gridcell decomposition and processor bounds for gridcells
- call decompInit_lnd(ni, nj, amask)
- deallocate(amask)
- if (use_soil_moisture_streams) call decompInit_lnd3D(ni, nj, nlevsoi)
-
- ! Initialize bounds for just gridcells
- ! Remaining bounds (landunits, columns, patches) will be determined
- ! after the call to decompInit_glcp - so get_proc_bounds is called
- ! twice and the gridcell information is just filled in twice
- call get_proc_bounds(bounds)
-
- ! Get grid cell bounds values
- begg = bounds%begg
- endg = bounds%endg
-
- ! Initialize ldomain data type
- if (masterproc) then
- write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc)
- endif
- call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc)
- if (masterproc) then
- call domain_check(ldomain)
- endif
- ldomain%mask = 1 !!! TODO - is this needed?
-
- end subroutine lnd_set_decomp_and_domain_from_surfrd
-
- !-----------------------------------------------------------------------
- subroutine surfrd_get_globmask(filename, mask, ni, nj)
-
- ! Read the surface dataset grid related information
- ! This is used to set the domain decomposition - so global data is read here
-
- use fileutils , only : getfil
- use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t
- use abortutils , only : endrun
- use shr_log_mod, only : errMsg => shr_log_errMsg
-
- ! input/output variables
- character(len=*), intent(in) :: filename ! grid filename
- integer , pointer :: mask(:) ! grid mask
- integer , intent(out) :: ni, nj ! global grid sizes
-
- ! local variables
- logical :: isgrid2d
- integer :: dimid,varid ! netCDF id's
- integer :: ns ! size of grid on file
- integer :: n,i,j ! index
- integer :: ier ! error status
- type(file_desc_t) :: ncid ! netcdf id
- character(len=256) :: locfn ! local file name
- logical :: readvar ! read variable in or not
- integer , allocatable :: idata2d(:,:)
- character(len=32) :: subname = 'surfrd_get_globmask' ! subroutine name
- !-----------------------------------------------------------------------
-
- if (filename == ' ') then
- mask(:) = 1
- else
- ! Check if file exists
- if (masterproc) then
- if (filename == ' ') then
- write(iulog,*) trim(subname),' ERROR: filename must be specified '
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
- end if
-
- ! Open file
- call getfil( filename, locfn, 0 )
- call ncd_pio_openfile (ncid, trim(locfn), 0)
-
- ! Determine dimensions and if grid file is 2d or 1d
- call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns)
- if (masterproc) then
- write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d
- end if
- allocate(mask(ns))
- mask(:) = 1
- if (isgrid2d) then
- ! Grid is 2d
- allocate(idata2d(ni,nj))
- idata2d(:,:) = 1
- call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar)
- if (.not. readvar) then
- call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar)
- end if
- if (readvar) then
- do j = 1,nj
- do i = 1,ni
- n = (j-1)*ni + i
- mask(n) = idata2d(i,j)
- enddo
- enddo
- end if
- deallocate(idata2d)
- else
- ! Grid is not 2d
- call ncd_io(ncid=ncid, varname='LANDMASK', data=mask, flag='read', readvar=readvar)
- if (.not. readvar) then
- call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar)
- end if
- end if
- if (.not. readvar) call endrun( msg=' ERROR: landmask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__))
-
- ! Close file
- call ncd_pio_closefile(ncid)
- end if
-
- end subroutine surfrd_get_globmask
-
- !-----------------------------------------------------------------------
- subroutine surfrd_get_grid(begg, endg, ldomain, filename)
-
- ! Read the surface dataset grid related information:
- ! This is called after the domain decomposition has been created
- ! - real latitude of grid cell (degrees)
- ! - real longitude of grid cell (degrees)
-
- use clm_varcon , only : spval, re, grlnd
- use domainMod , only : domain_type, lon1d, lat1d, domain_init
- use fileutils , only : getfil
- use abortutils , only : endrun
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use ncdio_pio , only : file_desc_t, ncd_pio_openfile, ncd_pio_closefile
- use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size
- use pio
-
- ! input/output variables
- integer , intent(in) :: begg, endg
- type(domain_type) , intent(inout) :: ldomain ! domain to init
- character(len=*) , intent(in) :: filename ! grid filename
-
- ! local variables
- type(file_desc_t) :: ncid ! netcdf id
- integer :: beg ! local beg index
- integer :: end ! local end index
- integer :: ni,nj,ns ! size of grid on file
- logical :: readvar ! true => variable is on input file
- logical :: isgrid2d ! true => file is 2d lat/lon
- logical :: istype_domain ! true => input file is of type domain
- real(r8), allocatable :: rdata2d(:,:) ! temporary
- character(len=16) :: vname ! temporary
- character(len=256) :: locfn ! local file name
- integer :: n ! indices
- character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name
- !-----------------------------------------------------------------------
-
- if (masterproc) then
- if (filename == ' ') then
- write(iulog,*) trim(subname),' ERROR: filename must be specified '
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
- end if
-
- call getfil( filename, locfn, 0 )
- call ncd_pio_openfile (ncid, trim(locfn), 0)
-
- ! Determine dimensions
- call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns)
-
- ! Determine isgrid2d flag for domain
- call domain_init(ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg)
-
- ! Determine type of file - old style grid file or new style domain file
- call check_var(ncid=ncid, varname='xc', readvar=readvar)
- if (readvar)then
- istype_domain = .true.
- else
- istype_domain = .false.
- end if
-
- ! Read in area, lon, lat
- if (istype_domain) then
- call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, &
- dim1name=grlnd, readvar=readvar)
- ! convert from radians**2 to km**2
- ldomain%area = ldomain%area * (re**2)
- if (.not. readvar) call endrun( msg=' ERROR: area NOT on file'//errMsg(sourcefile, __LINE__))
- call ncd_io(ncid=ncid, varname= 'xc', flag='read', data=ldomain%lonc, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: xc NOT on file'//errMsg(sourcefile, __LINE__))
- call ncd_io(ncid=ncid, varname= 'yc', flag='read', data=ldomain%latc, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: yc NOT on file'//errMsg(sourcefile, __LINE__))
- else
- call endrun( msg=" ERROR: can no longer read non domain files" )
- end if
-
- if (isgrid2d) then
- allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj))
- if (istype_domain) vname = 'xc'
- call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar)
- lon1d(:) = rdata2d(:,1)
- if (istype_domain) vname = 'yc'
- call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar)
- lat1d(:) = rdata2d(1,:)
- deallocate(rdata2d)
- end if
-
- ! Check lat limited to -90,90
- if (minval(ldomain%latc) < -90.0_r8 .or. &
- maxval(ldomain%latc) > 90.0_r8) then
- write(iulog,*) trim(subname),' WARNING: lat/lon min/max is ', &
- minval(ldomain%latc),maxval(ldomain%latc)
- endif
- if ( any(ldomain%lonc < 0.0_r8) )then
- call endrun( msg=' ERROR: lonc is negative (see https://github.com/ESCOMP/ctsm/issues/507)' &
- //errMsg(sourcefile, __LINE__))
- endif
- call ncd_io(ncid=ncid, varname='mask', flag='read', data=ldomain%mask, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: LANDMASK NOT on fracdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_io(ncid=ncid, varname='frac', flag='read', data=ldomain%frac, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(sourcefile, __LINE__))
- end if
-
- call ncd_pio_closefile(ncid)
-
- end subroutine surfrd_get_grid
-
- !------------------------------------------------------------------------------
- subroutine decompInit_lnd3D(lni,lnj,lnk)
- !
- ! !DESCRIPTION:
- ! Create a 3D decomposition gsmap for the global 2D grid with soil levels
- ! as the 3rd dimesnion.
- !
- ! !USES:
- use decompMod, only : gindex_global, bounds_type, get_proc_bounds
- use spmdMod , only : comp_id, mpicom
- use mct_mod , only : mct_gsmap_init
- !
- ! !ARGUMENTS:
- integer , intent(in) :: lni,lnj,lnk ! domain global size
- !
- ! !LOCAL VARIABLES:
- integer :: m,n,k ! indices
- integer :: begg,endg,lsize,gsize ! used for gsmap init
- integer :: begg3d,endg3d
- integer, pointer :: gindex(:) ! global index for gsmap init
- type(bounds_type) :: bounds
- !------------------------------------------------------------------------------
-
- ! Initialize gsmap_lnd2dsoi_gdc2glo
- call get_proc_bounds(bounds)
- begg = bounds%begg; endg=bounds%endg
-
- begg3d = (begg-1)*lnk + 1
- endg3d = endg*lnk
- lsize = (endg3d - begg3d + 1 )
- allocate(gindex(begg3d:endg3d))
- do k = 1, lnk
- do n = begg,endg
- m = (begg-1)*lnk + (k-1)*(endg-begg+1) + (n-begg+1)
- gindex(m) = gindex_global(n-begg+1) + (k-1)*(lni*lnj)
- enddo
- enddo
- gsize = lni * lnj * lnk
- call mct_gsMap_init(gsMap_lnd2Dsoi_gdc2glo, gindex, mpicom, comp_id, lsize, gsize)
-
- ! Diagnostic output
-
- if (masterproc) then
- write(iulog,*)' 3D GSMap'
- write(iulog,*)' longitude points = ',lni
- write(iulog,*)' latitude points = ',lnj
- write(iulog,*)' soil levels = ',lnk
- write(iulog,*)' gsize = ',gsize
- write(iulog,*)' lsize = ',lsize
- write(iulog,*)' bounds(gindex) = ',size(gindex)
- write(iulog,*)
- end if
-
- deallocate(gindex)
-
- end subroutine decompInit_lnd3D
-
-end module lnd_set_decomp_and_domain
diff --git a/src/cpl/mct/ndepStreamMod.F90 b/src/cpl/mct/ndepStreamMod.F90
deleted file mode 100644
index d26ff7c95e..0000000000
--- a/src/cpl/mct/ndepStreamMod.F90
+++ /dev/null
@@ -1,376 +0,0 @@
-module ndepStreamMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Contains methods for reading in nitrogen deposition data file
- ! Also includes functions for dynamic ndep file handling and
- ! interpolation.
- !
- ! !USES
- use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl
- use shr_strdata_mod, only: shr_strdata_type, shr_strdata_create
- use shr_strdata_mod, only: shr_strdata_print, shr_strdata_advance
- use mct_mod , only: mct_ggrid
- use spmdMod , only: mpicom, masterproc, comp_id, iam
- use clm_varctl , only: iulog, inst_name
- use abortutils , only: endrun
- use decompMod , only: bounds_type
- use domainMod , only: ldomain
-
- ! !PUBLIC TYPES:
- implicit none
- private
-
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: ndep_init ! position datasets for dynamic ndep
- public :: ndep_interp ! interpolates between two years of ndep file data
- public :: clm_domain_mct ! Sets up MCT domain for this resolution
-
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: check_units ! Check the units and make sure they can be used
-
- ! ! PRIVATE TYPES
- type(shr_strdata_type) :: sdat ! input data stream
- integer :: stream_year_first_ndep ! first year in stream to use
- integer :: stream_year_last_ndep ! last year in stream to use
- integer :: model_year_align_ndep ! align stream_year_firstndep with
- logical :: divide_by_secs_per_yr = .true. ! divide by the number of seconds per year
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !==============================================================================
-
-contains
-
- !==============================================================================
-
- subroutine ndep_init(bounds, NLFilename)
- !
- ! Initialize data stream information.
- !
- ! Uses:
- use shr_kind_mod , only : CS => shr_kind_cs
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use shr_nl_mod , only : shr_nl_find_group_name
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_mpi_mod , only : shr_mpi_bcast
- use lnd_set_decomp_and_domain , only : gsMap_lnd2Dsoi_gdc2glo, gsmap_global
- !
- ! arguments
- implicit none
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! local variables
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- type(mct_ggrid) :: dom_clm ! domain information
- character(len=CL) :: stream_fldFileName_ndep
- character(len=CL) :: ndepmapalgo = 'bilinear'
- character(len=CL) :: ndep_tintalgo = 'linear'
- character(len=CS) :: ndep_taxmode = 'extend'
- character(len=CL) :: ndep_varlist = 'NDEP_year'
- character(*), parameter :: shr_strdata_unset = 'NOT_SET'
- character(*), parameter :: subName = "('ndepdyn_init')"
- character(*), parameter :: F00 = "('(ndepdyn_init) ',4a)"
- !-----------------------------------------------------------------------
-
- namelist /ndepdyn_nml/ &
- stream_year_first_ndep, &
- stream_year_last_ndep, &
- model_year_align_ndep, &
- ndepmapalgo, ndep_taxmode, &
- ndep_varlist, &
- stream_fldFileName_ndep, &
- ndep_tintalgo
-
- ! Default values for namelist
- stream_year_first_ndep = 1 ! first year in stream to use
- stream_year_last_ndep = 1 ! last year in stream to use
- model_year_align_ndep = 1 ! align stream_year_first_ndep with this model year
- stream_fldFileName_ndep = ' '
-
- ! Read ndepdyn_nml namelist
- if (masterproc) then
- open( newunit=nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call shr_nl_find_group_name(nu_nml, 'ndepdyn_nml', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=ndepdyn_nml,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(msg=' ERROR reading ndepdyn_nml namelist'//errMsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg=' ERROR finding ndepdyn_nml namelist'//errMsg(sourcefile, __LINE__))
- end if
- close(nu_nml)
- endif
-
- call shr_mpi_bcast(stream_year_first_ndep , mpicom)
- call shr_mpi_bcast(stream_year_last_ndep , mpicom)
- call shr_mpi_bcast(model_year_align_ndep , mpicom)
- call shr_mpi_bcast(stream_fldFileName_ndep, mpicom)
- call shr_mpi_bcast(ndep_varlist , mpicom)
- call shr_mpi_bcast(ndep_taxmode , mpicom)
- call shr_mpi_bcast(ndep_tintalgo , mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) 'ndepdyn stream settings:'
- write(iulog,*) ' stream_year_first_ndep = ',stream_year_first_ndep
- write(iulog,*) ' stream_year_last_ndep = ',stream_year_last_ndep
- write(iulog,*) ' model_year_align_ndep = ',model_year_align_ndep
- write(iulog,*) ' stream_fldFileName_ndep = ',stream_fldFileName_ndep
- write(iulog,*) ' ndep_varList = ',ndep_varList
- write(iulog,*) ' ndep_taxmode = ',ndep_taxmode
- write(iulog,*) ' ndep_tintalgo = ',ndep_tintalgo
- write(iulog,*) ' '
- endif
- ! Read in units
- call check_units( stream_fldFileName_ndep, ndep_varList )
-
- ! Set domain and create streams
- call clm_domain_mct (bounds, dom_clm)
-
- call shr_strdata_create(sdat,name="clmndep", &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsmap_global, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- yearFirst=stream_year_first_ndep, &
- yearLast=stream_year_last_ndep, &
- yearAlign=model_year_align_ndep, &
- offset=0, &
- domFilePath='', &
- domFileName=trim(stream_fldFileName_ndep), &
- domTvarName='time', &
- domXvarName='lon' , &
- domYvarName='lat' , &
- domAreaName='area', &
- domMaskName='mask', &
- filePath='', &
- filename=(/trim(stream_fldFileName_ndep)/),&
- fldListFile=ndep_varlist, &
- fldListModel=ndep_varlist, &
- fillalgo='none', &
- mapalgo=ndepmapalgo, &
- tintalgo=ndep_tintalgo, &
- calendar=get_calendar(), &
- taxmode=ndep_taxmode )
-
-
- if (masterproc) then
- call shr_strdata_print(sdat,'CLMNDEP data')
- endif
-
- end subroutine ndep_init
- !================================================================
-
- subroutine check_units( stream_fldFileName_ndep, ndep_varList )
- !-------------------------------------------------------------------
- ! Check that units are correct on the file and if need any conversion
- use ncdio_pio , only : ncd_pio_openfile, ncd_inqvid, ncd_getatt, ncd_pio_closefile, ncd_nowrite
- use ncdio_pio , only : file_desc_t, var_desc_t
- use shr_kind_mod , only : CS => shr_kind_cs
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_string_mod, only : shr_string_listGetName
- implicit none
-
- !-----------------------------------------------------------------------
- !
- ! Arguments
- character(len=*), intent(IN) :: stream_fldFileName_ndep ! ndep filename
- character(len=*), intent(IN) :: ndep_varList ! ndep variable list to examine
- !
- ! Local variables
- type(file_desc_t) :: ncid ! NetCDF filehandle for ndep file
- type(var_desc_t) :: vardesc ! variable descriptor
- integer :: varid ! variable index
- logical :: readvar ! If variable was read
- character(len=CS) :: ndepunits! ndep units
- character(len=CS) :: fname ! ndep field name
- !-----------------------------------------------------------------------
- call ncd_pio_openfile( ncid, trim(stream_fldFileName_ndep), ncd_nowrite )
- call shr_string_listGetName( ndep_varList, 1, fname )
- call ncd_inqvid( ncid, fname, varid, vardesc, readvar=readvar )
- if ( readvar ) then
- call ncd_getatt( ncid, varid, "units", ndepunits )
- else
- call endrun(msg=' ERROR finding variable: '//trim(fname)//" in file: "// &
- trim(stream_fldFileName_ndep)//errMsg(sourcefile, __LINE__))
- end if
- call ncd_pio_closefile( ncid )
-
- ! Now check to make sure they are correct
- if ( trim(ndepunits) == "g(N)/m2/s" )then
- divide_by_secs_per_yr = .false.
- else if ( trim(ndepunits) == "g(N)/m2/yr" )then
- divide_by_secs_per_yr = .true.
- else
- call endrun(msg=' ERROR in units for nitrogen deposition equal to: '//trim(ndepunits)//" not units expected"// &
- errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine check_units
-
- !================================================================
- subroutine ndep_interp(bounds, atm2lnd_inst)
-
- !-----------------------------------------------------------------------
- use clm_time_manager, only : get_curr_date, get_curr_days_per_year
- use clm_varcon , only : secspday
- use atm2lndType , only : atm2lnd_type
- !
- ! Arguments
- type(bounds_type) , intent(in) :: bounds
- type(atm2lnd_type), intent(inout) :: atm2lnd_inst
- !
- ! Local variables
- integer :: g, ig
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- integer :: dayspyr ! days per year
- !-----------------------------------------------------------------------
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ndepdyn')
-
- if ( divide_by_secs_per_yr )then
- ig = 0
- dayspyr = get_curr_days_per_year( )
- do g = bounds%begg,bounds%endg
- ig = ig+1
- atm2lnd_inst%forc_ndep_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr)
- end do
- else
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- atm2lnd_inst%forc_ndep_grc(g) = sdat%avs(1)%rAttr(1,ig)
- end do
- end if
-
- end subroutine ndep_interp
-
- !==============================================================================
- subroutine clm_domain_mct(bounds, dom_clm, nlevels)
-
- !-------------------------------------------------------------------
- ! Set domain data type for internal clm grid
- use clm_varcon , only : re
- use domainMod , only : ldomain
- use mct_mod , only : mct_ggrid, mct_gsMap_lsize, mct_gGrid_init
- use mct_mod , only : mct_gsMap_orderedPoints, mct_gGrid_importIAttr
- use mct_mod , only : mct_gGrid_importRAttr, mct_gsMap
- use lnd_set_decomp_and_domain , only : gsMap_lnd2Dsoi_gdc2glo, gsmap_global
- implicit none
- !
- ! arguments
- type(bounds_type), intent(in) :: bounds
- type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model
- integer, intent(in), optional :: nlevels ! Number of levels if this is a 3D field
- !
- ! local variables
- integer :: g,i,j,k ! index
- integer :: lsize ! land model domain data size
- real(r8), pointer :: data(:) ! temporary
- integer , pointer :: idata(:) ! temporary
- integer :: nlevs ! Number of vertical levels
- type(mct_gsMap), pointer :: gsmap => null() ! MCT GS map
- !-------------------------------------------------------------------
- ! SEt number of levels, and get the GS map for either the 2D or 3D grid
- nlevs = 1
- if ( present(nlevels) ) nlevs = nlevels
- if ( nlevs == 1 ) then
- gsmap => gsmap_global
- else
- gsmap => gsMap_lnd2Dsoi_gdc2glo
- end if
- !
- ! Initialize mct domain type
- ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land)
- ! Note that in addition land carries around landfrac for the purposes of domain checking
- !
- lsize = mct_gsMap_lsize(gsmap, mpicom)
- call mct_gGrid_init( GGrid=dom_clm, &
- CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize )
- !
- ! Allocate memory
- !
- allocate(data(lsize))
- !
- ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT
- !
- call mct_gsMap_orderedPoints(gsmap, iam, idata)
- gsmap => null()
- call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize)
- !
- ! Determine domain (numbering scheme is: West to East and South to North to South pole)
- ! Initialize attribute vector with special value
- !
- data(:) = -9999.0_R8
- call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize)
- call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize)
- call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize)
- call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize)
- data(:) = 0.0_R8
- call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize)
- !
- ! Determine bounds
- !
- ! Fill in correct values for domain components
- ! Note aream will be filled in in the atm-lnd mapper
- !
- do k = 1, nlevs
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%lonc(g)
- end do
- end do
- call mct_gGrid_importRattr(dom_clm,"lon",data,lsize)
-
- do k = 1, nlevs
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%latc(g)
- end do
- end do
- call mct_gGrid_importRattr(dom_clm,"lat",data,lsize)
-
- do k = 1, nlevs
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%area(g)/(re*re)
- end do
- end do
- call mct_gGrid_importRattr(dom_clm,"area",data,lsize)
-
- do k = 1, nlevs
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = real(ldomain%mask(g), r8)
- end do
- end do
- call mct_gGrid_importRattr(dom_clm,"mask",data,lsize)
-
- do k = 1, nlevs
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = real(ldomain%frac(g), r8)
- end do
- end do
- call mct_gGrid_importRattr(dom_clm,"frac",data,lsize)
-
- deallocate(data)
- deallocate(idata)
-
- end subroutine clm_domain_mct
-
-end module ndepStreamMod
diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90
index 11cc807640..b9966f81e9 100644
--- a/src/cpl/nuopc/lnd_import_export.F90
+++ b/src/cpl/nuopc/lnd_import_export.F90
@@ -248,7 +248,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r
if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch')
! CARMA volumetric soil water from land
- ! TODO: is the following correct - the CARMA field exchange is very confusing in mct
call shr_carma_readnl('drv_flds_in', carma_fields)
! export to atm
diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90
index 7554288d30..569fb85def 100644
--- a/src/main/clm_varctl.F90
+++ b/src/main/clm_varctl.F90
@@ -115,7 +115,7 @@ module clm_varctl
character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name
character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid
- ! only needed for LILAC and MCT drivers
+ ! only needed for LILAC
!----------------------------------------------------------
! Flag to read ndep rather than obtain it from coupler
diff --git a/src/main/glc2lndMod.F90 b/src/main/glc2lndMod.F90
index ecd6818210..2d0dbb5791 100644
--- a/src/main/glc2lndMod.F90
+++ b/src/main/glc2lndMod.F90
@@ -78,7 +78,6 @@ module glc2lndMod
! - set_glc2lnd_fields
! - update_glc2lnd_fracs
! - update_glc2lnd_topo
- procedure, public :: set_glc2lnd_fields_mct ! set coupling fields sent from glc to lnd
procedure, public :: set_glc2lnd_fields_nuopc ! set coupling fields sent from glc to lnd
procedure, public :: update_glc2lnd_fracs ! update subgrid fractions based on input from GLC
procedure, public :: update_glc2lnd_topo ! update topographic heights
@@ -242,61 +241,6 @@ subroutine Clean(this)
end subroutine Clean
- !-----------------------------------------------------------------------
- subroutine set_glc2lnd_fields_mct(this, bounds, glc_present, x2l, &
- index_x2l_Sg_ice_covered, index_x2l_Sg_topo, index_x2l_Flgg_hflx, &
- index_x2l_Sg_icemask, index_x2l_Sg_icemask_coupled_fluxes)
- !
- ! !DESCRIPTION:
- ! Set coupling fields sent from glc to lnd
- !
- ! If glc_present is true, then the given fields are all assumed to be valid; if
- ! glc_present is false, then these fields are ignored.
- !
- ! !ARGUMENTS:
- class(glc2lnd_type), intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- logical , intent(in) :: glc_present ! true if running with a non-stub glc model
- real(r8) , intent(in) :: x2l(:, bounds%begg: ) ! driver import state to land model [field, gridcell]
- integer , intent(in) :: index_x2l_Sg_ice_covered( 0: ) ! indices of ice-covered field in x2l, for each elevation class
- integer , intent(in) :: index_x2l_Sg_topo( 0: ) ! indices of topo field in x2l, for each elevation class
- integer , intent(in) :: index_x2l_Flgg_hflx( 0: ) ! indices of heat flux field in x2l, for each elevation class
- integer , intent(in) :: index_x2l_Sg_icemask ! index of icemask field in x2l
- integer , intent(in) :: index_x2l_Sg_icemask_coupled_fluxes ! index of icemask_coupled_fluxes field in x2l
- !
- ! !LOCAL VARIABLES:
- integer :: g
- integer :: ice_class
-
- character(len=*), parameter :: subname = 'set_glc2lnd_fields_mct'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_FL((ubound(x2l, 2) == bounds%endg), sourcefile, __LINE__)
- SHR_ASSERT_ALL_FL((ubound(index_x2l_Sg_ice_covered) == (/maxpatch_glc/)), sourcefile, __LINE__)
- SHR_ASSERT_ALL_FL((ubound(index_x2l_Sg_topo) == (/maxpatch_glc/)), sourcefile, __LINE__)
- SHR_ASSERT_ALL_FL((ubound(index_x2l_Flgg_hflx) == (/maxpatch_glc/)), sourcefile, __LINE__)
-
- if (glc_present) then
- do g = bounds%begg, bounds%endg
- do ice_class = 0, maxpatch_glc
- this%frac_grc(g,ice_class) = x2l(index_x2l_Sg_ice_covered(ice_class),g)
- this%topo_grc(g,ice_class) = x2l(index_x2l_Sg_topo(ice_class),g)
- this%hflx_grc(g,ice_class) = x2l(index_x2l_Flgg_hflx(ice_class),g)
- end do
- this%icemask_grc(g) = x2l(index_x2l_Sg_icemask,g)
- this%icemask_coupled_fluxes_grc(g) = x2l(index_x2l_Sg_icemask_coupled_fluxes,g)
- end do
-
- call this%set_glc2lnd_fields_wrapup(bounds)
- else
- if (glc_do_dynglacier) then
- call endrun(' ERROR: With glc_present false (e.g., a stub glc model), glc_do_dynglacier must be false '// &
- errMsg(sourcefile, __LINE__))
- end if
- end if
-
- end subroutine set_glc2lnd_fields_mct
-
!-----------------------------------------------------------------------
subroutine set_glc2lnd_fields_nuopc(this, bounds, glc_present, &
frac_grc, topo_grc, hflx_grc, icemask_grc, icemask_coupled_fluxes_grc)
diff --git a/test/tools/CLM_compare.sh b/test/tools/CLM_compare.sh
deleted file mode 100755
index 38f547c3ab..0000000000
--- a/test/tools/CLM_compare.sh
+++ /dev/null
@@ -1,39 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 2 ]; then
- echo "CLM_compare.sh: incorrect number of input arguments"
- exit 1
-fi
-
-echo "CLM_compare.sh: comparing $1 "
-echo " with $2"
-
-##note syntax here as stderr and stdout from cprnc command go
-##to separate places!
-${CPRNC_EXE} ${CPRNC_OPT} $1 $2 2>&1 > cprnc.out
-rc=$?
-if [ $rc -ne 0 ]; then
- echo "CLM_compare.sh: error doing comparison, cprnc error= $rc"
- exit 2
-fi
-
-result_old=`perl -e 'while (my $ll = <>) \
- { if ($ll =~ /(\d+)[^0-9]+compared[^0-9]+(\d+)/) \
- { print "PASS" if $1>0 && $2==0 }}' cprnc.out`
-if grep -c "the two files seem to be IDENTICAL" cprnc.out > /dev/null; then
- result=PASS
-elif grep -c "the two files seem to be DIFFERENT" cprnc.out > /dev/null; then
- result=FAIL
-else
- result=$result_old
-fi
-
-if [ "$result" = "PASS" ]; then
- echo "CLM_compare.sh: files are b4b"
-else
- echo "CLM_compare.sh: files are NOT b4b"
- exit 3
-fi
-
-exit 0
diff --git a/test/tools/Makefile b/test/tools/Makefile
deleted file mode 100644
index b5031abdba..0000000000
--- a/test/tools/Makefile
+++ /dev/null
@@ -1,12 +0,0 @@
-#
-# Makefile to build clm testing documentation
-#
-
-# Get list of tests_ files
-SOURCES = $(wildcard tests_*)
-
-all: test_table.html
-
-test_table.html: $(SOURCES)
- gen_test_table.sh
-
diff --git a/test/tools/README b/test/tools/README
deleted file mode 100644
index c545f625b8..0000000000
--- a/test/tools/README
+++ /dev/null
@@ -1,73 +0,0 @@
-$CTSMROOT/clm/test/tools/README 06/08/2018
-
-Scripts for testing the CLM support tools with many different
-configurations and run-time options.
-
-I. MAIN SCRIPTS:
-
-test_driver.sh - Test the CLM offline tools
-
-To use...
-
-./test_driver.sh -i
-
-on Derecho
-
-qcmd -l walltime=08:00:00 -- ./test_driver.sh -i >& run.out &
-
-And to for example to compare to another baseline code (in this case ctsm5.1.dev066, which would need to be cloned at the given
-path) ...
-
-qcmd -l walltime=08:00:00 -- env BL_ROOT=/glade/scratch/erik/ctsm5.1.dev066 ./test_driver.sh -i >& run.out &
-
-on izumi
-
-nohup ./test_driver.sh -i >& run.out &
-
-release tests
-
-qcmd -l walltime=10:00:00 -- env CLM_INPUT_TESTS=`pwd`/tests_posttag_nompi_regression \
-./test_driver.sh -i >& run_regress.out &
-
-To run neon-specific tests, please use login nodes:
-env CLM_INPUT_TESTS=`pwd`/tests_pretag_nompi_neon ./test_driver.sh -i > & run_neon.out &
-
-
-Intended for use on NCAR machines Derecho, Casper (DAV) and izumi.
-
-II. RUNNING test_driver.sh TOOLS TESTING:
-
-Basic use:
-
-./test_driver.sh -i
-./test_driver.sh -h # to get help on options
-
-Important environment variables (just used by test_driver.sh)
-
-BL_ROOT ---------------- Root directory of CLM baseline code to compare to
- (if not set BL test will not be performed)
-BL_TESTDIR ------------- Root directory of where to put baseline tests
-CLM_INPUT_TESTS -------- Filename of file with list of tests to perform
-CLM_TESTDIR ------------ Root directory of where to put most tests
-CLM_RETAIN_FILES ------- If set to TRUE -- don't cleanup files after testing
-CLM_FC ----------------- Use given compiler
-CLM_JOBID -------------- Job identification number to use (rather than process ID)
-CLM_THREADS ------------ Number of open-MP threads to use
- (by default this is set differently by machine)
-CLM_SOFF --------------- If set to TRUE -- stop on first failed test (default FALSE)
-
-Important files for test_driver tools testing:
-
-test_driver.sh ------- Main test script for tools
-nl_files ------------- Directory with various namelists to test
-config_files --------- Directory with various configurations to test
-input_tests_master --- Master list of tests
-tests_pretag_* ------- Tests for specific machines to do by default before a tag is done
-tests_posttag_* ------ Tests for specific machines to do for more extensive testing
- after a tag is done
-CLM_compare.sh ------- Compares output history files between two cases
-T*.sh ---------------- Basic test script to do a specific type of test
-gen_test_table.sh ---- Creates HTML table of tests
-Makefile ------------- Will build the HTML table of tests
-
-../../tools/README.testing - Information on how the testing works for the CLM tools
diff --git a/test/tools/README.testnames b/test/tools/README.testnames
deleted file mode 100644
index 74dbe8e5f3..0000000000
--- a/test/tools/README.testnames
+++ /dev/null
@@ -1,69 +0,0 @@
-Tests for test_driver are for the CLM tools only.
-
-Test naming conventions for the test_driver.sh script:
-
-Test names are:
-
-xxnmi
-
-Where: xx is the two-letter test type
- sm=smoke, br=branch, er=exact restart, bl=base-line comparision,
- cb=configure-build, rp=reproducibility, op=OpenMP threading for tools
-
-n is the configuration type:
-
-1 -- unused
-2 -- unused
-3 -- unused
-4 -- unused
-5 -- unused
-6 -- unused
-7 -- unused
-8 -- unused
-9 -- mesh_maker
-0 -- run_neon
-a -- modify_data
-b -- subset_data
-c -- mkprocdata_map
-d -- mkmapgrids
-e -- unused
-f -- unused
-g -- unused
-h -- unused
-i -- tools scripts
-
-m is the resolution
-
-0 -- 0.9x1.25
-1 -- 48x96
-5 -- 10x15
-6 -- 5x5_amazon
-7 -- 1x1 brazil
-8 -- US-UMB
-9 -- 4x5
-a -- NEON YELL
-b -- NEON KONA
-c -- NEON OSBS
-d -- SouthAmerica
-e -- 1850PanTropics
-f -- PanBoreal
-g -- AlaskaTananaValley
-h -- single point from the 0.9x1.25 grid (Township SD)
-y -- 1.9x2.5 with transient 1850-2100 for rcp=2.6 and glacier-MEC on
-T -- 1x1_numaIA
-Z -- 10x15 with crop on
-@ -- ne120np4
-# -- ne30np4
-
-i is the specific test (usually this implies...)
-
-1 -- Serial script
-2 -- Serial
-3 -- OpenMP only
-4 -- serial, DEBUG
-7 -- OpenMP only second test, DEBUG
-8 -- OpenMP only third test, DEBUG
-9 -- Serial Script
-0 -- Serial Script
-
-
diff --git a/test/tools/TBLCFGtools.sh b/test/tools/TBLCFGtools.sh
deleted file mode 100755
index 6276c885e2..0000000000
--- a/test/tools/TBLCFGtools.sh
+++ /dev/null
@@ -1,120 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 3 ]; then
- echo "TBLCFGtools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then
- echo "TBL.sh: no environment variables set for baseline test - will skip"
- exit 255
-fi
-
-tool=$(basename $1)
-test_name=TBLCFGtools.$tool.$2.$3
-
-if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TBLCFGtools.sh: smoke test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TBLCFGtools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TBLCFGtools.sh: smoke test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TBLCFGtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-rundir=${CLM_TESTDIR}/${test_name}
-if [ -d ${rundir} ]; then
- rm -r ${rundir}
-fi
-mkdir -p ${rundir}
-if [ $? -ne 0 ]; then
- echo "TBLCFGtools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${rundir}
-
-echo "TBLCFGtools.sh: calling TSMCFGtools.sh to run $tool executable"
-${CLM_SCRIPTDIR}/TSMCFGtools.sh $1 $2 $3
-rc=$?
-if [ $rc -ne 0 ]; then
- echo "TBLCFGtools.sh: error from TSMCFGtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
-fi
-
-if [ -n "${BL_ROOT}" ]; then
- if [ -z "$BL_TESTDIR" ]; then
- BL_TESTDIR=${CLM_TESTDIR}.bl
- fi
- echo "TBLCFGtools.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR"
-
- echo "TBLCFGtools.sh: calling ****baseline**** TSMCFGtools.sh for smoke test"
- bl_dir=`/bin/ls -1d ${BL_ROOT}/test/tools`
- env CLM_TESTDIR=${BL_TESTDIR} \
- CLM_ROOT=${BL_ROOT} \
- CLM_SCRIPTDIR=$bl_dir \
- $bl_dir/TSMCFGtools.sh $1 $2 $3
- rc=$?
- if [ $rc -ne 0 ]; then
- echo "TBLCFGtools.sh: error from *baseline* TSMCFGtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 5
- fi
-fi
-
-echo "TBLCFGtools.sh: starting b4b comparisons "
-files_to_compare=`cd ${CLM_TESTDIR}/TSMCFGtools.$tool.$2.$3; ls *.nc`
-if [ -z "${files_to_compare}" ] && [ "$debug" != "YES" ]; then
- echo "TBLCFGtools.sh: error locating files to compare"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
-fi
-
-all_comparisons_good="TRUE"
-for compare_file in ${files_to_compare}; do
-
- env CPRNC_OPT="-m" \
- ${CLM_SCRIPTDIR}/CLM_compare.sh \
- ${BL_TESTDIR}/TSMCFGtools.$tool.$2.$3/${compare_file} \
- ${CLM_TESTDIR}/TSMCFGtools.$tool.$2.$3/${compare_file}
- rc=$?
- mv cprnc.out cprnc.${compare_file}.out
- if [ $rc -eq 0 ]; then
- echo "TBLCFGtools.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out"
- else
- echo "TBLCFGtools.sh: error from CLM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details
-"
- all_comparisons_good="FALSE"
- fi
-done
-
-if [ ${all_comparisons_good} = "TRUE" ]; then
- echo "TBLCFGtools.sh: baseline test passed"
- echo "PASS" > TestStatus
- if [ $CLM_RETAIN_FILES != "TRUE" ]; then
- echo "TBLCFGtools.sh: removing some unneeded files to save disc space"
- rm *.nc
- rm *.r*
- fi
-else
- echo "TBLCFGtools.sh: at least one file comparison did not pass"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 7
-fi
-
-exit 0
diff --git a/test/tools/TBLscript_tools.sh b/test/tools/TBLscript_tools.sh
deleted file mode 100755
index d05492c687..0000000000
--- a/test/tools/TBLscript_tools.sh
+++ /dev/null
@@ -1,122 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 3 ]; then
- echo "TBLscript_tools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then
- echo "TBLscript_tools.sh: no environment variables set for baseline test - will skip"
- exit 255
-fi
-
-test_name=TBLscript_tools.$1.$2.$3
-
-if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TBLscript_tools.sh: smoke test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TBLscript_tools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TBLscript_tools.sh: smoke test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TBLscript_tools.sh: this smoke test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-rundir=${CLM_TESTDIR}/${test_name}
-if [ -d ${rundir} ]; then
- rm -r ${rundir}
-fi
-mkdir -p ${rundir}
-if [ $? -ne 0 ]; then
- echo "TBLscript_tools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${rundir}
-
-echo "TBLscript_tools.sh: calling TSMscript_tools.sh to run $1 executable"
-${CLM_SCRIPTDIR}/TSMscript_tools.sh $1 $2 $3
-rc=$?
-if [ $rc -ne 0 ]; then
- echo "TBLscript_tools.sh: error from TSMtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
-fi
-
-if [ -n "${BL_ROOT}" ]; then
- if [ -z "$BL_TESTDIR" ]; then
- BL_TESTDIR=${CLM_TESTDIR}.bl
- fi
- echo "TBLscript_tools.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR"
-
- echo "TBLscript_tools.sh: calling ****baseline**** TSMtools.sh for smoke test"
- bl_dir=`/bin/ls -1d ${BL_ROOT}/test/tools`
- env CLM_TESTDIR=${BL_TESTDIR} \
- CLM_SCRIPTDIR=$bl_dir \
- CLM_ROOT=$BL_ROOT \
- CTSM_ROOT=$BL_ROOT \
- CIME_ROOT=$BL_ROOT/cime \
- $bl_dir/TSMscript_tools.sh $1 $2 $3
- rc=$?
- if [ $rc -ne 0 ]; then
- echo "TBLscript_tools.sh: error from *baseline* TSMscript_tools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 5
- fi
-fi
-
-echo "TBLscript_tools.sh: starting b4b comparisons "
-files_to_compare=`cd ${CLM_TESTDIR}/TSMscript_tools.$1.$2.$3; ls *.nc`
-if [ -z "${files_to_compare}" ] && [ "$debug" != "YES" ]; then
- echo "TBLscript_tools.sh: error locating files to compare"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
-fi
-
-all_comparisons_good="TRUE"
-for compare_file in ${files_to_compare}; do
-
- env CPRNC_OPT="-m" \
- ${CLM_SCRIPTDIR}/CLM_compare.sh \
- ${BL_TESTDIR}/TSMscript_tools.$1.$2.$3/${compare_file} \
- ${CLM_TESTDIR}/TSMscript_tools.$1.$2.$3/${compare_file}
- rc=$?
- mv cprnc.out cprnc.${compare_file}.out
- if [ $rc -eq 0 ]; then
- echo "TBLscript_tools.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out"
- else
- echo "TBLscript_tools.sh: error from CLM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details"
- all_comparisons_good="FALSE"
- fi
-done
-
-if [ ${all_comparisons_good} = "TRUE" ]; then
- echo "TBLscript_tools.sh: baseline test passed"
- echo "PASS" > TestStatus
- if [ $CLM_RETAIN_FILES != "TRUE" ]; then
- echo "TBLscript_tools.sh: removing some unneeded files to save disc space"
- rm *.nc
- rm *.r*
- fi
-else
- echo "TBLscript_tools.sh: at least one file comparison did not pass"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 7
-fi
-
-
-
-exit 0
diff --git a/test/tools/TBLtools.sh b/test/tools/TBLtools.sh
deleted file mode 100755
index 555ea7d1be..0000000000
--- a/test/tools/TBLtools.sh
+++ /dev/null
@@ -1,119 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 3 ]; then
- echo "TBLtools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then
- echo "TBL.sh: no environment variables set for baseline test - will skip"
- exit 255
-fi
-
-test_name=TBLtools.$1.$2.$3
-
-if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TBLtools.sh: smoke test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TBLtools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TBLtools.sh: smoke test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TBLtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-rundir=${CLM_TESTDIR}/${test_name}
-if [ -d ${rundir} ]; then
- rm -r ${rundir}
-fi
-mkdir -p ${rundir}
-if [ $? -ne 0 ]; then
- echo "TBLtools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${rundir}
-
-echo "TBLtools.sh: calling TSMtools.sh to run $1 executable"
-${CLM_SCRIPTDIR}/TSMtools.sh $1 $2 $3
-rc=$?
-if [ $rc -ne 0 ]; then
- echo "TBLtools.sh: error from TSMtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
-fi
-
-if [ -n "${BL_ROOT}" ]; then
- if [ -z "$BL_TESTDIR" ]; then
- BL_TESTDIR=${CLM_TESTDIR}.bl
- fi
- echo "TBLtools.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR"
-
- echo "TBLtools.sh: calling ****baseline**** TSMtools.sh for smoke test"
- bl_dir=`/bin/ls -1d ${BL_ROOT}/test/tools`
- env CLM_TESTDIR=${BL_TESTDIR} \
- CLM_ROOT=${BL_ROOT} \
- CLM_SCRIPTDIR=$bl_dir \
- $bl_dir/TSMtools.sh $1 $2 $3
- rc=$?
- if [ $rc -ne 0 ]; then
- echo "TBLtools.sh: error from *baseline* TSMtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 5
- fi
-fi
-
-echo "TBLtools.sh: starting b4b comparisons "
-files_to_compare=`cd ${CLM_TESTDIR}/TSMtools.$1.$2.$3; ls *.nc`
-if [ -z "${files_to_compare}" ] && [ "$debug" != "YES" ]; then
- echo "TBLtools.sh: error locating files to compare"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
-fi
-
-all_comparisons_good="TRUE"
-for compare_file in ${files_to_compare}; do
-
- env CPRNC_OPT="-m" \
- ${CLM_SCRIPTDIR}/CLM_compare.sh \
- ${BL_TESTDIR}/TSMtools.$1.$2.$3/${compare_file} \
- ${CLM_TESTDIR}/TSMtools.$1.$2.$3/${compare_file}
- rc=$?
- mv cprnc.out cprnc.${compare_file}.out
- if [ $rc -eq 0 ]; then
- echo "TBLtools.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out"
- else
- echo "TBLtools.sh: error from CLM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details
-"
- all_comparisons_good="FALSE"
- fi
-done
-
-if [ ${all_comparisons_good} = "TRUE" ]; then
- echo "TBLtools.sh: baseline test passed"
- echo "PASS" > TestStatus
- if [ $CLM_RETAIN_FILES != "TRUE" ]; then
- echo "TBLtools.sh: removing some unneeded files to save disc space"
- rm *.nc
- rm *.r*
- fi
-else
- echo "TBLtools.sh: at least one file comparison did not pass"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 7
-fi
-
-exit 0
diff --git a/test/tools/TCBCFGtools.sh b/test/tools/TCBCFGtools.sh
deleted file mode 100755
index 5c0b015123..0000000000
--- a/test/tools/TCBCFGtools.sh
+++ /dev/null
@@ -1,135 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 2 ]; then
- echo "TCBCFGtools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-tool=$(basename $1)
-test_name=TCBCFGtools.$tool.$2
-
-if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TCBCFGtools.sh: build test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TCBCFGtools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TCBCFGtools.sh: build test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TCBCFGtools.sh: this build test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-cfgdir=`ls -1d ${CLM_ROOT}/tools/${1}`
-if [ $? -ne 0 ];then
- cfgdir=`ls -1d ${CIME_ROOT}/tools/mapping/${1}*`
- echo "use: $cfgdir"
-fi
-blddir=${CLM_TESTDIR}/${test_name}/src
-if [ -d ${blddir} ]; then
- rm -r ${blddir}
-fi
-mkdir -p ${blddir}
-if [ $? -ne 0 ]; then
- echo "TCBCFGtools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${blddir}
-
-echo "TCBCFGtools.sh: building $tool executable; output in ${blddir}/test.log"
-#
-# Copy build files over
-#
-cp $cfgdir/src/Makefile .
-cp $cfgdir/src/Filepath .
-#
-# Add cfgdir path to beginning of each path in Filepath
-#
-touch Filepath
-while read filepath_arg; do
- echo "${cfgdir}/src/${filepath_arg}" >> Filepath
-done < ${cfgdir}/src/Filepath
-
-#
-# Figure out configuration
-#
-if [ ! -f ${CLM_SCRIPTDIR}/config_files/$tool ]; then
- echo "TCB.sh: configure options file ${CLM_SCRIPTDIR}/config_files/$tool not found"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
-fi
-
-##construct string of args to configure
-config_string=" "
-while read config_arg; do
- config_string="${config_string}${config_arg} "
-done < ${CLM_SCRIPTDIR}/config_files/$tool
-
-if [ "$TOOLSLIBS" != "" ]; then
- export SLIBS=$TOOLSLIBS
-fi
-echo "env CIMEROOT=$CLM_ROOT/cime COMPILER=$CESM_COMP $config_string $CLM_ROOT/cime/tools/configure --macros-format Makefile --machine $CESM_MACH $TOOLS_CONF_STRING"
-env CIMEROOT=$CLM_ROOT/cime COMPILER=$CESM_COMP $config_string $CLM_ROOT/cime/tools/configure --macros-format Makefile --machine $CESM_MACH $TOOLS_CONF_STRING >> test.log 2>&1
-rc=$?
-if [ $rc -ne 0 ]; then
- echo "TCBCFGtools.sh: configure failed, error from configure= $rc"
- echo "TCBCFGtools.sh: see ${blddir}/test.log for details"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 5
-fi
-
-. $INITMODULES
-. ./.env_mach_specific.sh
-
-attempt=1
-still_compiling="TRUE"
-while [ $still_compiling = "TRUE" ]; do
-
- echo "TCBCFGtools.sh: call to make:"
- echo " ${MAKE_CMD} USER_CPPDEFS=-DLINUX"
- if [ "$debug" != "YES" ]; then
- ${MAKE_CMD} USER_CPPDEFS=-DLINUX >> test.log 2>&1
- status="PASS"
- rc=$?
- else
- status="GEN"
- rc=0
- fi
- if [ $rc -eq 0 ]; then
- echo "TCBCFGtools.sh: make was successful"
- echo "TCBCFGtools.sh: configure and build test passed"
- echo "$status" > TestStatus
- if [ $CLM_RETAIN_FILES != "TRUE" ]; then
- echo "TCBCFGtools.sh: removing some unneeded files to save disc space"
- rm *.o
- rm *.mod
- fi
- still_compiling="FALSE"
- elif [ $attempt -lt 10 ] && \
- grep -c "LICENSE MANAGER PROBLEM" test.log > /dev/null; then
- attempt=`expr $attempt + 1`
- echo "TCBCFGtools.sh: encountered License Manager Problem; launching attempt #$attempt"
- else
- echo "TCBCFGtools.sh: clm build failed, error from make= $rc"
- echo "TCBCFGtools.sh: see ${blddir}/test.log for details"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
- fi
-done
-if [ "$TOOLSLIBS" != "" ]; then
- export -n SLIBS
-fi
-
-exit 0
diff --git a/test/tools/TCBtools.sh b/test/tools/TCBtools.sh
deleted file mode 100755
index 205b2e9da0..0000000000
--- a/test/tools/TCBtools.sh
+++ /dev/null
@@ -1,121 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 2 ]; then
- echo "TCBtools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-test_name=TCBtools.$1.$2
-
-if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TCBtools.sh: build test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TCBtools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TCBtools.sh: build test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TCBtools.sh: this build test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-cfgdir=`ls -1d ${CLM_ROOT}/tools/$1`
-blddir=${CLM_TESTDIR}/${test_name}/src
-if [ -d ${blddir} ]; then
- rm -r ${blddir}
-fi
-mkdir -p ${blddir}
-if [ $? -ne 0 ]; then
- echo "TCBtools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${blddir}
-
-echo "TCBtools.sh: building $1 executable; output in ${blddir}/test.log"
-#
-# Copy build files over
-#
-cp $cfgdir/src/Makefile .
-cp $cfgdir/src/Srcfiles .
-cp $cfgdir/src/Mkdepends .
-cp $cfgdir/src/Makefile.common .
-#
-# Add cfgdir path to beginning of each path in Filepath
-#
-touch Filepath
-while read filepath_arg; do
- echo "${cfgdir}/src/${filepath_arg}" >> Filepath
-done < ${cfgdir}/src/Filepath
-
-#
-# Figure out configuration
-#
-if [ ! -f ${CLM_SCRIPTDIR}/config_files/$2 ]; then
- echo "TCB.sh: configure options file ${CLM_SCRIPTDIR}/config_files/$2 not found"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
-fi
-
-##construct string of args to configure
-config_string="$TOOLS_MAKE_STRING TOOLROOT=$cfgdir "
-while read config_arg; do
- config_string="${config_string}${config_arg} "
-done < ${CLM_SCRIPTDIR}/config_files/$2
-
-attempt=1
-still_compiling="TRUE"
-if [ "$TOOLSLIBS" != "" ]; then
- export SLIBS=$TOOLSLIBS
-fi
-while [ $still_compiling = "TRUE" ]; do
-
- ln -s Macros.make Macros
-
- echo "TCBtools.sh: call to make:"
- echo " ${MAKE_CMD} ${config_string} "
- if [ "$debug" != "YES" ]; then
- ${MAKE_CMD} ${config_string} >> test.log 2>&1
- status="PASS"
- rc=$(( $rc + $? ))
- else
- status="GEN"
- rc=0
- fi
- if [ $rc -eq 0 ]; then
- echo "TCBtools.sh: make was successful"
- echo "TCBtools.sh: configure and build test passed"
- echo "$status" > TestStatus
- if [ $CLM_RETAIN_FILES != "TRUE" ]; then
- echo "TCBtools.sh: removing some unneeded files to save disc space"
- rm *.o
- rm *.mod
- fi
- still_compiling="FALSE"
- elif [ $attempt -lt 10 ] && \
- grep -c "LICENSE MANAGER PROBLEM" test.log > /dev/null; then
- attempt=`expr $attempt + 1`
- echo "TCBtools.sh: encountered License Manager Problem; launching attempt #$attempt"
- else
- echo "TCBtools.sh: clm build failed, error from make= $rc"
- echo "TCBtools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
- fi
-done
-if [ "$TOOLSLIBS" != "" ]; then
- export -n SLIBS
-fi
-
-exit 0
diff --git a/test/tools/TSMCFGtools.sh b/test/tools/TSMCFGtools.sh
deleted file mode 100755
index b667a4c6ec..0000000000
--- a/test/tools/TSMCFGtools.sh
+++ /dev/null
@@ -1,113 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 3 ]; then
- echo "TSMCFGtools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-tool=$(basename $1)
-test_name=TSMCFGtools.$tool.$2.$3
-
-
-if [ -z "$CLM_RERUN" ]; then
- CLM_RERUN="no"
-fi
-
-if [ "$CLM_RERUN" != "yes" ] && [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TSMCFGtools.sh: smoke test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TSMCFGtools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TSMCFGtools.sh: smoke test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TSMCFGtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-cfgdir=`ls -1d ${CLM_ROOT}/tools/${1}*`
-rundir=${CLM_TESTDIR}/${test_name}
-if [ -d ${rundir} ]; then
- rm -r ${rundir}
-fi
-mkdir -p ${rundir}
-if [ $? -ne 0 ]; then
- echo "TSMCFGtools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${rundir}
-
-echo "TSMCFGtools.sh: calling TCBCFGtools.sh to prepare $tool executable"
-${CLM_SCRIPTDIR}/TCBCFGtools.sh $1 $2
-rc=$?
-if [ $rc -ne 0 ]; then
- echo "TSMCFGtools.sh: error from TCBtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
-fi
-
-echo "TSMCFGtools.sh: running $tool output in ${rundir}/test.log"
-
-if [ "$2" = "CFGtools__o" ] || [ "$2" = "CFGtools__do" ]; then
- toolrun="env OMP_NUM_THREADS=${CLM_THREADS} ${CLM_TESTDIR}/TCBCFGtools.$tool.$2/${tool}*"
-else
- toolrun="${CLM_TESTDIR}/TCBCFGtools.$tool.$2/${tool}*"
-fi
-
-runfile="${CLM_SCRIPTDIR}/nl_files/$tool.$3"
-if [ ! -f "${runfile}" ]; then
- echo "TSMCFGtools.sh: error ${runfile} input run file not found"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 5
-fi
-
-echo "Run file type = ${3#*.}"
-if [ ${3#*.} == "runoptions" ]; then
- runopts=`cat ${runfile} | sed -e "s|CSMDATA|$CSMDATA|g"`
- echo "$toolrun $runopts"
- cp $cfgdir/*.nc .
- if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then
- $toolrun $runopts >> test.log 2>&1
- rc=$?
- status="PASS"
- else
- echo "Successfully created file" > test.log
- status="GEN"
- rc=0
- fi
-else
- echo "$toolrun < ${runfile}"
- if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then
- $toolrun < ${runfile} >> test.log 2>&1
- rc=$?
- status="PASS"
- else
- echo "Successfully created file" > test.log
- status="GEN"
- rc=0
- fi
-fi
-
-if [ $rc -eq 0 ] && grep -ci "Successfully created " test.log > /dev/null; then
- echo "TSMCFGtools.sh: smoke test passed"
- echo "$status" > TestStatus
-else
- echo "TSMCFGtools.sh: error running $tool, error= $rc"
- echo "TSMCFGtools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
-fi
-
-exit 0
diff --git a/test/tools/TSMscript_tools.sh b/test/tools/TSMscript_tools.sh
deleted file mode 100755
index 943fec97f2..0000000000
--- a/test/tools/TSMscript_tools.sh
+++ /dev/null
@@ -1,98 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 3 ]; then
- echo "TSMscript_tools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-test_name=TSMscript_tools.$1.$2.$3
-
-if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TSMscript_tools.sh: smoke test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TSMscript_tools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TSMscript_tools.sh: smoke test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TSMscript_tools.sh: this smoke test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-cfgdir=`ls -1d ${CLM_ROOT}/tools/$1`
-rundir=${CLM_TESTDIR}/${test_name}
-if [ -d ${rundir} ]; then
- rm -r ${rundir}
-fi
-mkdir -p ${rundir}
-if [ $? -ne 0 ]; then
- echo "TSMscript_tools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${rundir}
-
-optfile=${3%^*}
-cfgfile=${3#*^}
-
-if [ "$optfile" != "$3" ]; then
- echo "TSMscript_tools.sh: calling TCBtools.sh to prepare $1 executable"
- ${CLM_SCRIPTDIR}/TCBtools.sh $1 $cfgfile
- rc=$?
- if [ $rc -ne 0 ]; then
- echo "TSMscript_tools.sh: error from TCBtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
- fi
- tcbtools=${CLM_TESTDIR}/TCBtools.$1.$cfgfile
-else
- tcbtools="$rundir"
-fi
-
-scopts=`cat ${CLM_SCRIPTDIR}/nl_files/$optfile | sed -e "s|CSMDATA|$CSMDATA|g" | sed -e "s|EXEDIR|$tcbtools|g" | sed -e "s|CFGDIR|$cfgdir|g"`
-scopts=`echo $scopts | sed -e "s|CTSM_ROOT|$CTSM_ROOT|g" | sed -e "s|CIME_ROOT|$CIME_ROOT|g"`
-
-echo "TSMscript_tools.sh: running ${cfgdir}/$2 with $scopts; output in ${rundir}/test.log"
-
-if [ ! -f "${cfgdir}/$2" ]; then
- echo "TSMscript_tools.sh: error ${cfgdir}/$2 input script not found"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 5
-fi
-
-if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then
- ${cfgdir}/$2 $scopts >> test.log 2>&1
- rc=$?
- status="PASS"
-else
- echo "success" > test.log
- status="GEN"
- rc=0
-fi
-
-if [ $rc -eq 0 ] && grep -ci "Successfully " test.log > /dev/null; then
- echo "TSMscript_tools.sh: smoke test passed"
- echo "$status" > TestStatus
- # Copy files from subdirectories up...
- # (use hard links rather than symbolic links because 'ln -s' does funny
- # things when there are no matching files)
- ln */*.nc */*/*.nc .
-else
- echo "TSMscript_tools.sh: error running $2, error= $rc"
- echo "TSMscript_tools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
-fi
-
-exit 0
diff --git a/test/tools/TSMtools.sh b/test/tools/TSMtools.sh
deleted file mode 100755
index 33a2316973..0000000000
--- a/test/tools/TSMtools.sh
+++ /dev/null
@@ -1,117 +0,0 @@
-#!/bin/sh
-#
-
-if [ $# -ne 3 ]; then
- echo "TSMtools.sh: incorrect number of input arguments"
- exit 1
-fi
-
-test_name=TSMtools.$1.$2.$3
-
-if [ -z "$CLM_RERUN" ]; then
- CLM_RERUN="no"
-fi
-
-if [ "$CLM_RERUN" != "yes" ] && [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then
- if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TSMtools.sh: smoke test has already passed; results are in "
- echo " ${CLM_TESTDIR}/${test_name}"
- exit 0
- elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then
- echo "TSMtools.sh: test already generated"
- else
- read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus
- prev_jobid=${fail_msg#*job}
-
- if [ $JOBID = $prev_jobid ]; then
- echo "TSMtools.sh: smoke test has already failed for this job - will not reattempt; "
- echo " results are in: ${CLM_TESTDIR}/${test_name}"
- exit 2
- else
- echo "TSMtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to "
- echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again"
- cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid
- fi
- fi
-fi
-
-cfgdir=`ls -1d ${CLM_ROOT}/tools/$1`
-rundir=${CLM_TESTDIR}/${test_name}
-if [ -d ${rundir} ]; then
- rm -r ${rundir}
-fi
-mkdir -p ${rundir}
-if [ $? -ne 0 ]; then
- echo "TSMtools.sh: error, unable to create work subdirectory"
- exit 3
-fi
-cd ${rundir}
-
-echo "Copy any text files over"
-cp $cfgdir/*.txt $rundir
-
-echo "TSMtools.sh: calling TCBtools.sh to prepare $1 executable"
-${CLM_SCRIPTDIR}/TCBtools.sh $1 $2
-rc=$?
-if [ $rc -ne 0 ]; then
- echo "TSMtools.sh: error from TCBtools.sh= $rc"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 4
-fi
-
-echo "TSMtools.sh: running $1; output in ${rundir}/test.log"
-
-if [ "$3" = "tools__o" ] || [ "$3" = "tools__do" ]; then
- toolrun="env OMP_NUM_THREADS=${CLM_THREADS} ${CLM_TESTDIR}/TCBtools.$1.$2/$1"
-else
- toolrun="${CLM_TESTDIR}/TCBtools.$1.$2/$1"
-fi
-
-runfile="${cfgdir}/$1.$3"
-
-if [ ! -f "${runfile}" ]; then
- runfile="${CLM_SCRIPTDIR}/nl_files/$1.$3"
- if [ ! -f "${runfile}" ]; then
- echo "TSMtools.sh: error ${runfile} input run file not found"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 5
- fi
-fi
-
-echo "Run file type = ${3#*.}"
-if [ ${3#*.} == "runoptions" ]; then
- echo "$toolrun "`cat ${runfile}`
- cp $cfgdir/*.nc .
- if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then
- $toolrun `cat ${runfile}` >> test.log 2>&1
- rc=$?
- status="PASS"
- else
- echo "Successfully created file" > test.log
- status="GEN"
- rc=0
- fi
-else
- echo "$toolrun < ${runfile}"
- if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then
- $toolrun < ${runfile} >> test.log 2>&1
- rc=$?
- status="PASS"
- else
- echo "Successfully created file" > test.log
- status="GEN"
- rc=0
- fi
-fi
-
-if [ $rc -eq 0 ] && grep -ci "Successfully created " test.log > /dev/null; then
- echo "TSMtools.sh: smoke test passed"
- echo "$status" > TestStatus
-else
- echo "TSMtools.sh: error running $1, error= $rc"
- echo "TSMtools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details"
- echo "FAIL.job${JOBID}" > TestStatus
- exit 6
-fi
-
-exit 0
diff --git a/test/tools/config_files/CFGtools__ds b/test/tools/config_files/CFGtools__ds
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/test/tools/config_files/README b/test/tools/config_files/README
deleted file mode 100644
index bdfe5e0dd0..0000000000
--- a/test/tools/config_files/README
+++ /dev/null
@@ -1,9 +0,0 @@
-_do => debug on, omp only on
-_ds => debug on, serial mode (neither mpi nor omp)
-
-_o => debug off, omp only on
-_s => debug off, serial mode (neither mpi nor omp)
-
-tools__ds => options for tools, debug on, serial mode
-tools__do => options for tools, debug on, omp only on
-tools__o => options for tools, debug off, omp only on
diff --git a/test/tools/config_files/tools__do b/test/tools/config_files/tools__do
deleted file mode 100644
index 7f061ed65d..0000000000
--- a/test/tools/config_files/tools__do
+++ /dev/null
@@ -1 +0,0 @@
-SMP=TRUE OPT=FALSE
diff --git a/test/tools/config_files/tools__ds b/test/tools/config_files/tools__ds
deleted file mode 100644
index cf2d414b28..0000000000
--- a/test/tools/config_files/tools__ds
+++ /dev/null
@@ -1 +0,0 @@
-OPT=FALSE
diff --git a/test/tools/config_files/tools__o b/test/tools/config_files/tools__o
deleted file mode 100644
index 8821e0bc5a..0000000000
--- a/test/tools/config_files/tools__o
+++ /dev/null
@@ -1 +0,0 @@
-SMP=TRUE OPT=TRUE
diff --git a/test/tools/config_files/tools__s b/test/tools/config_files/tools__s
deleted file mode 100644
index 507973f8be..0000000000
--- a/test/tools/config_files/tools__s
+++ /dev/null
@@ -1 +0,0 @@
-OPT=TRUE
diff --git a/test/tools/gen_test_table.sh b/test/tools/gen_test_table.sh
deleted file mode 100755
index 0791ad0447..0000000000
--- a/test/tools/gen_test_table.sh
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/bin/sh
-#
-
-# this script, when executed in the directory containing the test-driver
-# scripts (~/test/system) will loop through the default test
-# lists for pre and post tag testing of clm and create an html file
-# (test_table.html) with the specifics of each test detailed
-
-outfile="./test_table.html"
-
-echo '' > $outfile
-echo '' >> $outfile
-echo '' >> $outfile
-echo '' >> $outfile
-echo 'CLM Testing Information Page' >> $outfile
-echo '' >> $outfile
-echo '' >> $outfile
-
-#########################################################################################
-for input_file in `ls tests_*` ; do
- echo '' >> $outfile
- echo "$input_file" >> $outfile
- echo "" >> $outfile
- echo "test# | " >> $outfile
- echo "testid | " >> $outfile
- echo "test script | " >> $outfile
- echo "arg1 | " >> $outfile
- echo "arg2 | " >> $outfile
- echo "arg3 | " >> $outfile
- echo "
" >> $outfile
-
- test_list=""
- while read input_line; do
- test_list="${test_list}${input_line} "
- done < ./${input_file}
-
- count=0
- ##loop through the tests of input file
- for test_id in ${test_list}; do
- echo "" >> $outfile
- count=`expr $count + 1`
- while [ ${#count} -lt 3 ]; do
- count="0${count}"
- done
- echo " $count | " >> $outfile
-
- master_line=`grep $test_id ./input_tests_master`
- dir=""
- for arg in ${master_line}; do
- arg1=${arg%^*}
- arg2=${arg#*^}
- if [ -d ../../tools/$arg ]; then
- dir=$arg
- elif [ -f ./nl_files/$arg ]; then
- echo "$arg | " >> $outfile
- elif [ -f ./config_files/$arg ]; then
- echo "$arg | " >> $outfile
- elif [ -f ./nl_files/$arg1 ] && [ -f ./nl_files/$arg2 ]; then
- echo "$arg1^" \
- "$arg2 | " >> $outfile
- elif [ -f ./nl_files/$arg1 ] && [ -f ./config_files/$arg2 ]; then
- echo "$arg1^" \
- "$arg2 | " >> $outfile
- elif [ -f ../../tools/$dir/$dir.$arg ]; then
- echo "$arg | " >> $outfile
- else
- echo "$arg | " >> $outfile
- fi
- done
- echo '
' >> $outfile
- done
- echo '
' >> $outfile
- echo '' >> $outfile
- echo ' ' >> $outfile
- echo '
' >> $outfile
-done
-echo '' >> $outfile
-echo '' >> $outfile
-
-exit 0
diff --git a/test/tools/get_cprnc_diffs.sh b/test/tools/get_cprnc_diffs.sh
deleted file mode 100755
index 360220cb71..0000000000
--- a/test/tools/get_cprnc_diffs.sh
+++ /dev/null
@@ -1,56 +0,0 @@
-#!/bin/bash
-
-# This script extracts lines from the output of cprnc that tell us
-# which variables differ between two files
-#
-# Usage: get_cprnc_diffs filename
-
-# ----------------------------------------------------------------------
-# SET PARAMETERS HERE
-# ----------------------------------------------------------------------
-
-# maximum number of differences to extract from the cprnc output
-maxdiffs=200
-
-# ----------------------------------------------------------------------
-# LOCAL FUNCTIONS DEFINED HERE
-# ----------------------------------------------------------------------
-
-# This function gets differences for one prefix (e.g., "RMS")
-# Usage: get_diffs prefix
-# (also uses $infile and $maxdiffs from the parent script)
-function get_diffs {
- prefix=$1
- outfile=${infile}.${prefix}.$$
- grep "$prefix" $infile > $outfile
- numlines=`wc -l $outfile | awk '{print $1}'`
- if [ $numlines -gt $maxdiffs ]; then
- echo "WARNING: Too many instances of $prefix - only printing last $maxdiffs"
- tail -$maxdiffs $outfile
- else
- cat $outfile
- fi
- rm $outfile
-}
-
-# ----------------------------------------------------------------------
-# BEGIN MAIN SCRIPT
-# ----------------------------------------------------------------------
-
-# ----------------------------------------------------------------------
-# Handle command-line arguments
-# ----------------------------------------------------------------------
-
-if [[ $# -ne 1 ]]; then
- echo "Usage: get_cprnc_diffs filename"
- exit 1
-fi
-
-infile=$1
-
-# ----------------------------------------------------------------------
-# Do the processing
-# ----------------------------------------------------------------------
-
-get_diffs RMS
-get_diffs FILLDIFF
diff --git a/test/tools/input_tests_master b/test/tools/input_tests_master
deleted file mode 100644
index 7da8c19803..0000000000
--- a/test/tools/input_tests_master
+++ /dev/null
@@ -1,32 +0,0 @@
-
-
-smc#4 TSMscript_tools.sh mkprocdata_map mkprocdata_map_wrap mkprocdata_ne30_to_f19_I2000^tools__ds
-blc#4 TBLscript_tools.sh mkprocdata_map mkprocdata_map_wrap mkprocdata_ne30_to_f19_I2000^tools__ds
-
-sm0c1 TSMscript_tools.sh site_and_regional run_neon.py run_neon_OSBS
-bl0c1 TBLscript_tools.sh site_and_regional run_neon.py run_neon_OSBS
-sm0a1 TSMscript_tools.sh site_and_regional run_neon.py run_neon_YELL_PRISM
-bl0a1 TBLscript_tools.sh site_and_regional run_neon.py run_neon_YELL_PRISM
-
-smba1 TSMscript_tools.sh site_and_regional subset_data subset_data_YELL
-blba1 TBLscript_tools.sh site_and_regional subset_data subset_data_YELL
-smbb1 TSMscript_tools.sh site_and_regional subset_data subset_data_KONA
-blbb1 TBLscript_tools.sh site_and_regional subset_data subset_data_KONA
-smb81 TSMscript_tools.sh site_and_regional subset_data subset_data_US-UMB
-blb81 TBLscript_tools.sh site_and_regional subset_data subset_data_US-UMB
-smbh1 TSMscript_tools.sh site_and_regional subset_data subset_data_f09_1x1pt_townshipSD
-blbh1 TBLscript_tools.sh site_and_regional subset_data subset_data_f09_1x1pt_townshipSD
-smbd1 TSMscript_tools.sh site_and_regional subset_data subset_data_f09_58x45pt_SouthAmerica
-blbd1 TBLscript_tools.sh site_and_regional subset_data subset_data_f09_58x45pt_SouthAmerica
-smbe1 TSMscript_tools.sh site_and_regional subset_data subset_data_f09_90x288pt_1850PanTropics
-blbe1 TBLscript_tools.sh site_and_regional subset_data subset_data_f09_90x288pt_1850PanTropics
-smbf1 TSMscript_tools.sh site_and_regional subset_data subset_data_f09_37x288pt_PanBoreal
-blbf1 TBLscript_tools.sh site_and_regional subset_data subset_data_f09_37x288pt_PanBoreal
-smbg1 TSMscript_tools.sh site_and_regional subset_data subset_data_f09_4x9pt_AlaskaTananaValley
-blbg1 TBLscript_tools.sh site_and_regional subset_data subset_data_f09_4x9pt_AlaskaTananaValley
-
-sm901 TSMscript_tools.sh site_and_regional mesh_maker mesh_maker_fv09
-bl901 TBLscript_tools.sh site_and_regional mesh_maker mesh_maker_fv09
-
-smaa2 TSMscript_tools.sh site_and_regional modify_singlept_site_neon.py modify_data_YELL
-blaa2 TBLscript_tools.sh site_and_regional modify_singlept_site_neon.py modify_data_YELL
diff --git a/test/tools/nl_files/mesh_maker_fv09 b/test/tools/nl_files/mesh_maker_fv09
deleted file mode 100644
index 7de951fee1..0000000000
--- a/test/tools/nl_files/mesh_maker_fv09
+++ /dev/null
@@ -1 +0,0 @@
- --input CSMDATA/atm/datm7/domain.lnd.fv0.9x1.25_gx1v6.090309.nc --lat yc --lon xc --overwrite --mask mask --area area --verbose
diff --git a/test/tools/nl_files/mkmapdata_if10 b/test/tools/nl_files/mkmapdata_if10
deleted file mode 100644
index f726ea34e7..0000000000
--- a/test/tools/nl_files/mkmapdata_if10
+++ /dev/null
@@ -1 +0,0 @@
--r 10x15 --fast --batch
diff --git a/test/tools/nl_files/mkmapdata_ne30np4 b/test/tools/nl_files/mkmapdata_ne30np4
deleted file mode 100644
index ae435ac2bc..0000000000
--- a/test/tools/nl_files/mkmapdata_ne30np4
+++ /dev/null
@@ -1 +0,0 @@
--r ne30np4 --fast --batch
diff --git a/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000 b/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000
deleted file mode 100644
index af85dcf226..0000000000
--- a/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000
+++ /dev/null
@@ -1 +0,0 @@
--i CSMDATA/lnd/clm2/test_mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c170430.nc -o ne30output_onf19grid.nc -m CSMDATA/lnd/clm2/test_mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc -t CSMDATA/lnd/clm2/test_mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c170430.nc -e EXEDIR
diff --git a/test/tools/nl_files/modify_data_YELL b/test/tools/nl_files/modify_data_YELL
deleted file mode 100644
index 0d180e8bf6..0000000000
--- a/test/tools/nl_files/modify_data_YELL
+++ /dev/null
@@ -1 +0,0 @@
---neon_site YELL --surf_dir CSMDATA/lnd/clm2/surfdata_esmf/NEON --out_dir EXEDIR --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/run_neon_OSBS b/test/tools/nl_files/run_neon_OSBS
deleted file mode 100644
index 0c274b13ad..0000000000
--- a/test/tools/nl_files/run_neon_OSBS
+++ /dev/null
@@ -1 +0,0 @@
---verbose --run-type ad --setup-only --neon-site OSBS
diff --git a/test/tools/nl_files/run_neon_YELL_PRISM b/test/tools/nl_files/run_neon_YELL_PRISM
deleted file mode 100644
index f5ebdf9fdf..0000000000
--- a/test/tools/nl_files/run_neon_YELL_PRISM
+++ /dev/null
@@ -1 +0,0 @@
---verbose --run-type transient --setup-only --neon-site YELL --prism --neon-version v2 --experiment toolstest
diff --git a/test/tools/nl_files/subset_data_KONA b/test/tools/nl_files/subset_data_KONA
deleted file mode 100644
index 0df59b1b17..0000000000
--- a/test/tools/nl_files/subset_data_KONA
+++ /dev/null
@@ -1 +0,0 @@
-point --lon 263.38956 --lat 39.1082 --site KONA --dompft 17 19 23 45 --pctpft 28 12 32 28 --crop --create-surface --outdir EXEDIR/KONA_user-mod_and_data --user-mods-dir EXEDIR/KONA_user-mod_and_data --verbose --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/subset_data_US-UMB b/test/tools/nl_files/subset_data_US-UMB
deleted file mode 100644
index 935b0dc99d..0000000000
--- a/test/tools/nl_files/subset_data_US-UMB
+++ /dev/null
@@ -1 +0,0 @@
-point --lon 275.28626 --lat 45.5598 --site 1x1_US-UMB --dompft 7 --cap-saturation --uniform-snowpack --create-surface --outdir EXEDIR/US-UMB_user-mod_and_data --user-mods-dir EXEDIR/US-UMB_user-mod_and_data --verbose --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/subset_data_YELL b/test/tools/nl_files/subset_data_YELL
deleted file mode 100644
index 0d6960e7f5..0000000000
--- a/test/tools/nl_files/subset_data_YELL
+++ /dev/null
@@ -1 +0,0 @@
-point --lon 250.45804 --lat 44.95597 --site YELL --dompft 1 --crop --uniform-snowpack --cap-saturation --create-surface --outdir EXEDIR/YELL_user-mod_and_data --user-mods-dir EXEDIR/YELL_user-mod_and_data --silent --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/subset_data_f09_1x1pt_townshipSD b/test/tools/nl_files/subset_data_f09_1x1pt_townshipSD
deleted file mode 100644
index aa25c07d1e..0000000000
--- a/test/tools/nl_files/subset_data_f09_1x1pt_townshipSD
+++ /dev/null
@@ -1 +0,0 @@
-point --lon 257.5 --lat 43.822 --site f09_1x1pt_townshipSD --include-nonveg --crop --create-datm --create-user-mods --datm-syr 2000 --datm-eyr 2000 --create-surface --outdir EXEDIR/f09_US_pt_user-mod_and_data --user-mods-dir EXEDIR/f09_US_pt_user-mod_and_data --verbose --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/subset_data_f09_37x288pt_PanBoreal b/test/tools/nl_files/subset_data_f09_37x288pt_PanBoreal
deleted file mode 100644
index 448b5052d6..0000000000
--- a/test/tools/nl_files/subset_data_f09_37x288pt_PanBoreal
+++ /dev/null
@@ -1 +0,0 @@
-region --lat1 55 --lat2 89.1 --lon1 0 --lon2 360 --create-mesh --create-surface --create-domain --create-user-mods --verbose --overwrite --reg f09_37x288pt_PanBoreal --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/subset_data_f09_4x9pt_AlaskaTananaValley b/test/tools/nl_files/subset_data_f09_4x9pt_AlaskaTananaValley
deleted file mode 100644
index 9928d78429..0000000000
--- a/test/tools/nl_files/subset_data_f09_4x9pt_AlaskaTananaValley
+++ /dev/null
@@ -1 +0,0 @@
-region --lat1 62 --lat2 66 --lon1 -152 --lon2 -141 --create-mesh --create-domain --create-surface --create-user-mods --verbose --overwrite --reg f09_4x9pt_AlaskaTananaValley --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/subset_data_f09_58x45pt_SouthAmerica b/test/tools/nl_files/subset_data_f09_58x45pt_SouthAmerica
deleted file mode 100644
index 201dd2c76c..0000000000
--- a/test/tools/nl_files/subset_data_f09_58x45pt_SouthAmerica
+++ /dev/null
@@ -1 +0,0 @@
-region --lat1 -40 --lat2 15 --lon1 275 --lon2 330 --create-mesh --create-surface --create-user-mods --create-domain --create-landuse --verbose --overwrite --reg f09_58x45_SouthAmerica --inputdata-dir CSMDATA
diff --git a/test/tools/nl_files/subset_data_f09_90x288pt_1850PanTropics b/test/tools/nl_files/subset_data_f09_90x288pt_1850PanTropics
deleted file mode 100644
index 1c9d5eace9..0000000000
--- a/test/tools/nl_files/subset_data_f09_90x288pt_1850PanTropics
+++ /dev/null
@@ -1 +0,0 @@
-region --lat1 -55 --lat2 30 --lon1 0 --lon2 360 --crop --create-surface --create-domain --create-mesh --overwrite --reg f09_90x288pt_1850PanTropics --inputdata-dir CSMDATA --cfg-file CTSM_ROOT/tools/mksurfdata_map/default_data_1850.cfg --verbose
diff --git a/test/tools/show_var_diffs.sh b/test/tools/show_var_diffs.sh
deleted file mode 100755
index f462d4ad0c..0000000000
--- a/test/tools/show_var_diffs.sh
+++ /dev/null
@@ -1,79 +0,0 @@
-#!/bin/bash
-
-# This script processes a log file that was output by test_driver,
-# giving lists of all variables with differences in values (those with
-# RMS errors), and all variables with differences in fill patterns.
-#
-# This assumes that the log file contains output like:
-# RMS foo
-# RMS bar
-# FILLDIFF foo
-# FILLDIFF bar
-# Some characteristics of these output lines are:
-# - they begin with a leading space, followed by RMS or FILLDIFF
-# - the variable name is in the second column of the line
-#
-# Note that (as of 4-5-12) the log file only contains output from the
-# last file that didn't match, so this could potentially miss
-# something -- especially if there are both h0 and h1 files in the
-# comparison.
-
-# Usage: show_var_diffs logfile
-
-# ----------------------------------------------------------------------
-# LOCAL FUNCTIONS DEFINED HERE
-# ----------------------------------------------------------------------
-
-# This function shows the differences for one prefix (e.g., "RMS")
-# Usage: show_diffs prefix
-# (also uses $logfile from the parent script)
-#
-# Matches lines that start with the regular expression "^ ${prefix}"
-# (note that one leading space is expected before the prefix)
-#
-# Assumes that the variable name is in the second column of matching lines
-function show_diffs {
- prefix=$1
-
- # first determine if there were warnings relating to this prefix
- grep "WARNING: Too many instances of ${prefix}" $logfile > /dev/null
- if [ $? -eq 0 ]; then # found a warning
- echo "WARNING: Some output was truncated; this may not be a complete list"
- fi
-
- # now make a list of all variables matching this prefix
- grep "^ ${prefix}" $logfile > $logfile.tmp.$$
- if [ $? -eq 0 ]; then
- awk '{print $2}' $logfile.tmp.$$ | sort | uniq
- else
- echo "(no differences)"
- fi
-
- rm $logfile.tmp.$$
-}
-
-# ----------------------------------------------------------------------
-# BEGIN MAIN SCRIPT
-# ----------------------------------------------------------------------
-
-# ----------------------------------------------------------------------
-# Handle command-line arguments
-# ----------------------------------------------------------------------
-
-if [[ $# -ne 1 ]]; then
- echo "Usage: show_var_diffs logfile"
- exit 1
-fi
-
-logfile=$1
-
-# ----------------------------------------------------------------------
-# Do the processing
-# ----------------------------------------------------------------------
-
-echo "Variables with differences in values:"
-show_diffs "RMS"
-
-echo ""
-echo "Variables with differences in fill patterns:"
-show_diffs "FILLDIFF"
\ No newline at end of file
diff --git a/test/tools/test_driver.sh b/test/tools/test_driver.sh
deleted file mode 100755
index f93301a530..0000000000
--- a/test/tools/test_driver.sh
+++ /dev/null
@@ -1,722 +0,0 @@
-#!/bin/sh
-#
-# test_driver.sh: driver script for the offline testing of CLM of tools
-#
-# interactive usage on all machines:
-#
-# env ./test_driver.sh -i
-#
-# valid arguments:
-# -i interactive usage
-# -d debug usage -- display tests that will run -- but do NOT actually execute them
-# -f force batch submission (avoids user prompt)
-# -h displays this help message
-#
-#
-# **pass environment variables by preceding above commands
-# with 'env var1=setting var2=setting '
-# **more details in the CLM testing user's guide, accessible
-# from the CLM developers web page
-
-
-#will attach timestamp onto end of script name to prevent overwriting
-cur_time=`date '+%H:%M:%S'`
-
-hostname=`hostname`
-echo $hostname
-case $hostname in
-
- ##Derecho
- derecho* | dec*)
- submit_script="test_driver_derecho${cur_time}.sh"
-
-##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv
-cat > ./${submit_script} << EOF
-#!/bin/sh
-#
-
-interactive="YES"
-input_file="tests_pretag_derecho_nompi"
-c_threads=128
-
-export INITMODULES="/glade/u/apps/derecho/23.06/spack/opt/spack/lmod/8.7.20/gcc/7.5.0/pdxb/lmod/lmod/init/sh"
-. \$INITMODULES
-
-module --force purge
-module load ncarenv
-module load craype
-module load intel
-module load mkl
-module load ncarcompilers
-module load netcdf
-module load nco
-module load ncl
-
-#omp threads
-if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line
- export CLM_THREADS=\$c_threads
-fi
-
-# Stop on first failed test
-if [ -z "\$CLM_SOFF" ]; then #CLM_SOFF NOT set
- export CLM_SOFF=FALSE
-fi
-
-export CESM_MACH="derecho"
-export CESM_COMP="intel"
-
-export NETCDF_DIR=\$NETCDF
-export INC_NETCDF=\$NETCDF/include
-export LIB_NETCDF=\$NETCDF/lib
-export MAKE_CMD="gmake -j "
-export CFG_STRING=""
-export TOOLS_MAKE_STRING="USER_FC=ifort USER_LINKER=ifort USER_CPPDEFS=-DLINUX"
-export MACH_WORKSPACE=\$SCRATCH
-export CPRNC_EXE="$CESMDATAROOT/cprnc/cprnc"
-dataroot="$CESMDATAROOT/inputdata"
-export TOOLSLIBS=""
-export REGRID_PROC=1
-export TOOLS_CONF_STRING="--mpilib mpi-serial"
-
-
-echo_arg=""
-
-EOF
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^
- ;;
-
- ##cheyenne
- cheyenne* | r*i*n*)
- submit_script="test_driver_cheyenne${cur_time}.sh"
-
-#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv
-at > ./${submit_script} << EOF
-!/bin/sh
-
-
-interactive="YES"
-input_file="tests_pretag_cheyenne_nompi"
-c_threads=36
-
-
-export INITMODULES="/glade/u/apps/ch/opt/lmod/8.1.7/lmod/lmod/init/sh"
-. \$INITMODULES
-
-module purge
-module load ncarenv
-module load intel
-module load mkl
-module load ncarcompilers
-module load netcdf
-
-module load nco
-module load ncl
-
-module load conda
-
-
-##omp threads
-if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line
- export CLM_THREADS=\$c_threads
-fi
-
-# Stop on first failed test
-if [ -z "\$CLM_SOFF" ]; then #CLM_SOFF NOT set
- export CLM_SOFF=FALSE
-fi
-
-export CESM_MACH="cheyenne"
-export CESM_COMP="intel"
-
-export NETCDF_DIR=\$NETCDF
-export INC_NETCDF=\$NETCDF/include
-export LIB_NETCDF=\$NETCDF/lib
-export MAKE_CMD="gmake -j "
-export CFG_STRING=""
-export TOOLS_MAKE_STRING="USER_FC=ifort USER_LINKER=ifort USER_CPPDEFS=-DLINUX"
-export MACH_WORKSPACE="/glade/scratch"
-export CPRNC_EXE="$CESMDATAROOT/tools/cime/tools/cprnc/cprnc.cheyenne"
-dataroot="$CESMDATAROOT"
-export TOOLSLIBS=""
-export REGRID_PROC=1
-export TOOLS_CONF_STRING="--mpilib mpi-serial"
-
-
-echo_arg=""
-
-EOF
-##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^
- ;;
-
- ## DAV cluster
- casper* | pronghorn*)
- submit_script="test_driver_dav${cur_time}.sh"
-
-##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv
-cat > ./${submit_script} << EOF
-#!/bin/sh
-#
-
-interactive="YES"
-input_file="tests_posttag_dav_mpi"
-c_threads=36
-
-
-export INITMODULES="/glade/u/apps/ch/opt/lmod/8.1.7/lmod/lmod/init/sh"
-. \$INITMODULES
-
-module purge
-module load ncarenv
-module load intel
-module load mkl
-module load ncarcompilers
-module load netcdf
-module load openmpi
-
-module load nco
-module load conda
-module load ncl
-
-
-##omp threads
-if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line
- export CLM_THREADS=\$c_threads
-fi
-
-# Stop on first failed test
-if [ -z "\$CLM_SOFF" ]; then #CLM_SOFF NOT set
- export CLM_SOFF=FALSE
-fi
-
-export CESM_MACH="cheyenne"
-export CESM_COMP="intel"
-
-export NETCDF_DIR=\$NETCDF
-export INC_NETCDF=\$NETCDF/include
-export LIB_NETCDF=\$NETCDF/lib
-export MAKE_CMD="gmake -j "
-export CFG_STRING=""
-export TOOLS_MAKE_STRING="USER_FC=ifort USER_LINKER=ifort USER_CPPDEFS=-DLINUX"
-export MACH_WORKSPACE="/glade/scratch"
-export CPRNC_EXE="$CESMDATAROOT/tools/cime/tools/cprnc/cprnc.cheyenne"
-dataroot="$CESMDATAROOT"
-export TOOLSLIBS=""
-export TOOLS_CONF_STRING="--mpilib mpich"
-
-
-echo_arg=""
-
-EOF
-##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^
- ;;
-
- ## hobart
- hobart* | h*.cgd.ucar.edu)
- submit_script="test_driver_hobart_${cur_time}.sh"
- export PATH=/cluster/torque/bin:${PATH}
-
-##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv
-cat > ./${submit_script} << EOF
-#!/bin/sh
-#
-
-# Name of the queue (CHANGE THIS if needed)
-#PBS -q long
-# Number of nodes (CHANGE THIS if needed)
-#PBS -l nodes=1:ppn=24
-# output file base name
-#PBS -N test_dr
-# Put standard error and standard out in same file
-#PBS -j oe
-# Export all Environment variables
-#PBS -V
-# End of options
-
-if [ -n "\$PBS_JOBID" ]; then #batch job
- export JOBID=\`echo \${PBS_JOBID} | cut -f1 -d'.'\`
- initdir=\${PBS_O_WORKDIR}
-fi
-
-if [ "\$PBS_ENVIRONMENT" = "PBS_BATCH" ]; then
- interactive="NO"
- input_file="tests_posttag_hobart"
-else
- interactive="YES"
- input_file="tests_posttag_hobart_nompi"
-fi
-
-##omp threads
-if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line
- export CLM_THREADS=2
-fi
-export CLM_RESTART_THREADS=1
-
-##mpi tasks
-export CLM_TASKS=24
-export CLM_RESTART_TASKS=20
-
-export P4_GLOBMEMSIZE=500000000
-
-
-export CESM_MACH="hobart"
-
-ulimit -s unlimited
-ulimit -c unlimited
-
-export CESM_COMP="intel"
-export TOOLS_MAKE_STRING="USER_FC=ifort USER_CC=icc "
-export TOOLS_CONF_STRING=" -mpilib mpi-serial"
-export CFG_STRING=""
-export INITMODULES="/usr/share/Modules/init/sh"
-
-. \$INITMODULES
-module purge
-module load compiler/intel
-module load tool/nco
-module load tool/netcdf
-module load lang/python
-
-export NETCDF_DIR=\$NETCDF_PATH
-export INC_NETCDF=\${NETCDF_PATH}/include
-export LIB_NETCDF=\${NETCDF_PATH}/lib
-export MAKE_CMD="gmake -j 5" ##using hyper-threading on hobart
-export MACH_WORKSPACE="/scratch/cluster"
-export CPRNC_EXE=/fs/cgd/csm/tools/cprnc/cprnc
-export DATM_QIAN_DATA_DIR="/project/tss/atm_forcing.datm7.Qian.T62.c080727"
-dataroot="/fs/cgd/csm"
-export TOOLSSLIBS=""
-echo_arg="-e"
-
-EOF
-##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^
- ;;
-
- ## izumi
- izumi* | i*.unified.ucar.edu)
- submit_script="test_driver_izumi_${cur_time}.sh"
- export PATH=/cluster/torque/bin:${PATH}
-
-##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv
-cat > ./${submit_script} << EOF
-#!/bin/sh
-#
-
-# Name of the queue (CHANGE THIS if needed)
-#PBS -q long
-# Number of nodes (CHANGE THIS if needed)
-#PBS -l nodes=1:ppn=24
-# output file base name
-#PBS -N test_dr
-# Put standard error and standard out in same file
-#PBS -j oe
-# Export all Environment variables
-#PBS -V
-# End of options
-
-if [ -n "\$PBS_JOBID" ]; then #batch job
- export JOBID=\`echo \${PBS_JOBID} | cut -f1 -d'.'\`
- initdir=\${PBS_O_WORKDIR}
-fi
-
-if [ "\$PBS_ENVIRONMENT" = "PBS_BATCH" ]; then
- interactive="NO"
- input_file="tests_posttag_izumi"
-else
- interactive="YES"
- input_file="tests_posttag_izumi_nompi"
-fi
-
-##omp threads
-if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line
- export CLM_THREADS=2
-fi
-export CLM_RESTART_THREADS=1
-
-##mpi tasks
-export CLM_TASKS=24
-export CLM_RESTART_TASKS=20
-
-export P4_GLOBMEMSIZE=500000000
-
-
-export CESM_MACH="izumi"
-
-ulimit -s unlimited
-ulimit -c unlimited
-
-export CESM_COMP="intel"
-export TOOLS_MAKE_STRING="USER_FC=ifort USER_CC=icc "
-export TOOLS_CONF_STRING=" -mpilib mpi-serial"
-export CFG_STRING=""
-export INITMODULES="/usr/share/Modules/init/sh"
-
-. \$INITMODULES
-module purge
-module load compiler/intel
-module load tool/nco
-module load tool/netcdf
-module load lang/python
-
-export NETCDF_DIR=\$NETCDF_PATH
-export INC_NETCDF=\${NETCDF_PATH}/include
-export LIB_NETCDF=\${NETCDF_PATH}/lib
-export MAKE_CMD="gmake -j 5" ##using hyper-threading on izumi
-export MACH_WORKSPACE="/scratch/cluster"
-export CPRNC_EXE=/fs/cgd/csm/tools/cprnc/cprnc.izumi
-export DATM_QIAN_DATA_DIR="/project/tss/atm_forcing.datm7.Qian.T62.c080727"
-dataroot="/fs/cgd/csm"
-export TOOLSSLIBS=""
-echo_arg="-e"
-
-EOF
-##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^
- ;;
-
- * )
- echo "Only setup to work on: derecho, cheyenne, hobart and izumi"
- exit
-
-
-esac
-
-##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv
-cat >> ./${submit_script} << EOF
-
-export CPRNC_OPT=""
-if [ -n "\${CLM_JOBID}" ]; then
- export JOBID=\${CLM_JOBID}
-fi
-##check if interactive job
-
-if [ "\$interactive" = "YES" ]; then
-
- if [ -z "\${JOBID}" ]; then
- export JOBID=\$\$
- fi
- echo "test_driver.sh: interactive run - setting JOBID to \$JOBID"
- if [ \$0 = "test_driver.sh" ]; then
- initdir="."
- else
- initdir=\${0%/*}
- fi
-else
- echo "ERROR: you *always* need to use the interactive option (-i)"
- echo " currently doesn't work without it"
- exit 3
-fi
-
-##establish script dir and clm_root
-if [ -f \${initdir}/test_driver.sh ]; then
- export CLM_SCRIPTDIR=\`cd \${initdir}; pwd \`
- export CLM_ROOT=\`cd \${CLM_SCRIPTDIR}/../..; pwd \`
- export CTSM_ROOT=\${CLM_ROOT}
- if [ -d \${CLM_ROOT}/cime ]; then
- export CIME_ROOT=\${CLM_ROOT}/cime
- else
- export CIME_ROOT=\${CLM_ROOT}/../../cime
- fi
- if [ ! -d \${CIME_ROOT} ]; then
- echo "ERROR: trouble finding the CIME_ROOT directory: \$CIME_ROOT"
- exit 3
- fi
-else
- if [ -n "\${CLM_ROOT}" ] && [ -f \${CLM_ROOT}/test/tools/test_driver.sh ]; then
- export CLM_SCRIPTDIR=\`cd \${CLM_ROOT}/test/tools; pwd \`
- else
- echo "ERROR: unable to determine script directory "
- echo " if initiating batch job from directory other than the one containing test_driver.sh, "
- echo " you must set the environment variable CLM_ROOT to the full path of directory containing "
- echo " . "
- exit 3
- fi
-fi
-
-# Setup conda environment
-conda activate ctsm_pylib
-if [ \$? -ne 0 ]; then
- echo "ERROR: Trouble activating the ctsm_pylib conda environment, be sure it's setup with \$CLM_ROOT/py_env_create, then rerun"
- exit 4
-fi
-
-##output files
-clm_log=\${initdir}/td.\${JOBID}.log
-if [ -f \$clm_log ]; then
- rm \$clm_log
-fi
-clm_status=\${initdir}/td.\${JOBID}.status
-if [ -f \$clm_status ]; then
- rm \$clm_status
-fi
-
-##setup test work directory
-if [ -z "\$CLM_TESTDIR" ]; then
- export CLM_TESTDIR=\${MACH_WORKSPACE}/\$LOGNAME/clmTests/test-driver.\${JOBID}
- if [ -d \$CLM_TESTDIR ] && [ \$CLM_RETAIN_FILES != "TRUE" ]; then
- rm -r \$CLM_TESTDIR
- fi
-fi
-if [ ! -d \$CLM_TESTDIR ]; then
- mkdir -p \$CLM_TESTDIR
- if [ \$? -ne 0 ]; then
- echo "ERROR: unable to create work directory \$CLM_TESTDIR"
- exit 4
- fi
-fi
-
-## MCT and PIO build directorys
-export MCT_LIBDIR=\$CLM_TESTDIR/mct
-export PIO_LIBDIR=\$CLM_TESTDIR/pio
-
-##set our own environment vars
-export CSMDATA=\${dataroot}/inputdata
-export DIN_LOC_ROOT=\${CSMDATA}
-export MPI_TYPE_MAX=100000
-
-##process other env vars possibly coming in
-if [ -z "\$CLM_RETAIN_FILES" ]; then
- export CLM_RETAIN_FILES=FALSE
-fi
-if [ -n "\${CLM_INPUT_TESTS}" ]; then
- input_file=\$CLM_INPUT_TESTS
-else
- input_file=\${CLM_SCRIPTDIR}/\${input_file}
-fi
-if [ ! -f \${input_file} ]; then
- echo "ERROR: unable to locate input file \${input_file}"
- exit 5
-fi
-
-if [ \$interactive = "YES" ]; then
- echo "reading tests from \${input_file}"
-else
- echo "reading tests from \${input_file}" >> \${clm_log}
-fi
-
-num_tests=\`wc -w < \${input_file}\`
-echo "STATUS OF CLM TESTING UNDER JOB \${JOBID}; scheduled to run \$num_tests tests from:" >> \${clm_status}
-echo "\$input_file" >> \${clm_status}
-echo "" >> \${clm_status}
-echo " on machine: $hostname" >> \${clm_status}
-if [ -n "${BL_ROOT}" ]; then
- echo "tests of baseline will use source code from:" >> \${clm_status}
- echo "\$BL_ROOT" >> \${clm_status}
-fi
-if [ \$interactive = "NO" ]; then
- echo "see \${clm_log} for more detailed output" >> \${clm_status}
-fi
-echo "" >> \${clm_status}
-
-test_list=""
-while read input_line; do
- test_list="\${test_list}\${input_line} "
-done < \${input_file}
-
-
-##initialize flags, counter
-skipped_tests="NO"
-pending_tests="NO"
-count=0
-
-##loop through the tests of input file
-for test_id in \${test_list}; do
- count=\`expr \$count + 1\`
- while [ \${#count} -lt 3 ]; do
- count="0\${count}"
- done
-
- master_line=\`grep \$test_id \${CLM_SCRIPTDIR}/input_tests_master\`
- status_out=""
- for arg in \${master_line}; do
- status_out="\${status_out}\${arg} "
- done
-
- if [ -z "\$status_out" ]; then
- echo "No test matches \$test_id in \${CLM_SCRIPTDIR}/input_tests_master"
- exit 3
- fi
-
- test_cmd=\${status_out#* }
-
- status_out="\${count} \${status_out}"
-
- if [ \$interactive = "YES" ]; then
- echo ""
- echo "***********************************************************************************"
- echo "\${status_out}"
- echo "***********************************************************************************"
- else
- echo "" >> \${clm_log}
- echo "***********************************************************************************"\
- >> \${clm_log}
- echo "\$status_out" >> \${clm_log}
- echo "***********************************************************************************"\
- >> \${clm_log}
- fi
-
- if [ \${#status_out} -gt 94 ]; then
- status_out=\`echo "\${status_out}" | cut -c1-100\`
- fi
- while [ \${#status_out} -lt 97 ]; do
- status_out="\${status_out}."
- done
-
- echo \$echo_arg "\$status_out\c" >> \${clm_status}
-
- if [ \$interactive = "YES" ]; then
- \${CLM_SCRIPTDIR}/\${test_cmd}
- rc=\$?
- else
- \${CLM_SCRIPTDIR}/\${test_cmd} >> \${clm_log} 2>&1
- rc=\$?
- fi
- if [ \$rc -eq 0 ]; then
- echo "PASS" >> \${clm_status}
- elif [ \$rc -eq 255 ]; then
- echo "SKIPPED*" >> \${clm_status}
- skipped_tests="YES"
- elif [ \$rc -eq 254 ]; then
- echo "PENDING**" >> \${clm_status}
- pending_tests="YES"
- else
- echo " rc=\$rc FAIL" >> \${clm_status}
- if [ "\$CLM_SOFF" = "TRUE" ]; then
- echo "stopping on first failure" >> \${clm_status}
- echo "stopping on first failure" >> \${clm_log}
- exit 6
- fi
- fi
-done
-
-echo "end of input" >> \${clm_status}
-if [ \$interactive = "YES" ]; then
- echo "end of input"
-else
- echo "end of input" >> \${clm_log}
-fi
-
-if [ \$skipped_tests = "YES" ]; then
- echo "* please verify that any skipped tests are not required of your clm commit" >> \${clm_status}
-fi
-if [ \$pending_tests = "YES" ]; then
- echo "** tests that are pending must be checked manually for a successful completion" >> \${clm_status}
- if [ \$interactive = "NO" ]; then
- echo " see the test's output in \${clm_log} " >> \${clm_status}
- echo " for the location of test results" >> \${clm_status}
- fi
-fi
-
-if [ "\$interactive" = "YES" ]; then
- passInt="test_driver.sh-i"
-else
- passInt="test_driver.sh"
-fi
-
-../../bld/unit_testers/xFail/wrapClmTests.pl -statusFile "\${clm_status}" -numberOfTests "\${num_tests}" -callingScript "\${passInt}"
-
-exit 0
-
-EOF
-##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^
-
-
-chmod a+x $submit_script
-if [ ! -z "$CLM_RETAIN_FILES" ]; then
- export CLM_RETAIN_FILES="FALSE"
-fi
-arg1=${1##*-}
-case $arg1 in
- [iI]* )
- debug="NO"
- interactive="YES"
- compile_only="NO"
- export debug
- export interactive
- export compile_only
- ./${submit_script}
- exit 0
- ;;
-
- [cC]* )
- debug="NO"
- interactive="YES"
- compile_only="YES"
- export debug
- export CLM_RETAIN_FILES="TRUE"
- export interactive
- export compile_only
- export CLM_RETAIN_FILES="TRUE"
- ./${submit_script}
- exit 0
- ;;
-
- [dD]* )
- debug="YES"
- interactive="YES"
- compile_only="NO"
- export debug
- export interactive
- export compile_only
- ./${submit_script}
- exit 0
- ;;
-
- [fF]* )
- debug="NO"
- interactive="NO"
- compile_only="NO"
- export debug
- export interactive
- export compile_only
- ;;
-
- "" )
- echo ""
- echo "**********************"
- echo "$submit_script has been created and will be submitted to the batch queue..."
- echo "(ret) to continue, (a) to abort"
- read ans
- case $ans in
- [aA]* )
- echo "aborting...type ./test_driver.sh -h for help message"
- exit 0
- ;;
- esac
- debug="NO"
- interactive="NO"
- compile_only="NO"
- export debug
- export interactive
- export compile_only
- ;;
-
- * )
- echo ""
- echo "**********************"
- echo "usage on derecho, cheyenne, hobart, and izumi: "
- echo "./test_driver.sh -i"
- echo ""
- echo "valid arguments: "
- echo "-i interactive usage"
- echo "-c compile-only usage (run configure and compile do not run clm)"
- echo "-d debug-only usage (run configure and build-namelist do NOT compile or run clm)"
- echo "-f force batch submission (avoids user prompt)"
- echo "-h displays this help message"
- echo ""
- echo "**pass environment variables by preceding above commands "
- echo " with 'env var1=setting var2=setting '"
- echo ""
- echo "**********************"
- exit 0
- ;;
-esac
-
-echo "submitting..."
-case $hostname in
- #default
- * )
- echo "no submission capability on this machine use the interactive option: -i"
- exit 0
- ;;
-
-esac
-exit 0
diff --git a/test/tools/tests_posttag_hobart_nompi b/test/tools/tests_posttag_hobart_nompi
deleted file mode 100644
index c185428868..0000000000
--- a/test/tools/tests_posttag_hobart_nompi
+++ /dev/null
@@ -1 +0,0 @@
-smc#4 blc#4
diff --git a/test/tools/tests_posttag_nompi_regression b/test/tools/tests_posttag_nompi_regression
deleted file mode 100644
index c185428868..0000000000
--- a/test/tools/tests_posttag_nompi_regression
+++ /dev/null
@@ -1 +0,0 @@
-smc#4 blc#4
diff --git a/test/tools/tests_pretag_cheyenne_nompi b/test/tools/tests_pretag_cheyenne_nompi
deleted file mode 100644
index e92ffaaaad..0000000000
--- a/test/tools/tests_pretag_cheyenne_nompi
+++ /dev/null
@@ -1,3 +0,0 @@
-smc#4 blc#4
-smba1 blba1
-smbd1 blbd1
diff --git a/test/tools/tests_pretag_derecho_nompi b/test/tools/tests_pretag_derecho_nompi
deleted file mode 100644
index 5fdaf335ae..0000000000
--- a/test/tools/tests_pretag_derecho_nompi
+++ /dev/null
@@ -1,9 +0,0 @@
-smba1 blba1
-smbd1 blbd1
-sm0a1 bl0a1
-sm0c1 bl0c1
-smaa2 blaa2
-smba1 blba1
-smb81 blb81
-smbc1 blbc1
-smbd1 blbd1
diff --git a/test/tools/tests_pretag_nompi_neon b/test/tools/tests_pretag_nompi_neon
deleted file mode 100644
index e5fa27e6c4..0000000000
--- a/test/tools/tests_pretag_nompi_neon
+++ /dev/null
@@ -1,8 +0,0 @@
-sm0a1 bl0a1
-sm0c1 bl0c1
-smaa2 blaa2
-smba1 blba1
-smbb1 blbb1
-smb81 blb81
-smbc1 blbc1
-smbd1 blbd1