diff --git a/.gitignore b/.gitignore index a3997f2a..25472c52 100644 --- a/.gitignore +++ b/.gitignore @@ -23,6 +23,8 @@ buildnmlc test/include/*.mod test/include/*.o test/unit/tmp +test/system/*.log +test/system/cime-tests.o* # Ignore editor temporaries and backups *.swp diff --git a/Externals.cfg b/Externals.cfg index 5a9544c6..ad6907e6 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -1,5 +1,5 @@ [ccs_config] -tag = ccs_config_cesm0.0.78 +tag = ccs_config_cesm0.0.106 protocol = git repo_url = https://github.com/ESMCI/ccs_config_cesm local_path = ccs_config @@ -13,7 +13,7 @@ local_path = components/cice5 required = True [cice6] -tag = cesm_cice6_4_1_10 +tag = cesm_cice6_5_0_7 protocol = git repo_url = https://github.com/ESCOMP/CESM_CICE local_path = components/cice @@ -21,14 +21,14 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.14.39 +tag = cmeps0.14.60 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps required = True [cdeps] -tag = cdeps1.0.21 +tag = cdeps1.0.33 protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git local_path = components/cdeps @@ -36,14 +36,14 @@ externals = Externals_CDEPS.cfg required = True [cpl7] -tag = cpl77.0.6 +tag = cpl77.0.8 protocol = git repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps local_path = components/cpl7 required = True [share] -tag = share1.0.17 +tag = share1.0.18 protocol = git repo_url = https://github.com/ESCOMP/CESM_share local_path = share @@ -64,14 +64,14 @@ local_path = libraries/parallelio required = True [cime] -tag = cime6.0.175 +tag = cime6.0.236_httpsbranch01 protocol = git repo_url = https://github.com/ESMCI/cime local_path = cime required = True [cism] -tag = cismwrap_2_1_96 +tag = cismwrap_2_1_100 protocol = git repo_url = https://github.com/ESCOMP/CISM-wrapper local_path = components/cism @@ -79,7 +79,7 @@ externals = Externals_CISM.cfg required = True [clm] -tag = ctsm5.1.dev139 +tag = ctsm5.2.005 protocol = git repo_url = https://github.com/ESCOMP/CTSM local_path = components/clm @@ -87,8 +87,7 @@ externals = Externals_CLM.cfg required = True [fms] -# Older tag than CESM as there is a compilation error mismatch -tag = fi_20211011 +tag = fi_230818 protocol = git repo_url = https://github.com/ESCOMP/FMS_interface local_path = libraries/FMS @@ -96,14 +95,14 @@ externals = Externals_FMS.cfg required = True [mosart] -tag = mosart1_0_48 +tag = mosart1_0_49 protocol = git repo_url = https://github.com/ESCOMP/MOSART local_path = components/mosart required = True [rtm] -tag = rtm1_0_78 +tag = rtm1_0_79 protocol = git repo_url = https://github.com/ESCOMP/RTM local_path = components/rtm diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 01557943..183fd491 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -66,7 +66,8 @@ module cam_comp subroutine cam_init(caseid, ctitle, model_doi_url, & initial_run_in, restart_run_in, branch_run_in, & - calendar, brnch_retain_casename, aqua_planet, & + post_assim_in, calendar, & + brnch_retain_casename, aqua_planet, & single_column, scmlat, scmlon, & eccen, obliqr, lambm0, mvelpp, & perpetual_run, perpetual_ymd, & @@ -105,6 +106,7 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & logical, intent(in) :: initial_run_in ! is inital run? logical, intent(in) :: restart_run_in ! is restart run? logical, intent(in) :: branch_run_in ! is branch run? + logical, intent(in) :: post_assim_in ! true => resume mode character(len=cs), intent(in) :: calendar ! Calendar type ! brnch_retain_casename is a flag to allow a branch to use the same ! caseid as the run being branched from. @@ -155,6 +157,7 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & initial_run_in=initial_run_in, & restart_run_in=restart_run_in, & branch_run_in=branch_run_in, & + post_assim_in=post_assim_in, & aqua_planet_in=aqua_planet, & brnch_retain_casename_in=brnch_retain_casename) @@ -452,7 +455,7 @@ end subroutine cam_run4 ! !----------------------------------------------------------------------- ! - subroutine cam_timestep_final() + subroutine cam_timestep_final(do_ncdata_check) !----------------------------------------------------------------------- ! ! Purpose: Timestep final runs at the end of each timestep @@ -461,12 +464,15 @@ subroutine cam_timestep_final() use phys_comp, only: phys_timestep_final + !Flag for whether a snapshot (ncdata) check should be run or not + logical, intent(in) :: do_ncdata_check + ! !---------------------------------------------------------- ! PHYS_TIMESTEP_FINAL Call the Physics package !---------------------------------------------------------- ! - call phys_timestep_final() + call phys_timestep_final(do_ncdata_check) end subroutine cam_timestep_final diff --git a/src/control/cam_control_mod.F90 b/src/control/cam_control_mod.F90 index 51b860b3..11057198 100644 --- a/src/control/cam_control_mod.F90 +++ b/src/control/cam_control_mod.F90 @@ -27,19 +27,21 @@ module cam_control_mod logical, protected :: initial_run ! startup mode which only requires a minimal initial file logical, protected :: restart_run ! continue a previous run; requires a restart file logical, protected :: branch_run ! branch from a previous run; requires a restart file + logical, protected :: post_assim ! We are resuming after a pause logical, protected :: adiabatic ! true => no physics logical, protected :: ideal_phys ! true => run Held-Suarez (1994) physics logical, protected :: kessler_phys ! true => run Kessler physics logical, protected :: tj2016_phys ! true => run tj2016 physics + logical, protected :: grayrad_phys ! true => run gray radiation (frierson) physics logical, protected :: simple_phys ! true => adiabatic or ideal_phys or kessler_phys - ! or tj2016 + ! or tj2016 or grayrad logical, protected :: aqua_planet ! Flag to run model in "aqua planet" mode logical, protected :: moist_physics ! true => moist physics enabled, i.e., - ! (.not. ideal_phys) .and. (.not. adiabatic) + ! (.not. ideal_phys) .and. (.not. adiabatic) logical, protected :: brnch_retain_casename ! true => branch run may use same caseid as - ! the run being branched from + ! the run being branched from real(r8), protected :: eccen ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) real(r8), protected :: obliqr ! Earth's obliquity in radians @@ -53,13 +55,15 @@ module cam_control_mod !============================================================================== subroutine cam_ctrl_init(caseid_in, ctitle_in, initial_run_in, & - restart_run_in, branch_run_in, aqua_planet_in, brnch_retain_casename_in) + restart_run_in, branch_run_in, post_assim_in, & + aqua_planet_in, brnch_retain_casename_in) character(len=cl), intent(in) :: caseid_in ! case ID character(len=cl), intent(in) :: ctitle_in ! case title logical, intent(in) :: initial_run_in ! true => inital run logical, intent(in) :: restart_run_in ! true => restart run logical, intent(in) :: branch_run_in ! true => branch run + logical, intent(in) :: post_assim_in ! true => resume mode logical, intent(in) :: aqua_planet_in ! Flag to run model in "aqua planet" mode logical, intent(in) :: brnch_retain_casename_in ! Flag to allow a branch to use the same ! caseid as the run being branched from. @@ -73,6 +77,7 @@ subroutine cam_ctrl_init(caseid_in, ctitle_in, initial_run_in, & initial_run = initial_run_in restart_run = restart_run_in branch_run = branch_run_in + post_assim = post_assim_in aqua_planet = aqua_planet_in @@ -87,6 +92,8 @@ subroutine cam_ctrl_init(caseid_in, ctitle_in, initial_run_in, & write(iulog,*) ' Restart of an earlier run' else if (branch_run) then write(iulog,*) ' Branch of an earlier run' + else if (post_assim) then + write(iulog,*) ' DART run using CAM initial mode' else write(iulog,*) ' Initial run' end if @@ -137,11 +144,12 @@ subroutine cam_ctrl_set_physics_type() suite_name = suite_names(1) adiabatic = trim(suite_name) == 'adiabatic' - ideal_phys = trim(suite_name) == 'held_suarez' + ideal_phys = trim(suite_name) == 'held_suarez_1994' kessler_phys = trim(suite_name) == 'kessler' tj2016_phys = trim(suite_name) == 'tj2016' + grayrad_phys = trim(suite_name) == 'grayrad' - simple_phys = adiabatic .or. ideal_phys .or. kessler_phys .or. tj2016_phys + simple_phys = adiabatic .or. ideal_phys .or. kessler_phys .or. tj2016_phys .or. grayrad_phys moist_physics = .not. (adiabatic .or. ideal_phys) @@ -159,6 +167,8 @@ subroutine cam_ctrl_set_physics_type() write(iulog,*) 'Run model with Kessler warm-rain physics forcing' else if (tj2016_phys) then write(iulog,*) 'Run model with Thatcher-Jablonowski (2016) physics forcing (moist Held-Suarez)' + else if (grayrad_phys) then + write(iulog,*) 'Run model with Frierson (2006) gray radiation physics' end if end if diff --git a/src/control/cam_logfile.F90 b/src/control/cam_logfile.F90 index 8c25d10c..0316297b 100644 --- a/src/control/cam_logfile.F90 +++ b/src/control/cam_logfile.F90 @@ -59,7 +59,7 @@ subroutine cam_set_log_unit(unit_num) integer, intent(in) :: unit_num - ! Change iulog to unit_num on this PE or log a waring + ! Change iulog to unit_num on this PE or log a warning ! The log unit number can be set at most once per run if (iulog_set) then write(iulog, *) 'cam_set_log_unit: Cannot change log unit during run' diff --git a/src/cpl/mct/atm_comp_mct.F90 b/src/cpl/mct/atm_comp_mct.F90 deleted file mode 100644 index 43d7df99..00000000 --- a/src/cpl/mct/atm_comp_mct.F90 +++ /dev/null @@ -1,920 +0,0 @@ -module atm_comp_mct - - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_kind_mod, only: cs=>shr_kind_cs, cl=>shr_kind_cl - use shr_file_mod, only: shr_file_getunit, shr_file_setLogUnit - use shr_file_mod, only: shr_file_setLogLevel, shr_file_getLogLevel - use shr_file_mod, only: shr_file_getLogUnit, shr_file_setIO - use shr_sys_mod, only: shr_sys_flush - use shr_flds_mod, only: shr_flds_dom_coord, shr_flds_dom_other - use seq_flds_mod, only: seq_flds_x2a_fields, seq_flds_a2x_fields - use pio, only: file_desc_t, io_desc_t, var_desc_t, pio_double - use pio, only: pio_def_dim, pio_put_att, pio_enddef - use pio, only: pio_read_darray, pio_freedecomp - use pio, only: pio_closefile, pio_write_darray, pio_def_var - use pio, only: pio_inq_varid, pio_noerr, pio_bcast_error - use pio, only: pio_internal_error, pio_seterrorhandling - use pio, only: PIO_OFFSET_KIND - use mct_mod, only: mct_aVect, mct_aVect, mct_gGrid - use mct_mod, only: mct_aVect_zero - use mct_mod, only: mct_aVect_getRList, mct_string_toChar - use mct_mod, only: mct_string, mct_string_clean - use mct_mod, only: mct_gsMap, mct_gsMap_lsize, mct_aVect_nRattr - use mct_mod, only: mct_gGrid_init, mct_gsMap_orderedPoints - use mct_mod, only: mct_gGrid_importIAttr, mct_gGrid_importRAttr - use mct_mod, only: mct_gsmap_orderedpoints, mct_gsMap_init - use seq_comm_mct, only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use seq_comm_mct, only: num_inst_atm - use seq_cdata_mod, only: seq_cdata, seq_cdata_setptrs - use seq_infodata_mod, only: seq_infodata_type - use seq_infodata_mod, only: seq_infodata_GetData, seq_infodata_PutData - use esmf, only: ESMF_Clock - use seq_timemgr_mod, only: seq_timemgr_EClockGetData - use seq_timemgr_mod, only: seq_timemgr_EClockDateInSync - use seq_timemgr_mod, only: seq_timemgr_StopAlarmIsOn - use seq_timemgr_mod, only: seq_timemgr_RestartAlarmIsOn - use atm_import_export, only: atm_import, atm_export - use cam_comp, only: cam_init, cam_run1, cam_run2, cam_run3 - use cam_comp, only: cam_run4, cam_final - use cam_instance, only: cam_instance_init, inst_suffix, inst_index - use cam_control_mod, only: cam_ctrl_set_orbit -! use radiation, only: radiation_nextsw_cday - use camsrfexch, only: cam_out_t, cam_in_t - use cam_initfiles, only: cam_initfiles_get_caseid - use cam_initfiles, only: cam_initfiles_get_restdir - use cam_abortutils, only: endrun - use filenames, only: interpret_filename_spec - use spmd_utils, only: spmd_init, masterproc, iam - use time_manager, only: get_curr_calday, advance_timestep - use time_manager, only: get_curr_date, get_nstep, get_step_size - use ioFileMod, only: cam_get_file - use perf_mod, only: t_startf, t_stopf - use cam_logfile, only: cam_set_log_unit, iulog - use cam_cpl_indices ! Temporary exception to naked use - - implicit none - private - - !-------------------------------------------------------------------------- - ! Public interfaces - !-------------------------------------------------------------------------- - - public :: atm_init_mct - public :: atm_run_mct - public :: atm_final_mct - - !-------------------------------------------------------------------------- - ! Private interfaces - !-------------------------------------------------------------------------- - - private :: atm_setgsmap_mct - private :: atm_domain_mct - private :: atm_read_srfrest_mct - private :: atm_write_srfrest_mct - - !-------------------------------------------------------------------------- - ! Private data - !-------------------------------------------------------------------------- - - type(cam_in_t), pointer :: cam_in => NULL() - type(cam_out_t), pointer :: cam_out => NULL() - - ! rsfilename_spec_cam: Filename specifier for restart surface file - character(len=cl) :: rsfilename_spec_cam - - integer, pointer :: dof(:) => NULL() ! PIO decomp 4 restarts - type(seq_infodata_type), pointer :: infodata => NULL() - - logical :: dart_mode = .false. - -!=========================================================================== -CONTAINS -!=========================================================================== - - subroutine atm_init_mct(EClock, cdata_a, x2a_a, a2x_a, NLFilename) - use physics_grid, only: get_grid_dims - - !----------------------------------------------------------------------- - ! - ! Arguments - ! - type(ESMF_Clock), intent(inout) :: EClock - type(seq_cdata), intent(inout) :: cdata_a - type(mct_aVect), intent(inout) :: x2a_a - type(mct_aVect), intent(inout) :: a2x_a - character(len=*), optional, intent(in) :: NLFilename ! Namelist - ! - ! Locals - ! - type(mct_gsMap), pointer :: gsMap_atm - type(mct_gGrid), pointer :: dom_a - integer :: ATMID - integer :: mpicom_atm - integer :: lsize - logical :: first_time = .true. - logical :: exists - integer :: shrlogunit ! save values, restore on return - integer :: shrloglev ! save values, restore on return - character(len=cs) :: start_type ! infodata start type - character(len=cl) :: caseid ! case ID - character(len=cl) :: ctitle ! case title - character(len=cl) :: model_doi_url ! DOI for CESM model run - character(len=cs) :: calendar ! Calendar type - logical :: aqua_planet ! Flag to run model in "aqua planet" mode - ! brnch_retain_casename: branch run may use same caseid as the run being branched from - logical :: brnch_retain_casename - logical :: single_column - real(r8) :: scmlat - real(r8) :: scmlon - real(r8) :: eccen - real(r8) :: obliqr - real(r8) :: lambm0 - real(r8) :: mvelpp - logical :: perpetual_run ! If in perpetual mode or not - integer :: perpetual_ymd ! Perpetual date (YYYYMMDD) - - real(r8) :: nextsw_cday ! calendar of next atm shortwave - integer :: stepno ! time step - integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step - integer :: nstep ! CAM nstep - real(r8) :: caldayp1 ! CAM calendar day for for next cam time step - integer :: start_ymd ! Start date (YYYYMMDD) - integer :: start_tod ! Start time of day (sec) - integer :: curr_ymd ! Start date (YYYYMMDD) - integer :: curr_tod ! Start time of day (sec) - integer :: stop_ymd ! Stop date (YYYYMMDD) - integer :: stop_tod ! Stop time of day (sec) - integer :: ref_ymd ! Reference date (YYYYMMDD) - integer :: ref_tod ! Reference time of day (sec) - logical :: initial_run ! startup mode which only requires a minimal initial file - logical :: restart_run ! continue a previous run; requires a restart file - logical :: branch_run ! branch from a previous run; requires a restart file - integer :: lbnum - character(cs) :: inst_name - integer :: inst_index - character(cs) :: inst_suffix - integer :: hdim1_d, hdim2_d ! grid dimensions - character(len=*), parameter :: subname = 'atm_init_mct' - ! data structure, If 1D data structure, then hdim2_d == 1. - !----------------------------------------------------------------------- - ! - ! Determine cdata points - ! - call seq_cdata_setptrs(cdata_a, ID=ATMID, mpicom=mpicom_atm, & - gsMap=gsMap_atm, dom=dom_a, infodata=infodata, & - post_assimilation=dart_mode) - - if (first_time) then - - ! determine instance information - inst_name = seq_comm_name(ATMID) - inst_index = seq_comm_inst(ATMID) - inst_suffix = seq_comm_suffix(ATMID) - call cam_instance_init(ATMID, inst_name, inst_index, inst_suffix) - - ! Set filename specifier for restart surface file - ! (%c=caseid, $y=year, $m=month, $d=day, $s=seconds in day) - rsfilename_spec_cam = '%c.cam'//trim(inst_suffix)//'.rs.%y-%m-%d-%s.nc' - - ! Determine attribute vector indices - call cam_cpl_indices_set() - - ! Initialize atm use of MPI - call spmd_init(mpicom_atm) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum = 1 - call memmon_dump_fort('memmon.out', 'atm_init_mct:start::', lbnum) - end if -#endif - - ! Redirect share output to cam log - - if (masterproc) then - inquire(file='atm_modelio.nml'//trim(inst_suffix), exist=exists) - if (exists) then - call cam_set_log_unit(shr_file_getUnit()) - call shr_file_setIO('atm_modelio.nml'//trim(inst_suffix), iulog) - end if - - write(iulog, *) "CAM atmosphere model initialization" - if (dart_mode) then - write(iulog, *) "***DART mode ON***" - end if - end if - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - ! - ! Get data from infodata object - ! - ! TODO: the perpetual_run does not work for nuopc since nextsw_cday is - ! not being set correctly - ! FOR now will debug without support for perpetual until this - ! can be resolved - perpetual_run = .false. - - call seq_infodata_GetData(infodata, & - case_name=caseid, case_desc=ctitle, & - model_doi_url=model_doi_url, & - start_type=start_type, aqua_planet=aqua_planet, & - brnch_retain_casename=brnch_retain_casename, & - single_column=single_column, scmlat=scmlat, scmlon=scmlon, & - orb_eccen=eccen, orb_mvelpp=mvelpp, orb_lambm0=lambm0, & - orb_obliqr=obliqr, & - perpetual=perpetual_run, perpetual_ymd=perpetual_ymd) - - ! set the run type - initial_run = .false. - restart_run = .false. - branch_run = .false. - if (trim(start_type) == 'startup') then - initial_run = .true. - else if (trim(start_type) == 'continue') then - restart_run = .true. - else if (trim(start_type) == 'branch') then - branch_run = .true. - else - call endrun(subname//': ERROR: unknown start_type, '// trim(start_type)) - end if - - ! DART always starts up as an initial run. - if (dart_mode) then - initial_run = .true. - restart_run = .false. - branch_run = .false. - end if - - ! Extract info from the eclock passed from coupler to initialize - ! the local time manager - - call seq_timemgr_EClockGetData(Eclock, & - start_ymd=start_ymd, start_tod=start_tod, & - ref_ymd=ref_ymd, ref_tod=ref_tod, & - stop_ymd=stop_ymd, stop_tod=stop_tod, & - curr_ymd=curr_ymd, curr_tod=curr_tod, & - dtime=dtime, calendar=calendar) - - ! Initialize CAM, allocate cam_in and cam_out and determine - ! atm decomposition (needed to initialize gsmap) - ! for an initial run, cam_in and cam_out are allocated in cam_init - ! for a restart/branch run, cam_in and cam_out are allocated in restart - - call cam_init( & - caseid=caseid, & - ctitle=ctitle, & - model_doi_url=model_doi_url, & - initial_run_in=initial_run, & - restart_run_in=restart_run, & - branch_run_in=branch_run, & - calendar=calendar, & - brnch_retain_casename=brnch_retain_casename, & - aqua_planet=aqua_planet, & - single_column=single_column, & - scmlat=scmlat, & - scmlon=scmlon, & - eccen=eccen, & - obliqr=obliqr, & - lambm0=lambm0, & - mvelpp=mvelpp, & - perpetual_run=perpetual_run, & - perpetual_ymd=perpetual_ymd, & - dtime=dtime, & - start_ymd=start_ymd, & - start_tod=start_tod, & - ref_ymd=ref_ymd, & - ref_tod=ref_tod, & - stop_ymd=stop_ymd, & - stop_tod=stop_tod, & - curr_ymd=curr_ymd, & - curr_tod=curr_tod, & - cam_out=cam_out, & - cam_in=cam_in) - ! - ! Initialize MCT gsMap, domain and attribute vectors (and dof) - ! - call atm_SetgsMap_mct(mpicom_atm, ATMID, gsMap_atm) - lsize = mct_gsMap_lsize(gsMap_atm, mpicom_atm) - - ! Set dof (module variable, needed for pio for restarts) - call mct_gsmap_orderedpoints(gsmap_atm, iam, dof) - ! - ! Initialize MCT domain - ! - call atm_domain_mct(lsize, gsMap_atm, dom_a) - ! - ! Initialize MCT attribute vectors - ! - call mct_aVect_init(a2x_a, rList=seq_flds_a2x_fields, lsize=lsize) - call mct_aVect_zero(a2x_a) - - call mct_aVect_init(x2a_a, rList=seq_flds_x2a_fields, lsize=lsize) - call mct_aVect_zero(x2a_a) - ! - ! Create initial atm export state - ! - call atm_export(cam_out, a2x_a%rattr) - ! - ! Set flag to specify that an extra albedo calculation is - ! to be done (i.e. specify active) - ! - call seq_infodata_PutData(infodata, atm_prognostic=.true.) - call get_grid_dims(hdim1_d, hdim2_d) - call seq_infodata_PutData(infodata, atm_nx=hdim1_d, atm_ny=hdim2_d) - - ! Set flag to indicate that CAM will provide carbon and dust - ! deposition fluxes. - ! This is now hardcoded to .true. since the ability of CICE to - ! read these fluxes from a file has been removed. - call seq_infodata_PutData(infodata, atm_aero=.true.) - - ! - ! Set time step of radiation computation as the current calday - ! This will only be used on the first timestep of an initial run - ! - if (initial_run) then - nextsw_cday = get_curr_calday() - call seq_infodata_PutData(infodata, nextsw_cday=nextsw_cday) - end if - - ! End redirection of share output to cam log - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - - first_time = .false. - - else - - ! For initial run, run cam radiation/clouds and return - ! For restart run, read restart x2a_a - ! Note - a2x_a is computed upon the completion of the previous run - cam_run1 is called - ! only for the purposes of finishing the flux averaged calculation to compute a2x_a - ! Note - cam_run1 is called on restart only to have cam internal state consistent with the - ! a2x_a state sent to the coupler - - ! Redirect share output to cam log - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - call seq_timemgr_EClockGetData(EClock, StepNo=StepNo) - if (StepNo == 0) then - call atm_import(x2a_a%rattr, cam_in) - call cam_run1 (cam_in, cam_out) - call atm_export(cam_out, a2x_a%rattr) - else - call atm_read_srfrest_mct(EClock, x2a_a, a2x_a) - call atm_import(x2a_a%rattr, cam_in, restart_init=.true.) - call cam_run1 (cam_in, cam_out) - end if - - ! Compute time of next radiation computation, like in run method - ! for exact restart - call seq_timemgr_EClockGetData(Eclock, dtime=atm_cpl_dt) - dtime = get_step_size() - nstep = get_nstep() -!!XXgoldyXX: v figure out what to do with radiation -#if 0 - if (nstep < 1 .or. dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 - else - call endrun(subname//': dtime must be less than or equal to atm_cpl_dt') - end if -#endif -!!XXgoldyXX: ^ figure out what to do with radiation - call seq_infodata_PutData(infodata, nextsw_cday=nextsw_cday) - - ! End redirection of share output to cam log - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - - end if - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out', 'atm_init_mct:end::', lbnum) - call memmon_reset_addr() - endif -#endif - - call shr_sys_flush(iulog) - - end subroutine atm_init_mct - - !=========================================================================== - - subroutine atm_run_mct(EClock, cdata_a, x2a_a, a2x_a) - - !----------------------------------------------------------------------- - ! - ! Arguments - ! - type(ESMF_Clock), intent(inout) :: EClock - type(seq_cdata), intent(inout) :: cdata_a - type(mct_aVect), intent(inout) :: x2a_a - type(mct_aVect), intent(inout) :: a2x_a - ! - ! Local variables - ! - integer :: shrlogunit, shrloglev ! save values, restore on exit - - real(r8) :: eccen - real(r8) :: obliqr - real(r8) :: lambm0 - real(r8) :: mvelpp - - logical :: dosend ! true => send data back to driver - integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step - 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 ! CAM current date (YYYYMMDD) - integer :: yr ! CAM current year - integer :: mon ! CAM current month - integer :: day ! CAM current day - integer :: tod ! CAM current time of day (sec) - - real(r8):: caldayp1 ! CAM calendar day for for next cam time step - real(r8):: nextsw_cday ! calendar of next atm shortwave - logical :: rstwr ! .true. ==> write restart file before returning - logical :: nlend ! Flag signaling last time-step - logical :: rstwr_sync ! .true. ==> write restart file before returning - logical :: nlend_sync ! Flag signaling last time-step - logical :: first_time = .true. - integer :: lbnum - character(len=*), parameter :: subname="atm_run_mct" - !----------------------------------------------------------------------- - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out', SubName //':start::', lbnum) - endif -#endif - - ! Redirect share output to cam log - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - ! Note that sync clock time should match cam time at end of - ! time step/loop not beginning - call seq_timemgr_EClockGetData(EClock, curr_ymd=ymd_sync, & - curr_tod=tod_sync, curr_yr=yr_sync, curr_mon=mon_sync, & - curr_day=day_sync) - - nlend_sync = seq_timemgr_StopAlarmIsOn(EClock) - rstwr_sync = seq_timemgr_RestartAlarmIsOn(EClock) - - ! load orbital parameters - call seq_infodata_GetData(infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & - orb_lambm0=lambm0, orb_obliqr=obliqr) - call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) - - ! Map input from mct to cam data structure - - call t_startf ('CAM_import') - call atm_import(x2a_a%rattr, cam_in) - call t_stopf ('CAM_import') - - ! Cycle over all time steps in the atm 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 - call get_curr_date(yr, mon, day, tod) - ymd = yr*10000 + mon*100 + day - tod = tod - dosend = (seq_timemgr_EClockDateInSync(EClock, ymd, tod)) - - ! Determine if time to write cam restart and stop - - rstwr = .false. - if (rstwr_sync .and. dosend) rstwr = .true. - nlend = .false. - if (nlend_sync .and. dosend) nlend = .true. - - ! Run CAM (run2, run3, run4) - - call t_startf ('CAM_run2') - call cam_run2(cam_out, cam_in) - call t_stopf ('CAM_run2') - - call t_startf ('CAM_run3') - call cam_run3(cam_out) - call t_stopf ('CAM_run3') - - call t_startf ('CAM_run4') - call cam_run4(cam_out, cam_in, rstwr, nlend, yr_spec=yr_sync, & - mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) - call t_stopf ('CAM_run4') - - ! Advance cam time step - - call t_startf ('CAM_adv_timestep') - call advance_timestep() - call t_stopf ('CAM_adv_timestep') - - ! Run cam radiation/clouds (run1) - - call t_startf ('CAM_run1') - call cam_run1 (cam_in, cam_out) - call t_stopf ('CAM_run1') - - ! Map output from cam to mct data structures - - call t_startf ('CAM_export') - call atm_export(cam_out, a2x_a%rattr) - call t_stopf ('CAM_export') - - end do - - ! Get time of next radiation calculation - albedos will need to be - ! calculated by each surface model at this time - - call seq_timemgr_EClockGetData(Eclock, dtime=atm_cpl_dt) - dtime = get_step_size() -!!XXgoldyXX: v figure out what to do with radiation -#if 0 - if (dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 - else - call endrun(subname//': dtime must be less than or equal to atm_cpl_dt') - end if -#endif -!!XXgoldyXX: ^ figure out what to do with radiation - - call seq_infodata_PutData(infodata, nextsw_cday=nextsw_cday) - - ! Write merged surface data restart file if appropriate - - if (rstwr_sync) then - call atm_write_srfrest_mct(x2a_a, a2x_a, yr_spec=yr_sync, & - mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) - end if - - ! Check for consistency of internal cam clock with master sync clock - - dtime = get_step_size() - 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, *)' cam ymd=', ymd, ' cam tod= ', tod - write(iulog, *)'sync ymd=', ymd_sync, ' sync tod= ', tod_sync - call endrun(subname//': CAM clock is not in sync with master Sync Clock') - end if - - ! End redirection of share output to cam log - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out', SubName //':end::', lbnum) - call memmon_reset_addr() - endif -#endif - - end subroutine atm_run_mct - - !=========================================================================== - - subroutine atm_final_mct(EClock, cdata_a, x2a_a, a2x_a) - - type(ESMF_Clock), intent(inout) :: EClock - type(seq_cdata), intent(inout) :: cdata_a - type(mct_aVect), intent(inout) :: x2a_a - type(mct_aVect), intent(inout) :: a2x_a - - call cam_final(cam_out, cam_in) - - end subroutine atm_final_mct - - !=========================================================================== - - subroutine atm_SetgsMap_mct(mpicom_atm, ATMID, GSMap_atm) - use physics_grid, only: columns_on_task, num_global_phys_cols - use physics_grid, only: global_index_p - - !------------------------------------------------------------------- - ! - ! Arguments - ! - integer, intent(in) :: mpicom_atm - integer, intent(in) :: ATMID - type(mct_gsMap), intent(out) :: GSMap_atm - ! - ! Local variables - ! - integer, allocatable :: gindex(:) - integer :: index - integer :: ierr ! error status - !------------------------------------------------------------------- - - ! Build the atmosphere grid numbering for MCT - ! Determine global seg map - allocate(gindex(columns_on_task)) - - do index = 1, columns_on_task - gindex(index) = global_index_p(index) - end do - - call mct_gsMap_init(gsMap_atm, gindex, mpicom_atm, ATMID, & - columns_on_task, num_global_phys_cols) - - deallocate(gindex) - - end subroutine atm_SetgsMap_mct - - !=========================================================================== - - subroutine atm_domain_mct(lsize, gsMap_a, dom_a) - use physics_grid, only: columns_on_task - use physics_grid, only: get_dlat_p, get_dlon_p, get_area_p - - !------------------------------------------------------------------- - ! - ! Arguments - ! - integer, intent(in) :: lsize - type(mct_gsMap), intent(in) :: gsMap_a - type(mct_ggrid), intent(inout) :: dom_a - ! - ! Local Variables - ! - integer :: index - real(r8), pointer :: data(:) ! temporary - integer, pointer :: idata(:) ! temporary - !------------------------------------------------------------------- - ! - ! Initialize mct atm domain - ! - call mct_gGrid_init(GGrid=dom_a, CoordChars=trim(shr_flds_dom_coord), & - OtherChars=trim(shr_flds_dom_other), lsize=lsize) - ! - ! Allocate memory - ! - allocate(data(lsize)) - ! - ! Initialize attribute vector with special value - ! - call mct_gsMap_orderedPoints(gsMap_a, iam, idata) - call mct_gGrid_importIAttr(dom_a, 'GlobGridNum', idata, lsize) - ! - ! Determine domain - ! Initialize attribute vector with special value - ! - data(:) = -9999.0_R8 - call mct_gGrid_importRAttr(dom_a, "lat", data, lsize) - call mct_gGrid_importRAttr(dom_a, "lon", data, lsize) - call mct_gGrid_importRAttr(dom_a, "area", data, lsize) - call mct_gGrid_importRAttr(dom_a, "aream", data, lsize) - data(:) = 0.0_R8 - call mct_gGrid_importRAttr(dom_a, "mask", data, lsize) - data(:) = 1.0_R8 - call mct_gGrid_importRAttr(dom_a, "frac", data, lsize) - ! - ! Fill in correct values for domain components - ! - do index = 1, columns_on_task - data(index) = get_dlat_p(index) - end do - call mct_gGrid_importRAttr(dom_a, "lat", data, lsize) - - do index = 1, columns_on_task - data(index) = get_dlon_p(index) - end do - call mct_gGrid_importRAttr(dom_a, "lon", data, lsize) - - do index = 1, columns_on_task - data(index) = get_area_p(index) - end do - call mct_gGrid_importRAttr(dom_a, "area", data, lsize) - - data(1:columns_on_task) = 1._r8 ! mask - call mct_gGrid_importRAttr(dom_a, "mask", data, lsize) - deallocate(data) - - end subroutine atm_domain_mct - - !=========================================================================== - - subroutine atm_read_srfrest_mct(EClock, x2a_a, a2x_a) - use physics_grid, only: columns_on_task, ngcols => num_global_phys_cols - - !----------------------------------------------------------------------- - use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile - use cam_pio_utils, only: cam_pio_newdecomp - ! - ! Arguments - ! - type(ESMF_Clock), intent(inout) :: EClock - type(mct_aVect), intent(inout) :: x2a_a - type(mct_aVect), intent(inout) :: a2x_a - ! - ! Local variables - ! - character(len=cl) :: fname_srf_cam ! surface restart filename - character(len=cl) :: pname_srf_cam ! surface restart full pathname - integer :: rcode ! return error code - integer :: yr_spec ! Current year - integer :: mon_spec ! Current month - integer :: day_spec ! Current day - integer :: sec_spec ! Current time of day (sec) - integer :: nf_x2a, nf_a2x, k - integer :: err_handling - real(r8), allocatable :: tmp(:) - type(file_desc_t) :: file - type(io_desc_t), pointer :: iodesc - type(var_desc_t) :: varid - character(CL) :: itemc ! string converted to char - type(mct_string) :: mstring ! mct char type - !----------------------------------------------------------------------- - - nullify(iodesc) - ! Determine and open surface restart dataset - - call seq_timemgr_EClockGetData(EClock, curr_yr=yr_spec, & - curr_mon=mon_spec, curr_day=day_spec, curr_tod=sec_spec) - - ! Determine and open surface restart dataset - - if (dart_mode) then - fname_srf_cam = interpret_filename_spec(rsfilename_spec_cam, & - yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, & - sec_spec=sec_spec) - pname_srf_cam = fname_srf_cam - else - fname_srf_cam = interpret_filename_spec(rsfilename_spec_cam, & - case=cam_initfiles_get_caseid(), yr_spec=yr_spec, & - mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec) - pname_srf_cam = trim(cam_initfiles_get_restdir())//fname_srf_cam - end if - call cam_get_file(pname_srf_cam, fname_srf_cam) - - call cam_pio_openfile(File, fname_srf_cam, 0) - allocate(iodesc) - call cam_pio_newdecomp(iodesc, (/ ngcols /), int(dof, PIO_OFFSET_KIND), & - pio_double) - allocate(tmp(size(dof))) - - nf_x2a = mct_aVect_nRattr(x2a_a) - do k = 1, nf_x2a - call mct_aVect_getRList(mstring, k, x2a_a) - itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) - - call pio_seterrorhandling(File, pio_bcast_error, & - oldmethod=err_handling) - rcode = pio_inq_varid(File, 'x2a_'//trim(itemc), varid) - if (rcode == pio_noerr) then - call pio_read_darray(File, varid, iodesc, tmp, rcode) - x2a_a%rattr(k, :) = tmp(:) - else - if (masterproc) then - write(iulog, *) 'srfrest warning: field ', trim(itemc), & - ' is not on restart file' - write(iulog, *) 'Setting to 0 for backwards compatibility' - end if - x2a_a%rattr(k,:) = 0._r8 - end if - call pio_seterrorhandling(File, err_handling) - end do - - nf_a2x = mct_aVect_nRattr(a2x_a) - do k = 1, nf_a2x - call mct_aVect_getRList(mstring,k,a2x_a) - itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) - - rcode = pio_inq_varid(File,'a2x_'//trim(itemc), varid) - call pio_read_darray(File, varid, iodesc, tmp, rcode) - a2x_a%rattr(k,:) = tmp(:) - end do - - call pio_freedecomp(File, iodesc) - deallocate(iodesc) - call cam_pio_closefile(File) - deallocate(tmp) - - end subroutine atm_read_srfrest_mct - - !=========================================================================== - - subroutine atm_write_srfrest_mct(x2a_a, a2x_a, & - yr_spec, mon_spec, day_spec, sec_spec) - - !----------------------------------------------------------------------- - use physics_grid, only: ngcols => num_global_phys_cols - use cam_pio_utils, only: cam_pio_createfile, cam_pio_closefile - use cam_pio_utils, only: cam_pio_newdecomp -!!XXgoldyXX: v import history -! use cam_history_support, only: fillvalue -real(r8) :: fillvalue = 9.87e36_r8 -!!XXgoldyXX: ^ import history - ! - ! Arguments - ! - type(mct_aVect), intent(in) :: x2a_a - type(mct_aVect), intent(in) :: a2x_a - integer, intent(in) :: yr_spec ! Simulation year - integer, intent(in) :: mon_spec ! Simulation month - integer, intent(in) :: day_spec ! Simulation day - integer, intent(in) :: sec_spec ! Seconds into current sim day - ! - ! Local variables - ! - character(len=cl) :: fname_srf_cam ! surface restart filename - integer :: rcode ! return error code - integer :: nf_x2a, nf_a2x, dimid(1), k - type(file_desc_t) :: file - type(var_desc_t), pointer :: varid_x2a(:), varid_a2x(:) - type(io_desc_t), pointer :: iodesc - character(CL) :: itemc ! string converted to char - type(mct_string) :: mstring ! mct char type - !----------------------------------------------------------------------- - - nullify(iodesc) - fname_srf_cam = interpret_filename_spec(rsfilename_spec_cam, & - yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, & - sec_spec= sec_spec) - - call cam_pio_createfile(File, fname_srf_cam, 0) - allocate(iodesc) - call cam_pio_newdecomp(iodesc, (/ ngcols /), int(dof, PIO_OFFSET_KIND), & - pio_double) - - nf_x2a = mct_aVect_nRattr(x2a_a) - allocate(varid_x2a(nf_x2a)) - - rcode = pio_def_dim(File, 'x2a_nx', ngcols, dimid(1)) - do k = 1, nf_x2a - call mct_aVect_getRList(mstring,k,x2a_a) - itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) - rcode = pio_def_var(File, 'x2a_'//trim(itemc), PIO_DOUBLE, dimid, & - varid_x2a(k)) - rcode = pio_put_att(File, varid_x2a(k), "_fillvalue", fillvalue) - end do - - nf_a2x = mct_aVect_nRattr(a2x_a) - allocate(varid_a2x(nf_a2x)) - - rcode = pio_def_dim(File, 'a2x_nx', ngcols, dimid(1)) - do k = 1, nf_a2x - call mct_aVect_getRList(mstring,k, a2x_a) - itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) - rcode = PIO_def_var(File, 'a2x_'//trim(itemc), PIO_DOUBLE, dimid, & - varid_a2x(k)) - rcode = PIO_put_att(File, varid_a2x(k), "_fillvalue", fillvalue) - end do - - rcode = pio_enddef(File) ! error return code, might be enddef already - - do k = 1, nf_x2a - call pio_write_darray(File, varid_x2a(k), iodesc, x2a_a%rattr(k,:), & - rcode) - end do - - do k = 1, nf_a2x - call pio_write_darray(File, varid_a2x(k), iodesc, a2x_a%rattr(k,:), & - rcode) - end do - - deallocate(varid_x2a, varid_a2x) - - call pio_freedecomp(File, iodesc) - deallocate(iodesc) - call cam_pio_closefile(file) - - end subroutine atm_write_srfrest_mct - -end module atm_comp_mct diff --git a/src/cpl/mct/atm_import_export.F90 b/src/cpl/mct/atm_import_export.F90 deleted file mode 100644 index c58d3aba..00000000 --- a/src/cpl/mct/atm_import_export.F90 +++ /dev/null @@ -1,397 +0,0 @@ -module atm_import_export - - use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl - use time_manager, only: get_nstep - use cam_logfile, only: iulog - use spmd_utils, only: masterproc - - implicit none - private - save - - ! Public interfaces - public :: atm_import - public :: atm_export - - ! Private module data - integer, parameter :: debug = 0 ! internal debug level - character(len=*), parameter :: modname = '(cam_import_export) ' - character(len=*), parameter :: F01 = "("//modname//",a, i8,2x,i8,2x,d21.14)" - -!============================================================================ -CONTAINS -!============================================================================ - - subroutine atm_import(x2a, cam_in, restart_init) - - !----------------------------------------------------------------------- - use cam_cpl_indices ! Temporary exception to naked use - use camsrfexch, only: cam_in_t - use shr_const_mod, only: shr_const_stebol - use shr_sys_mod, only: shr_sys_abort - use time_manager, only: is_first_step - use physics_grid, only: columns_on_task -!!XXgoldyXX: v figure out what to do with constituents -! use seq_drydep_mod, only: n_drydep -! use shr_fire_emis_mod, only: shr_fire_emis_mechcomps_n -! use co2_cycle, only: c_i, co2_readFlux_ocn, co2_readFlux_fuel -! use co2_cycle, only: co2_transport, co2_time_interp_ocn -! use co2_cycle, only: co2_time_interp_fuel -! use co2_cycle, only: data_flux_ocn, data_flux_fuel -! use physconst, only: mwco2 -!!XXgoldyXX: ^ figure out what to do with constituents - ! - ! Arguments - ! - real(r8), intent(in) :: x2a(:,:) - type(cam_in_t), intent(inout) :: cam_in - logical, optional, intent(in) :: restart_init - ! - ! Local variables - ! - integer :: index - logical, save :: first_time = .true. - integer, parameter :: ndst = 2 - integer, target :: spc_ndx(ndst) - integer, pointer :: dst_a5_ndx, dst_a7_ndx - integer, pointer :: dst_a1_ndx, dst_a3_ndx - integer :: nstep - logical :: overwrite_flds - !----------------------------------------------------------------------- - - overwrite_flds = .true. - ! don't overwrite fields if invoked during the initialization phase - ! of a 'continue' or 'branch' run type with data from .rs file - if (present(restart_init)) then - overwrite_flds = .not. restart_init - end if - -!!XXgoldyXX: v figure out what to do with constituents -#if 0 - ! CESM sign convention is that fluxes are positive downward - do index = 1, columns_on_task - if (overwrite_flds) then - cam_in%wsx(index) = -x2a(index_x2a_Faxx_taux, index) - cam_in%wsy(index) = -x2a(index_x2a_Faxx_tauy, index) - cam_in%shf(index) = -x2a(index_x2a_Faxx_sen, index) - cam_in%cflx(index,1) = -x2a(index_x2a_Faxx_evap, index) - end if - cam_in%lhf(index) = -x2a(index_x2a_Faxx_lat, index) - cam_in%lwup(index) = -x2a(index_x2a_Faxx_lwup, index) - cam_in%asdir(index) = x2a(index_x2a_Sx_avsdr, index) - cam_in%aldir(index) = x2a(index_x2a_Sx_anidr, index) - cam_in%asdif(index) = x2a(index_x2a_Sx_avsdf, index) - cam_in%aldif(index) = x2a(index_x2a_Sx_anidf, index) - cam_in%ts(index) = x2a(index_x2a_Sx_t, index) - cam_in%sst(index) = x2a(index_x2a_So_t, index) - cam_in%snowhland(index) = x2a(index_x2a_Sl_snowh, index) - cam_in%snowhice(index) = x2a(index_x2a_Si_snowh, index) - cam_in%tref(index) = x2a(index_x2a_Sx_tref, index) - cam_in%qref(index) = x2a(index_x2a_Sx_qref, index) - cam_in%u10(index) = x2a(index_x2a_Sx_u10, index) - cam_in%icefrac(index) = x2a(index_x2a_Sf_ifrac, index) - cam_in%ocnfrac(index) = x2a(index_x2a_Sf_ofrac, index) - cam_in%landfrac(index) = x2a(index_x2a_Sf_lfrac, index) - - if ( associated(cam_in%ram1) ) & - cam_in%ram1(index) = x2a(index_x2a_Sl_ram1, index) - if ( associated(cam_in%fv) ) & - cam_in%fv(index) = x2a(index_x2a_Sl_fv, index) - if ( associated(cam_in%soilw) ) & - cam_in%soilw(index) = x2a(index_x2a_Sl_soilw, index) - if ( associated(cam_in%dstflx) ) then - cam_in%dstflx(index,1) = x2a(index_x2a_Fall_flxdst1, index) - cam_in%dstflx(index,2) = x2a(index_x2a_Fall_flxdst2, index) - cam_in%dstflx(index,3) = x2a(index_x2a_Fall_flxdst3, index) - cam_in%dstflx(index,4) = x2a(index_x2a_Fall_flxdst4, index) - endif - if ( associated(cam_in%meganflx) ) then - cam_in%meganflx(i,1:shr_megan_mechcomps_n) = & - x2a(index_x2a_Fall_flxvoc:index_x2a_Fall_flxvoc+shr_megan_mechcomps_n-1, index) - endif - - ! Fire emission fluxes - if ( associated(cam_in%fireflx) .and. associated(cam_in%fireztop) ) then - cam_in%fireflx(i,:shr_fire_emis_mechcomps_n) = & - x2a(index_x2a_Fall_flxfire:index_x2a_Fall_flxfire+shr_fire_emis_mechcomps_n-1, index) - cam_in%fireztop(index) = x2a(index_x2a_Sl_ztopfire, index) - endif - - ! dry dep velocities - if ( index_x2a_Sl_ddvel/= 0 .and. n_drydep>0 ) then - cam_in%depvel(index,:n_drydep) = & - x2a(index_x2a_Sl_ddvel:index_x2a_Sl_ddvel+n_drydep-1, index) - endif - ! - ! fields needed to calculate water isotopes to ocean evaporation processes - ! - cam_in%ustar(index) = x2a(index_x2a_So_ustar,index) - cam_in%re(index) = x2a(index_x2a_So_re,index) - cam_in%ssq(index) = x2a(index_x2a_So_ssq,index) - ! - ! bgc scenarios - ! - if (index_x2a_Fall_fco2_lnd /= 0) then - cam_in%fco2_lnd(index) = -x2a(index_x2a_Fall_fco2_lnd,index) - end if - if (index_x2a_Faoo_fco2_ocn /= 0) then - cam_in%fco2_ocn(index) = -x2a(index_x2a_Faoo_fco2_ocn,index) - end if - if (index_x2a_Faoo_fdms_ocn /= 0) then - cam_in%fdms(index) = -x2a(index_x2a_Faoo_fdms_ocn,index) - end if - end do - - ! Get total co2 flux from components, - ! Note - co2_transport determines if cam_in%cflx(i,c_i(1:4)) is - ! allocated - if (co2_transport().and.overwrite_flds) then - - ! Interpolate in time for flux data read in - if (co2_readFlux_ocn) then - call co2_time_interp_ocn - end if - if (co2_readFlux_fuel) then - call co2_time_interp_fuel - end if - - ! from ocn : data read in or from coupler or zero - ! from fuel: data read in or zero - ! from lnd : through coupler or zero - do c = begchunk,endchunk - ncols = get_ncols_p(c) - do i = 1,ncols - - ! all co2 fluxes in unit kgCO2/m2/s ! co2 flux from ocn - if (index_x2a_Faoo_fco2_ocn /= 0) then - cam_in%cflx(i,c_i(1)) = cam_in%fco2_ocn(index) - else if (co2_readFlux_ocn) then - ! convert from molesCO2/m2/s to kgCO2/m2/s - cam_in%cflx(i,c_i(1)) = & - -data_flux_ocn%co2flx(i,c)*(1._r8- cam_in%landfrac(index)) & - *mwco2*1.0e-3_r8 - else - cam_in%cflx(i,c_i(1)) = 0._r8 - end if - - ! co2 flux from fossil fuel - if (co2_readFlux_fuel) then - cam_in%cflx(i,c_i(2)) = data_flux_fuel%co2flx(i,c) - else - cam_in%cflx(i,c_i(2)) = 0._r8 - end if - - ! co2 flux from land (cpl already multiplies flux by land fraction) - if (index_x2a_Fall_fco2_lnd /= 0) then - cam_in%cflx(i,c_i(3)) = cam_in%fco2_lnd(index) - else - cam_in%cflx(i,c_i(3)) = 0._r8 - end if - - ! merged co2 flux - cam_in%cflx(i,c_i(4)) = cam_in%cflx(i,c_i(1)) + & - cam_in%cflx(i,c_i(2)) + & - cam_in%cflx(i,c_i(3)) - end do - end do - end if - ! - ! if first step, determine longwave up flux from the surface temperature - ! - if (first_time) then - if (is_first_step()) then - do c = begchunk, endchunk - ncols = get_ncols_p(c) - do i = 1,ncols - cam_in%lwup(index) = shr_const_stebol*(cam_in%ts(index)**4) - end do - end do - end if - first_time = .false. - end if - - !----------------------------------------------------------------- - ! Debug output - !----------------------------------------------------------------- - - if (debug > 0 .and. masterproc) then - nstep = get_nstep() - ig = 1 - do c = begchunk, endchunk - ncols = get_ncols_p(c) - do i = 1,ncols - write(iulog,F01)'import: nstep, ig, Faxx_tauy = ',nstep,ig,x2a(index_x2a_Faxx_tauy,ig) - write(iulog,F01)'import: nstep, ig, Faxx_taux = ',nstep,ig,x2a(index_x2a_Faxx_taux,ig) - write(iulog,F01)'import: nstep, ig, Faxx_shf = ',nstep,ig,x2a(index_x2a_Faxx_sen,ig) - write(iulog,F01)'import: nstep, ig, Faxx_lhf = ',nstep,ig,x2a(index_x2a_Faxx_lat,ig) - write(iulog,F01)'import: nstep, ig, Sx_asdir = ',nstep,ig,x2a(index_x2a_Sx_avsdr,ig) - write(iulog,F01)'import: nstep, ig, Sx_aldir = ',nstep,ig,x2a(index_x2a_Sx_anidr,ig) - write(iulog,F01)'import: nstep, ig, Sx_asdif = ',nstep,ig,x2a(index_x2a_Sx_avsdf,ig) - write(iulog,F01)'import: nstep, ig, Sx_aldif = ',nstep,ig,x2a(index_x2a_Sx_anidf,ig) - write(iulog,F01)'import: nstep, ig, Sx_t = ',nstep,ig,x2a(index_x2a_Sx_t,ig) - write(iulog,F01)'import: nstep, ig, Sl_snowh = ',nstep,ig,x2a(index_x2a_Sl_snowh,ig) - write(iulog,F01)'import: nstep, ig, Si_snowh = ',nstep,ig,x2a(index_x2a_Si_snowh,ig) - write(iulog,F01)'import: nstep, ig, Sf_ifrac = ',nstep,ig,x2a(index_x2a_Sf_ifrac,ig) - write(iulog,F01)'import: nstep, ig, Sf_ofrac = ',nstep,ig,x2a(index_x2a_Sf_ofrac,ig) - write(iulog,F01)'import: nstep, ig, Sf_lfrac = ',nstep,ig,x2a(index_x2a_Sf_lfrac,ig) - if (.not. first_time .and. .not. is_first_step()) then - write(iulog,F01)'import: nstep, ig, Faxa_lwup = ',nstep,ig,x2a(index_x2a_Faxx_lwup, ig) - else - write(iulog,F01)'import: nstep, ig, Faxa_lwup = ',nstep,ig,cam_in%lwup(index) - end if - ig = ig + 1 - end do - end do - end if -#endif -!!XXgoldyXX: ^ figure out what to do with constituents - - end subroutine atm_import - - !============================================================================ - - subroutine atm_export(cam_out, a2x) - - !------------------------------------------------------------------- - use camsrfexch, only: cam_out_t - use physics_grid, only: columns_on_task - use cam_cpl_indices ! Temporary exception to naked use - ! - ! Arguments - ! - type(cam_out_t), intent(in) :: cam_out - real(r8), intent(inout) :: a2x(:,:) - ! - ! Local variables - ! - integer :: avsize, avnat - integer :: index - integer :: nstep - !----------------------------------------------------------------------- - - ! Copy from component arrays into chunk array data structure - ! Rearrange data from chunk structure into lat-lon buffer and subsequently - ! create attribute vector - -!!XXgoldyXX: v figure out what to do with constituents -#if 0 - do index = 1, columns_on_task - a2x(index_a2x_Sa_pslv,ig) = cam_out%psl(i) - a2x(index_a2x_Sa_z,ig) = cam_out%zbot(i) - a2x(index_a2x_Sa_topo,ig) = cam_out%topo(i) - a2x(index_a2x_Sa_u,ig) = cam_out%ubot(i) - a2x(index_a2x_Sa_v,ig) = cam_out%vbot(i) - a2x(index_a2x_Sa_tbot,ig) = cam_out%tbot(i) - a2x(index_a2x_Sa_ptem,ig) = cam_out%thbot(i) - a2x(index_a2x_Sa_pbot,ig) = cam_out%pbot(i) - a2x(index_a2x_Sa_shum,ig) = cam_out%qbot(i,1) - a2x(index_a2x_Sa_dens,ig) = cam_out%rho(i) - a2x(index_a2x_Faxa_swnet,ig) = cam_out%netsw(i) - a2x(index_a2x_Faxa_lwdn,ig) = cam_out%flwds(i) - a2x(index_a2x_Faxa_rainc,ig) = (cam_out%precc(i)-cam_out%precsc(i))*1000._r8 - a2x(index_a2x_Faxa_rainl,ig) = (cam_out%precl(i)-cam_out%precsl(i))*1000._r8 - a2x(index_a2x_Faxa_snowc,ig) = cam_out%precsc(i)*1000._r8 - a2x(index_a2x_Faxa_snowl,ig) = cam_out%precsl(i)*1000._r8 - a2x(index_a2x_Faxa_swndr,ig) = cam_out%soll(i) - a2x(index_a2x_Faxa_swvdr,ig) = cam_out%sols(i) - a2x(index_a2x_Faxa_swndf,ig) = cam_out%solld(i) - a2x(index_a2x_Faxa_swvdf,ig) = cam_out%solsd(i) - - ! aerosol deposition fluxes - a2x(index_a2x_Faxa_bcphidry,ig) = cam_out%bcphidry(i) - a2x(index_a2x_Faxa_bcphodry,ig) = cam_out%bcphodry(i) - a2x(index_a2x_Faxa_bcphiwet,ig) = cam_out%bcphiwet(i) - a2x(index_a2x_Faxa_ocphidry,ig) = cam_out%ocphidry(i) - a2x(index_a2x_Faxa_ocphodry,ig) = cam_out%ocphodry(i) - a2x(index_a2x_Faxa_ocphiwet,ig) = cam_out%ocphiwet(i) - a2x(index_a2x_Faxa_dstwet1,ig) = cam_out%dstwet1(i) - a2x(index_a2x_Faxa_dstdry1,ig) = cam_out%dstdry1(i) - a2x(index_a2x_Faxa_dstwet2,ig) = cam_out%dstwet2(i) - a2x(index_a2x_Faxa_dstdry2,ig) = cam_out%dstdry2(i) - a2x(index_a2x_Faxa_dstwet3,ig) = cam_out%dstwet3(i) - a2x(index_a2x_Faxa_dstdry3,ig) = cam_out%dstdry3(i) - a2x(index_a2x_Faxa_dstwet4,ig) = cam_out%dstwet4(i) - a2x(index_a2x_Faxa_dstdry4,ig) = cam_out%dstdry4(i) - - if (index_a2x_Sa_co2prog /= 0) then - a2x(index_a2x_Sa_co2prog,ig) = cam_out%co2prog(i) ! atm prognostic co2 - end if - if (index_a2x_Sa_co2diag /= 0) then - a2x(index_a2x_Sa_co2diag,ig) = cam_out%co2diag(i) ! atm diagnostic co2 - end if - if (index_a2x_Faxa_nhx > 0 ) then - a2x(index_a2x_Faxa_nhx,ig) = cam_out%nhx_nitrogen_flx(i) - endif - if (index_a2x_Faxa_noy > 0 ) then - a2x(index_a2x_Faxa_noy,ig) = cam_out%noy_nitrogen_flx(i) - endif - - ig = ig + 1 - end do - end do - - !----------------------------------------------------------------- - ! Debug output - !----------------------------------------------------------------- - - if (debug > 0 .and. masterproc) then - nstep = get_nstep() - ig = 1 - do c = begchunk, endchunk - ncols = get_ncols_p(c) - do i = 1,ncols - write(iulog,F01)'export: nstep, ig, Sa_z = ',nstep,ig,a2x(index_a2x_Sa_z,ig) - write(iulog,F01)'export: nstep, ig, Sa_topo = ',nstep,ig,a2x(index_a2x_Sa_topo,ig) - write(iulog,F01)'export: nstep, ig, Sa_u = ',nstep,ig,a2x(index_a2x_Sa_u,ig) - write(iulog,F01)'export: nstep, ig, Sa_v = ',nstep,ig,a2x(index_a2x_Sa_v,ig) - write(iulog,F01)'export: nstep, ig, Sa_tbot = ',nstep,ig,a2x(index_a2x_Sa_tbot,ig) - write(iulog,F01)'export: nstep, ig, Sa_ptem = ',nstep,ig,a2x(index_a2x_Sa_ptem,ig) - write(iulog,F01)'export: nstep, ig, Sa_pbot = ',nstep,ig,a2x(index_a2x_Sa_pbot,ig) - write(iulog,F01)'export: nstep, ig, Sa_shum = ',nstep,ig,a2x(index_a2x_Sa_shum,ig) - write(iulog,F01)'export: nstep, ig, Sa_dens = ',nstep,ig,a2x(index_a2x_Sa_dens,ig) - write(iulog,F01)'export: nstep, ig, Faxa_swnet = ',nstep,ig,a2x(index_a2x_Faxa_swnet,ig) - write(iulog,F01)'export: nstep, ig, Faxa_lwdn = ',nstep,ig,a2x(index_a2x_Faxa_lwdn,ig) - write(iulog,F01)'export: nstep, ig, Faxa_rainc = ',nstep,ig,a2x(index_a2x_Faxa_rainc,ig) - write(iulog,F01)'export: nstep, ig, Faxa_rainl = ',nstep,ig,a2x(index_a2x_Faxa_rainl,ig) - write(iulog,F01)'export: nstep, ig, Faxa_snowc = ',nstep,ig,a2x(index_a2x_Faxa_snowc,ig) - write(iulog,F01)'export: nstep, ig, Faxa_snowl = ',nstep,ig,a2x(index_a2x_Faxa_snowl,ig) - write(iulog,F01)'export: nstep, ig, Faxa_swndr = ',nstep,ig,a2x(index_a2x_Faxa_swndr,ig) - write(iulog,F01)'export: nstep, ig, Faxa_swvdr = ',nstep,ig,a2x(index_a2x_Faxa_swvdr,ig) - write(iulog,F01)'export: nstep, ig, Faxa_swndf = ',nstep,ig,a2x(index_a2x_Faxa_swndf,ig) - write(iulog,F01)'export: nstep, ig, Faxa_swvdf = ',nstep,ig,a2x(index_a2x_Faxa_swvdf,ig) - write(iulog,F01)'export: nstep, ig, Faxa_bcphidry = ',nstep,ig,a2x(index_a2x_Faxa_bcphidry,ig) - write(iulog,F01)'export: nstep, ig, Faxa_bcphodry = ',nstep,ig,a2x(index_a2x_Faxa_bcphodry,ig) - write(iulog,F01)'export: nstep, ig, Faxa_bcphiwet = ',nstep,ig,a2x(index_a2x_Faxa_bcphiwet,ig) - write(iulog,F01)'export: nstep, ig, Faxa_ocphidry = ',nstep,ig,a2x(index_a2x_Faxa_ocphidry,ig) - write(iulog,F01)'export: nstep, ig, Faxa_ocphodry = ',nstep,ig,a2x(index_a2x_Faxa_ocphodry,ig) - write(iulog,F01)'export: nstep, ig, Faxa_ocphidry = ',nstep,ig,a2x(index_a2x_Faxa_ocphiwet,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstwet1,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstdry1,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstwet2,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstdry2,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstwet3,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstdry3,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstwet4,ig) - write(iulog,F01)'export: nstep, ig, Faxa_dstwet1 = ',nstep,ig,a2x(index_a2x_Faxa_dstdry4,ig) - if (index_a2x_Sa_co2prog /= 0) then - write(iulog,F01)'export: nstep, ig, Sa_co2prog = ',nstep,ig,a2x(index_a2x_Sa_co2prog,ig) - end if - if (index_a2x_Sa_co2diag /= 0) then - write(iulog,F01)'export: nstep, ig, Sa_co2diag = ',nstep,ig,a2x(index_a2x_Sa_co2diag,ig) - end if - if (index_a2x_Faxa_nhx > 0 ) then - write(iulog,F01)'export: nstep, ig, Faxa_nhx = ',nstep,ig,a2x(index_a2x_Faxa_nhx,ig) - endif - if (index_a2x_Faxa_noy > 0 ) then - write(iulog,F01)'export: nstep, ig, Faxa_noy = ',nstep,ig,a2x(index_a2x_Faxa_noy,ig) - endif - ig = ig + 1 - end do - end do - end if -#endif -!!XXgoldyXX: ^ figure out what to do with constituents - - end subroutine atm_export - -end module atm_import_export diff --git a/src/cpl/mct/cam_cpl_indices.F90 b/src/cpl/mct/cam_cpl_indices.F90 deleted file mode 100644 index 5237e564..00000000 --- a/src/cpl/mct/cam_cpl_indices.F90 +++ /dev/null @@ -1,234 +0,0 @@ -module cam_cpl_indices - - use seq_flds_mod, only: seq_flds_x2a_fields, seq_flds_a2x_fields - use mct_mod, only: mct_aVect, mct_aVect_init, mct_avect_indexra - use mct_mod, only: mct_aVect_clean - use seq_drydep_mod, only: drydep_fields_token, lnd_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 - use shr_fire_emis_mod, only: shr_fire_emis_ztop_token - use shr_fire_emis_mod, only: shr_fire_emis_mechcomps_n - use srf_field_check, only: set_active_Sl_ram1, set_active_Sl_fv - use srf_field_check, only: set_active_Sl_soilw, set_active_Fall_flxdst1 - use srf_field_check, only: set_active_Fall_flxvoc, set_active_Fall_flxfire - use srf_field_check, only: set_active_Fall_fco2_lnd - use srf_field_check, only: set_active_Faoo_fco2_ocn, set_active_Faxa_nhx - use srf_field_check, only: set_active_Faxa_noy - - implicit none - - SAVE - public - - integer :: index_a2x_Sa_z ! bottom atm level height - integer :: index_a2x_Sa_topo ! surface topographic height - integer :: index_a2x_Sa_u ! bottom atm level zon wind - integer :: index_a2x_Sa_v ! bottom atm level mer wind - integer :: index_a2x_Sa_tbot ! bottom atm level temp - integer :: index_a2x_Sa_ptem ! bottom atm level pot temp - integer :: index_a2x_Sa_shum ! bottom atm level spec hum - integer :: index_a2x_Sa_dens ! bottom atm level air den - integer :: index_a2x_Sa_pbot ! bottom atm level pressure - integer :: index_a2x_Sa_pslv ! sea level atm pressure - integer :: index_a2x_Faxa_lwdn ! downward lw heat flux - integer :: index_a2x_Faxa_rainc ! prec: liquid "convective" - integer :: index_a2x_Faxa_rainl ! prec: liquid "large scale" - integer :: index_a2x_Faxa_snowc ! prec: frozen "convective" - integer :: index_a2x_Faxa_snowl ! prec: frozen "large scale" - integer :: index_a2x_Faxa_swndr ! sw: nir direct downward - integer :: index_a2x_Faxa_swvdr ! sw: vis direct downward - integer :: index_a2x_Faxa_swndf ! sw: nir diffuse downward - integer :: index_a2x_Faxa_swvdf ! sw: vis diffuse downward - integer :: index_a2x_Faxa_swnet ! sw: net - integer :: index_a2x_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition - integer :: index_a2x_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition - integer :: index_a2x_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition - integer :: index_a2x_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition - integer :: index_a2x_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition - integer :: index_a2x_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition - integer :: index_a2x_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition - integer :: index_a2x_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition - integer :: index_a2x_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition - integer :: index_a2x_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition - integer :: index_a2x_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition - integer :: index_a2x_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition - integer :: index_a2x_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition - integer :: index_a2x_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition - integer :: index_a2x_Sa_co2prog ! bottom atm level prognostic co2 - integer :: index_a2x_Sa_co2diag ! bottom atm level diagnostic co2 - integer :: index_a2x_Faxa_nhx ! flux: Nitrogen deposition - integer :: index_a2x_Faxa_noy ! flux: Nitrogen deposition - - integer :: index_x2a_Sx_t ! surface temperature - integer :: index_x2a_So_t ! sea surface temperature - integer :: index_x2a_Sf_lfrac ! surface land fraction - integer :: index_x2a_Sf_ifrac ! surface ice fraction - integer :: index_x2a_Sf_ofrac ! surface ocn fraction - integer :: index_x2a_Sx_tref ! 2m reference temperature - integer :: index_x2a_Sx_qref ! 2m reference specific humidity - integer :: index_x2a_Sx_avsdr ! albedo, visible, direct - integer :: index_x2a_Sx_anidr ! albedo, near-ir, direct - integer :: index_x2a_Sx_avsdf ! albedo, visible, diffuse - integer :: index_x2a_Sx_anidf ! albedo, near-ir, diffuse - integer :: index_x2a_Sl_snowh ! surface snow depth over land - integer :: index_x2a_Si_snowh ! surface snow depth over ice - integer :: index_x2a_Sl_fv ! friction velocity - integer :: index_x2a_Sl_ram1 ! aerodynamical resistance - integer :: index_x2a_Sl_soilw ! volumetric soil water - integer :: index_x2a_Faxx_taux ! wind stress, zonal - integer :: index_x2a_Faxx_tauy ! wind stress, meridional - integer :: index_x2a_Faxx_lat ! latent heat flux - integer :: index_x2a_Faxx_sen ! sensible heat flux - integer :: index_x2a_Faxx_lwup ! upward longwave heat flux - integer :: index_x2a_Faxx_evap ! evaporation water flux - integer :: index_x2a_Fall_flxdst1 ! dust flux size bin 1 - integer :: index_x2a_Fall_flxdst2 ! dust flux size bin 2 - integer :: index_x2a_Fall_flxdst3 ! dust flux size bin 3 - integer :: index_x2a_Fall_flxdst4 ! dust flux size bin 4 - integer :: index_x2a_Fall_flxvoc ! MEGAN emissions fluxes - integer :: index_x2a_Fall_flxfire ! Fire emissions fluxes - integer :: index_x2a_Sl_ztopfire ! Fire emissions fluxes top of vert distribution - integer :: index_x2a_Fall_fco2_lnd ! co2 flux from land - integer :: index_x2a_Faoo_fco2_ocn ! co2 flux from ocean - integer :: index_x2a_Faoo_fdms_ocn ! dms flux from ocean - integer :: index_x2a_So_ustar ! surface friction velocity in ocean - integer :: index_x2a_So_re ! square of atm/ocn exch. coeff - integer :: index_x2a_So_ssq ! surface saturation specific humidity in ocean - integer :: index_x2a_Sl_ddvel ! dry deposition velocities from land - integer :: index_x2a_Sx_u10 ! 10m wind - -contains - - subroutine cam_cpl_indices_set( ) - - type(mct_aVect) :: a2x ! temporary - type(mct_aVect) :: x2a ! temporary - - ! Determine attribute vector indices - - ! create temporary attribute vectors - call mct_aVect_init(x2a, rList=seq_flds_x2a_fields, lsize=1) - call mct_aVect_init(a2x, rList=seq_flds_a2x_fields, lsize=1) - - ! Initialize av indices - index_x2a_Sx_avsdr = mct_avect_indexra(x2a,'Sx_avsdr') - index_x2a_Sx_anidr = mct_avect_indexra(x2a,'Sx_anidr') - index_x2a_Sx_avsdf = mct_avect_indexra(x2a,'Sx_avsdf') - index_x2a_Sx_anidf = mct_avect_indexra(x2a,'Sx_anidf') - index_x2a_Sx_t = mct_avect_indexra(x2a,'Sx_t') - index_x2a_So_t = mct_avect_indexra(x2a,'So_t') - index_x2a_Sl_snowh = mct_avect_indexra(x2a,'Sl_snowh') - index_x2a_Si_snowh = mct_avect_indexra(x2a,'Si_snowh') - - index_x2a_Sl_fv = mct_avect_indexra(x2a,'Sl_fv') - index_x2a_Sl_ram1 = mct_avect_indexra(x2a,'Sl_ram1') - index_x2a_Sl_soilw = mct_avect_indexra(x2a,'Sl_soilw',perrWith='quiet') - - index_x2a_Sx_tref = mct_avect_indexra(x2a,'Sx_tref') - index_x2a_Sx_qref = mct_avect_indexra(x2a,'Sx_qref') - - index_x2a_Sf_ifrac = mct_avect_indexra(x2a,'Sf_ifrac') - index_x2a_Sf_ofrac = mct_avect_indexra(x2a,'Sf_ofrac') - index_x2a_Sf_lfrac = mct_avect_indexra(x2a,'Sf_lfrac') - - index_x2a_Sx_u10 = mct_avect_indexra(x2a,'Sx_u10') - index_x2a_Faxx_taux = mct_avect_indexra(x2a,'Faxx_taux') - index_x2a_Faxx_tauy = mct_avect_indexra(x2a,'Faxx_tauy') - index_x2a_Faxx_lat = mct_avect_indexra(x2a,'Faxx_lat') - index_x2a_Faxx_sen = mct_avect_indexra(x2a,'Faxx_sen') - index_x2a_Faxx_lwup = mct_avect_indexra(x2a,'Faxx_lwup') - index_x2a_Faxx_evap = mct_avect_indexra(x2a,'Faxx_evap') - index_x2a_So_ustar = mct_avect_indexra(x2a,'So_ustar') - index_x2a_So_re = mct_avect_indexra(x2a,'So_re') - index_x2a_So_ssq = mct_avect_indexra(x2a,'So_ssq') - index_x2a_Sl_fv = mct_avect_indexra(x2a,'Sl_fv') - index_x2a_Sl_ram1 = mct_avect_indexra(x2a,'Sl_ram1') - index_x2a_Fall_flxdst1 = mct_avect_indexra(x2a,'Fall_flxdst1') - index_x2a_Fall_flxdst2 = mct_avect_indexra(x2a,'Fall_flxdst2') - index_x2a_Fall_flxdst3 = mct_avect_indexra(x2a,'Fall_flxdst3') - index_x2a_Fall_flxdst4 = mct_avect_indexra(x2a,'Fall_flxdst4') - index_x2a_Fall_fco2_lnd = mct_avect_indexra(x2a,'Fall_fco2_lnd',perrWith='quiet') - index_x2a_Faoo_fco2_ocn = mct_avect_indexra(x2a,'Faoo_fco2_ocn',perrWith='quiet') - index_x2a_Faoo_fdms_ocn = mct_avect_indexra(x2a,'Faoo_fdms_ocn',perrWith='quiet') - - if (shr_megan_mechcomps_n>0) then - index_x2a_Fall_flxvoc = mct_avect_indexra(x2a,trim(shr_megan_fields_token)) - else - index_x2a_Fall_flxvoc = 0 - endif - - if (shr_fire_emis_mechcomps_n>0) then - index_x2a_Fall_flxfire = mct_avect_indexra(x2a,trim(shr_fire_emis_fields_token)) - index_x2a_Sl_ztopfire = mct_avect_indexra(x2a,trim(shr_fire_emis_ztop_token)) - else - index_x2a_Fall_flxfire = 0 - index_x2a_Sl_ztopfire = 0 - endif - - if ( lnd_drydep )then - index_x2a_Sl_ddvel = mct_avect_indexra(x2a, trim(drydep_fields_token)) - else - index_x2a_Sl_ddvel = 0 - end if - - index_a2x_Sa_z = mct_avect_indexra(a2x,'Sa_z') - index_a2x_Sa_topo = mct_avect_indexra(a2x,'Sa_topo') - index_a2x_Sa_u = mct_avect_indexra(a2x,'Sa_u') - index_a2x_Sa_v = mct_avect_indexra(a2x,'Sa_v') - index_a2x_Sa_tbot = mct_avect_indexra(a2x,'Sa_tbot') - index_a2x_Sa_ptem = mct_avect_indexra(a2x,'Sa_ptem') - index_a2x_Sa_pbot = mct_avect_indexra(a2x,'Sa_pbot') - index_a2x_Sa_pslv = mct_avect_indexra(a2x,'Sa_pslv') - index_a2x_Sa_shum = mct_avect_indexra(a2x,'Sa_shum') - index_a2x_Sa_dens = mct_avect_indexra(a2x,'Sa_dens') - index_a2x_Faxa_swnet = mct_avect_indexra(a2x,'Faxa_swnet') - index_a2x_Faxa_lwdn = mct_avect_indexra(a2x,'Faxa_lwdn') - index_a2x_Faxa_rainc = mct_avect_indexra(a2x,'Faxa_rainc') - index_a2x_Faxa_rainl = mct_avect_indexra(a2x,'Faxa_rainl') - index_a2x_Faxa_snowc = mct_avect_indexra(a2x,'Faxa_snowc') - index_a2x_Faxa_snowl = mct_avect_indexra(a2x,'Faxa_snowl') - index_a2x_Faxa_swndr = mct_avect_indexra(a2x,'Faxa_swndr') - index_a2x_Faxa_swvdr = mct_avect_indexra(a2x,'Faxa_swvdr') - index_a2x_Faxa_swndf = mct_avect_indexra(a2x,'Faxa_swndf') - index_a2x_Faxa_swvdf = mct_avect_indexra(a2x,'Faxa_swvdf') - index_a2x_Faxa_bcphidry = mct_avect_indexra(a2x,'Faxa_bcphidry') - index_a2x_Faxa_bcphodry = mct_avect_indexra(a2x,'Faxa_bcphodry') - index_a2x_Faxa_bcphiwet = mct_avect_indexra(a2x,'Faxa_bcphiwet') - index_a2x_Faxa_ocphidry = mct_avect_indexra(a2x,'Faxa_ocphidry') - index_a2x_Faxa_ocphodry = mct_avect_indexra(a2x,'Faxa_ocphodry') - index_a2x_Faxa_ocphiwet = mct_avect_indexra(a2x,'Faxa_ocphiwet') - index_a2x_Faxa_dstdry1 = mct_avect_indexra(a2x,'Faxa_dstdry1') - index_a2x_Faxa_dstdry2 = mct_avect_indexra(a2x,'Faxa_dstdry2') - index_a2x_Faxa_dstdry3 = mct_avect_indexra(a2x,'Faxa_dstdry3') - index_a2x_Faxa_dstdry4 = mct_avect_indexra(a2x,'Faxa_dstdry4') - index_a2x_Faxa_dstwet1 = mct_avect_indexra(a2x,'Faxa_dstwet1') - index_a2x_Faxa_dstwet2 = mct_avect_indexra(a2x,'Faxa_dstwet2') - index_a2x_Faxa_dstwet3 = mct_avect_indexra(a2x,'Faxa_dstwet3') - index_a2x_Faxa_dstwet4 = mct_avect_indexra(a2x,'Faxa_dstwet4') - index_a2x_Sa_co2prog = mct_avect_indexra(a2x,'Sa_co2prog',perrWith='quiet') - index_a2x_Sa_co2diag = mct_avect_indexra(a2x,'Sa_co2diag',perrWith='quiet') - index_a2x_Faxa_nhx = mct_avect_indexra(a2x,'Faxa_nhx',perrWith='quiet') - index_a2x_Faxa_noy = mct_avect_indexra(a2x,'Faxa_noy',perrWith='quiet') - - ! Call coupler independent interface routines to set flags for specific - ! fields so CAM can query whether they are passed by the coupler. - call set_active_Sl_ram1( index_x2a_Sl_ram1>0) - call set_active_Sl_fv( index_x2a_Sl_fv>0) - call set_active_Sl_soilw( index_x2a_Sl_soilw>0) - call set_active_Fall_flxdst1( index_x2a_Fall_flxdst1>0) - call set_active_Fall_flxvoc( index_x2a_Fall_flxvoc>0) - call set_active_Fall_flxfire( index_x2a_Fall_flxfire>0) - call set_active_Fall_fco2_lnd(index_x2a_Fall_fco2_lnd>0) - call set_active_Faoo_fco2_ocn(index_x2a_Faoo_fco2_ocn>0) - - ! Call coupler independent interface routines to set flags for specific - ! fields so CAM can query whether the coupler expects them to be provided. - call set_active_Faxa_nhx( index_a2x_Faxa_nhx>0) - call set_active_Faxa_noy( index_a2x_Faxa_noy>0) - - call mct_aVect_clean(x2a) - call mct_aVect_clean(a2x) - - end subroutine cam_cpl_indices_set - -end module cam_cpl_indices diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 387a1660..7cdd1247 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -1,2326 +1,2105 @@ module atm_comp_nuopc - !---------------------------------------------------------------------------- - ! This is the NUOPC cap for CAM - !---------------------------------------------------------------------------- - - use ESMF, only: ESMF_SUCCESS, ESMF_FAILURE, ESMF_KIND_I8 - use ESMF, only: ESMF_ALARMLIST_ALL, ESMF_METHOD_INITIALIZE - use ESMF, only: ESMF_LOGMSG_INFO, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU - use ESMF, only: ESMF_FILEFORMAT_ESMFMESH, ESMF_RC_NOT_VALID - use ESMF, only: ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - - use ESMF, only: ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER - use ESMF, only: ESMF_GridCreateNoPeriDimUfrm - use ESMF, only: ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM - use ESMF, only: ESMF_TimeInterval, ESMF_Time, ESMF_Calendar - use ESMF, only: ESMF_Mesh, ESMF_Field, ESMF_Alarm - use ESMF, only: ESMF_CalKind_Flag, operator(==), operator(+) - - use ESMF, only: ESMF_GridCompSetEntryPoint - use ESMF, only: ESMF_MethodRemove - use ESMF, only: ESMF_VMGetCurrent, ESMF_VMGet - use ESMF, only: ESMF_Grid, ESMF_DistGrid, ESMF_GridCompGet - use ESMF, only: ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance - use ESMF, only: ESMF_ClockGetAlarm, ESMF_ClockGetNextTime - use ESMF, only: ESMF_ClockGetAlarmList - use ESMF, only: ESMF_TimeGet, ESMF_TimeIntervalGet - use ESMF, only: ESMF_DistGridCreate, ESMF_MeshCreate, ESMF_MeshGet - use ESMF, only: ESMF_StateGet, ESMF_FieldGet - use ESMF, only: ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmSet - use ESMF, only: ESMF_LogWrite, ESMF_LogSetError - use ESMF, only: ESMF_LogFoundError - - use NUOPC, only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC, only: NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime - use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC, only: NUOPC_SetAttribute, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet - use NUOPC_Model, only: model_routine_SS => SetServices - use NUOPC_Model, only: SetVM - use NUOPC_Model, only: model_label_Advance => label_Advance - use NUOPC_Model, only: model_label_DataInitialize => label_DataInitialize - use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock - use NUOPC_Model, only: model_label_Finalize => label_Finalize - use NUOPC_Model, only: NUOPC_ModelGet - use shr_kind_mod, only: r8=>shr_kind_r8, i8=>shr_kind_i8 - use shr_kind_mod, only: CX=>shr_kind_cx, CL=>shr_kind_cl - use shr_kind_mod, only: CS=>shr_kind_cs - use shr_sys_mod, only: shr_sys_abort - use shr_file_mod, only: shr_file_getlogunit, shr_file_setlogunit - use shr_cal_mod, only: shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date - use shr_const_mod, only: shr_const_pi - use shr_orb_mod, only: shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT - use cam_instance, only: cam_instance_init, inst_suffix, inst_index -! use radiation, only: radiation_nextsw_cday, rad_nextsw_cday=>nextsw_cday - use camsrfexch, only: cam_out_t, cam_in_t - use cam_logfile, only: cam_set_log_unit, iulog - use spmd_utils, only: spmd_init, masterproc, iam, mpicom - use time_manager, only: get_curr_calday, advance_timestep, get_curr_date, get_nstep, get_step_size - use atm_import_export, only: advertise_fields, realize_fields - use atm_import_export, only: import_fields, export_fields - use nuopc_shr_methods, only: chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit - use nuopc_shr_methods, only: set_component_logging, get_component_instance, log_clock_advance - use perf_mod, only: t_startf, t_stopf - use physics_grid, only: columns_on_task, global_index_p, get_rlon_all_p, get_rlat_all_p - use physics_grid, only: num_global_phys_cols, get_grid_dims - use cam_control_mod, only: cam_ctrl_set_orbit - use cam_pio_utils, only: cam_pio_createfile, cam_pio_openfile, cam_pio_closefile, cam_pio_newdecomp - use cam_initfiles, only: cam_initfiles_get_caseid, cam_initfiles_get_restdir - use filenames, only: interpret_filename_spec - use pio, only: file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim, PIO_MAX_NAME - use pio, only: pio_freedecomp - use pio, only: pio_closefile, pio_inq_varid, pio_put_att, pio_enddef - use pio, only: pio_read_darray, pio_write_darray, pio_def_var, pio_inq_varid - use pio, only: pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling - use pio, only: pio_def_var, pio_put_var, PIO_INT, PIO_OFFSET_KIND - !$use omp_lib, only: omp_set_num_threads - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! Private interfaces - !-------------------------------------------------------------------------- - - private :: InitializeP0 - private :: InitializeAdvertise - private :: InitializeRealize - private :: ModelAdvance - private :: ModelSetRunClock - private :: ModelFinalize - private :: cam_read_srfrest - private :: cam_write_srfrest - private :: cam_orbital_init - private :: cam_orbital_update - private :: cam_set_mesh_for_single_column - - !-------------------------------------------------------------------------- - ! Private module data - !-------------------------------------------------------------------------- - - character(len=CL) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - integer :: flds_scalar_index_nextsw_cday = 0 - - integer, parameter :: dbug_flag = 0 - - ! Remove "NULL" once cam_in/out are fully developed -JN: - type(cam_in_t), pointer :: cam_in => NULL() - type(cam_out_t), pointer :: cam_out => NULL() - - character(len=CL) :: rsfilename_spec_cam ! Filename specifier for restart surface file - character(len=*), parameter :: modName = "(atm_comp_nuopc)" - character(len=*), parameter :: u_FILE_u = __FILE__ - - logical :: dart_mode = .false. - logical :: mediator_present - - character(len=CL) :: orb_mode ! orbital mode - integer :: orb_iyear ! orbital year - integer :: orb_iyear_align ! associated with model year - real(R8) :: orb_obliq ! obliquity in degrees - real(R8) :: orb_mvelp ! moving vernal equinox longitude - real(R8) :: orb_eccen ! orbital eccentricity - - character(len=*), parameter :: orb_fixed_year = 'fixed_year' - character(len=*), parameter :: orb_variable_year = 'variable_year' - character(len=*), parameter :: orb_fixed_parameters = 'fixed_parameters' - - !Remove once history output is developed for CAMDEN -JN: - real(r8) :: fillvalue = 9.87e36_r8 - - real(R8), parameter :: grid_tol = 1.e-2_r8 ! tolerance for calculated lat/lon vs read in - integer :: local_iulog = 6 !Local iulog for use with NUOPC interfaces - - ! dof is the global index space decomposition - integer(kind=PIO_OFFSET_KIND), allocatable :: dof(:) - -!========================================================================== -CONTAINS -!========================================================================== - - subroutine SetServices(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(len=*), parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - - ! the NUOPC gcomp component will register the generic methods - - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! switching to Initialize Phase Definition (IPD) - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! set entry point for methods that require specific implementation - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, & - rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! attach specializing method(s) - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & - specRoutine=ModelAdvance, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & - specRoutine=DataInitialize, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & - specRoutine=ModelSetRunClock, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & - specRoutine=ModelFinalize, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - end subroutine SetServices - - !========================================================================== - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - !------------------------------------------------------------------------ - rc = ESMF_SUCCESS - - ! Switch to IPDv03 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv03p"/), rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - end subroutine InitializeP0 - - !========================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! Dummy arguments - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local variables - type(ESMF_VM) :: vm - integer :: n - integer :: localpet - character(len=CL) :: cvalue - character(len=CL) :: logmsg - logical :: isPresent, isSet - integer :: shrlogunit ! original log unit - character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call ESMF_VmGet(vm, localPet=localPet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - !----------------------------------------------------------------------- - ! reset shr logging to my log file - !----------------------------------------------------------------------- - - call set_component_logging(gcomp, localpet==0, local_iulog, & - shrlogunit, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call shr_file_setLogUnit (shrlogunit) - call cam_set_log_unit(local_iulog) - - !----------------------------------------------------------------------- - ! advertise import/export fields - !----------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (isPresent .and. isSet) then - flds_scalar_name = trim(cvalue) - call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '// & - trim(flds_scalar_name), ESMF_LOGMSG_INFO) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') - end if - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue, *) flds_scalar_num - write(logmsg,*) flds_scalar_num - call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '// & - trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') - end if - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_nx - write(logmsg,*) flds_scalar_index_nx - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '// & - trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call shr_sys_abort(subname// & - 'Need to set attribute ScalarFieldIdxGridNX') - end if - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_ny - write(logmsg,*) flds_scalar_index_ny - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '// & - trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call shr_sys_abort(subname// & - 'Need to set attribute ScalarFieldIdxGridNY') - end if - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_nextsw_cday - write(logmsg,*) flds_scalar_index_nextsw_cday - call ESMF_LogWrite(trim(subname)// & - ' : flds_scalar_index_nextsw_cday = '//trim(logmsg), & - ESMF_LOGMSG_INFO) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call shr_sys_abort(subname// & - 'Need to set attribute ScalarFieldIdxNextSwCday') - end if - - call NUOPC_CompAttributeGet(gcomp, name="mediator_present", & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (isPresent .and. isSet) then - read (cvalue,*) mediator_present - if (mediator_present) then - call advertise_fields(gcomp, flds_scalar_name, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - else - call shr_sys_abort(subname//'Need to set attribute mediator_present') - end if - - if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end if - end subroutine InitializeAdvertise - - !========================================================================== - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - - use string_utils, only: to_str - use cam_comp, only: cam_init - - ! Dummy arguments - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local variables - type(ESMF_VM) :: vm - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep - type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - type(ESMF_DistGrid) :: distGrid - type(ESMF_Mesh) :: mesh, Emesh - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - real(r8), pointer :: lat(:), latMesh(:) - real(r8), pointer :: lon(:), lonMesh(:) - real(r8) :: lats(columns_on_task) ! array of task latitudes - real(r8) :: lons(columns_on_task) ! array of taskk longitude - integer :: hdim1_d, hdim2_d ! dims of rect horizontal grid data (If 1D data struct, hdim2_d==1) - integer :: ncols ! number of local columns - integer :: start_ymd ! Start date (YYYYMMDD) - integer :: start_tod ! Start time of day (sec) - integer :: curr_ymd ! Start date (YYYYMMDD) - integer :: curr_tod ! Start time of day (sec) - integer :: stop_ymd ! Stop date (YYYYMMDD) - integer :: stop_tod ! Stop time of day (sec) - integer :: ref_ymd ! Reference date (YYYYMMDD) - integer :: ref_tod ! Reference time of day (sec) - character(len=cs) :: calendar ! Calendar type - integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step - integer :: nstep ! CAM nstep - real(r8) :: caldayp1 ! CAM calendar day for for next cam time step - integer :: yy,mm,dd ! Temporaries for time query - logical :: perpetual_run ! If in perpetual mode or not - integer :: perpetual_ymd ! Perpetual date (YYYYMMDD) - character(CL) :: cvalue - character(ESMF_MAXSTR) :: convCIM, purpComp - integer :: lsize ! local size ofarrays - integer :: n,c,g,i,j ! indices - character(len=cs) :: start_type ! infodata start type - character(len=cl) :: caseid ! case ID - character(len=cl) :: ctitle ! case title - character(len=cl) :: model_doi_url ! DOI for CESM model run - logical :: aqua_planet ! Flag to run model in "aqua planet" mode - logical :: brnch_retain_casename ! true => branch run has same caseid as run being branched from - logical :: single_column - character(len=cl) :: single_column_lnd_domainfile - real(r8) :: scol_lon - real(r8) :: scol_lat - real(r8) :: scol_spval - real(r8) :: eccen - real(r8) :: obliqr - real(r8) :: lambm0 - real(r8) :: mvelpp - logical :: dart_mode_in - !character(len=cl) :: atm_resume_all_inst(num_inst_atm) ! atm resume file - integer :: lbnum - character(CS) :: inst_name - integer :: inst_index - character(CS) :: inst_suffix - integer :: lmpicom - logical :: isPresent - character(len=CX) :: diro - character(len=CX) :: logfile - integer :: compid ! component id - integer :: localPet, localPeCount - integer :: nthrds - integer :: astat - logical :: initial_run ! startup mode which only requires a minimal initial file - logical :: restart_run ! continue a previous run; requires a restart file - logical :: branch_run ! branch from a previous run; requires a restart file - character(len=CL) :: tempc1,tempc2 - integer :: shrlogunit ! original log unit - real(r8), parameter :: radtodeg = 180.0_r8/shr_const_pi - integer, parameter :: aqua_perpetual_ymd = 321 - character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' - character(len=*), parameter :: format = "('("//trim(subname)//") :',A)" - !------------------------------------------------------------------------ - - rc = ESMF_SUCCESS - single_column = .false. - if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - - call shr_file_setLogUnit (iulog) - - !----------------------------------------------------------------------- - ! generate local mpi comm - !----------------------------------------------------------------------- - - call ESMF_GridCompGet(gcomp, vm=vm, localpet=localPet, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if(localPeCount == 1) then - call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=u_FILE_u)) return - read(cvalue,*) nthrds - else - nthrds = localPeCount - end if - - !$ call omp_set_num_threads(nthrds) - - !----------------------------------------------------------------------- - ! determine instance information - !----------------------------------------------------------------------- - call get_component_instance(gcomp, inst_suffix, inst_index, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - inst_name = 'ATM'//inst_suffix - ! Set filename specifier for restart surface file - ! (%c=caseid, $y=year, $m=month, $d=day, $s=seconds in day) - rsfilename_spec_cam = '%c.cam' //trim(inst_suffix)//'.rs.%y-%m-%d-%s.nc' - - !----------------------------------------------------------------------- - ! initialize cam mpi (needed for masterproc below) - !----------------------------------------------------------------------- - - call spmd_init(lmpicom) - - !----------------------------------------------------------------------- - ! Initialize cam - needed in realize phase to get grid information - !----------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=u_FILE_u)) return - read(cvalue,*) compid - call cam_instance_init(compid, inst_name, inst_index, inst_suffix) - - !----------------------------------------------------------------------- - ! Initialize cam - needed in realize phase to get grid information - !----------------------------------------------------------------------- - - if (masterproc) then - write(iulog,format) "CAM atm model initialization" - end if + !---------------------------------------------------------------------------- + ! This is the NUOPC cap for CAM + !---------------------------------------------------------------------------- + + use ESMF , only : operator(<=), operator(>), operator(==), operator(+) + use ESMF , only : ESMF_MethodRemove + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Grid, ESMF_GridCreateNoPeriDimUfrm, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_DistGrid, ESMF_DistGridCreate + use ESMF , only : ESMF_Mesh, ESMF_MeshCreate, ESMF_MeshGet, ESMF_FILEFORMAT_ESMFMESH + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockGetNextTime, ESMF_ClockAdvance + use ESMF , only : ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmRingerOff, ESMF_AlarmIsRinging + use ESMF , only : ESMF_ClockGetAlarmList, ESMF_ALARMLIST_ALL, ESMF_AlarmSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet + use ESMF , only : ESMF_CalKind_Flag, ESMF_MAXSTR, ESMF_KIND_I8 + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_GridCompSetEntryPoint + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_LogWrite, ESMF_LogSetError, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_METHOD_INITIALIZE, ESMF_FAILURE, ESMF_RC_NOT_VALID + use ESMF , only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC , only : NUOPC_SetAttribute, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : SetVM + use NUOPC_Model , only : model_label_Advance => label_Advance + use NUOPC_Model , only : model_label_DataInitialize => label_DataInitialize + use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock + use NUOPC_Model , only : model_label_Finalize => label_Finalize + use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_const_mod , only : shr_const_pi + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT + use cam_instance , only : cam_instance_init, inst_suffix, inst_index + use cam_comp , only : cam_init, cam_run1, cam_run2, cam_run3, cam_run4, cam_final + use cam_comp , only : cam_timestep_init, cam_timestep_final + use camsrfexch , only : cam_out_t, cam_in_t +! use radiation , only : nextsw_cday !uncomment once radiation has been CCPP-ized -JN + use cam_logfile , only : cam_set_log_unit, iulog + use cam_abortutils , only : check_allocate + use spmd_utils , only : spmd_init, masterproc, iam + use time_manager , only : get_curr_calday, advance_timestep, get_curr_date, get_nstep, get_step_size + use atm_import_export , only : read_surface_fields_namelists, advertise_fields, realize_fields + use atm_import_export , only : import_fields, export_fields + use nuopc_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit + use nuopc_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance + use perf_mod , only : t_startf, t_stopf + use physics_grid , only : global_index_p, get_rlon_all_p, get_rlat_all_p + use physics_grid , only : ngcols => num_global_phys_cols + use physics_grid , only : lsize => columns_on_task + use physics_grid , only : hdim1_d, hdim2_d + use cam_control_mod , only : cam_ctrl_set_orbit + use cam_pio_utils , only : cam_pio_createfile, cam_pio_openfile, cam_pio_closefile, pio_subsystem + use cam_initfiles , only : cam_initfiles_get_caseid, cam_initfiles_get_restdir + use filenames , only : interpret_filename_spec + use pio , only : file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim, PIO_MAX_NAME + use pio , only : pio_closefile, pio_put_att, pio_enddef, pio_nowrite + use pio , only : pio_inq_dimid, pio_inq_varid, pio_inquire_dimension, pio_def_var + use pio , only : pio_initdecomp, pio_freedecomp + use pio , only : pio_read_darray, pio_write_darray + use pio , only : pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling + use pio , only : pio_def_var, pio_get_var, pio_put_var, PIO_INT + use ioFileMod , only : cam_get_file + !$use omp_lib , only : omp_set_num_threads + + implicit none + private ! except + + public :: SetServices + public :: SetVM + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + private :: InitializeP0 + private :: InitializeAdvertise + private :: InitializeRealize + private :: ModelAdvance + private :: ModelSetRunClock + private :: ModelFinalize + private :: cam_read_srfrest + private :: cam_write_srfrest + private :: cam_orbital_init + private :: cam_orbital_update + private :: cam_set_mesh_for_single_column + private :: cam_pio_checkerr + + !-------------------------------------------------------------------------- + ! Private module data + !-------------------------------------------------------------------------- + + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + integer :: nthrds + integer :: ierr ! allocate status + integer , parameter :: dbug_flag = 0 + type(cam_in_t) , pointer :: cam_in + type(cam_out_t) , pointer :: cam_out + integer , pointer :: dof(:) ! global index space decomposition + character(len=256) :: rsfilename_spec_cam ! Filename specifier for restart surface file + character(*) ,parameter :: modName = "(atm_comp_nuopc)" + character(*) ,parameter :: u_FILE_u = & + __FILE__ + + logical :: dart_mode = .false. + logical :: mediator_present + + character(len=CL) :: orb_mode ! attribute - orbital mode + integer :: orb_iyear ! attribute - orbital year + integer :: orb_iyear_align ! attribute - associated with model year + real(R8) :: orb_obliq ! attribute - obliquity in degrees + real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' + character(len=*) , parameter :: orb_variable_year = 'variable_year' + character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + + !Remove once history output is developed for CAMDEN -JN: + real(r8), parameter :: fillvalue = 1.e36_r8 + + real(R8) , parameter :: grid_tol = 1.e-2_r8 ! tolerance for calculated lat/lon vs read in + + type(ESMF_Mesh) :: model_mesh ! model_mesh + type(ESMF_Clock) :: model_clock ! model_clock + +!=============================================================================== +contains +!=============================================================================== + + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' + + rc = ESMF_SUCCESS + + ! the NUOPC gcomp component will register the generic methods + + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! switching to IPD version v03 + + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! set entry point for methods that require specific implementation + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! attach specializing method(s) + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & + specRoutine=DataInitialize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & + specRoutine=ModelSetRunClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ModelFinalize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine SetServices + + !=============================================================================== + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Switch to IPDv03 by filtering all other phaseMap entries + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine InitializeP0 + + !=============================================================================== + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + + ! intput/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + integer :: n + integer :: localpet + character(len=CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet + integer :: shrlogunit ! original log unit + integer :: newlogunit ! new log unit + character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VmGet(vm, localPet=localPet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------------------------------------------------------------- + ! reset shr logging to my log file + !---------------------------------------------------------------------------- + + call set_component_logging(gcomp, localpet==0, newlogunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_log_setLogUnit(newlogunit) + !Set CAM-SIMA log unit to new unit value: + call cam_set_log_unit(newlogunit) + + !---------------------------------------------------------------------------- + ! advertise import/export fields + !---------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nextsw_cday + write(logmsg,*) flds_scalar_index_nextsw_cday + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') + endif + + ! read mediator fields namelists + call read_surface_fields_namelists() + + call NUOPC_CompAttributeGet(gcomp, name="mediator_present", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read (cvalue,*) mediator_present + if (mediator_present) then + call advertise_fields(gcomp, flds_scalar_name, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else + call shr_sys_abort(subname//'Need to set attribute mediator_present') + endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end if + end subroutine InitializeAdvertise + + !=============================================================================== + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + use ESMF, only : ESMF_VMGet + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + type(ESMF_DistGrid) :: distGrid + integer :: spatialDim + integer :: numOwnedElements + real(r8), allocatable :: ownedElemCoords(:) + real(r8) :: lat(lsize) + real(r8) :: latMesh(lsize) + real(r8) :: lon(lsize) + real(r8) :: lonMesh(lsize) + integer :: ncols ! number of local columns + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! Start time of day (sec) + integer :: curr_ymd ! Start date (YYYYMMDD) + integer :: curr_tod ! Start time of day (sec) + integer :: stop_ymd ! Stop date (YYYYMMDD) + integer :: stop_tod ! Stop time of day (sec) + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! Reference time of day (sec) + character(len=cs) :: calendar ! Calendar type + integer :: dtime ! time step increment (sec) + integer :: atm_cpl_dt ! driver atm coupling time step + integer :: nstep ! CAM nstep + real(r8) :: caldayp1 ! CAM calendar day for for next cam time step + integer :: yy,mm,dd ! Temporaries for time query + logical :: perpetual_run ! If in perpetual mode or not + integer :: perpetual_ymd ! Perpetual date (YYYYMMDD) + character(CL) :: cvalue + character(ESMF_MAXSTR) :: convCIM, purpComp + integer :: n,c,g,i,j ! indices + character(len=cs) :: start_type ! infodata start type + character(len=cl) :: caseid ! case ID + character(len=cl) :: ctitle ! case title + character(len=cl) :: model_doi_url ! DOI for CESM model run + logical :: aqua_planet ! Flag to run model in "aqua planet" mode + logical :: brnch_retain_casename ! true => branch run has same caseid as run being branched from + logical :: single_column = .false. + character(len=cl) :: single_column_lnd_domainfile + real(r8) :: scol_lon + real(r8) :: scol_lat + real(r8) :: scol_spval + real(r8) :: eccen + real(r8) :: obliqr + real(r8) :: lambm0 + real(r8) :: mvelpp + !character(len=cl) :: atm_resume_all_inst(num_inst_atm) ! atm resume file + integer :: lbnum + character(CS) :: inst_name + integer :: inst_index + character(CS) :: inst_suffix + integer :: lmpicom + logical :: isPresent, isSet + character(len=512) :: diro + character(len=512) :: logfile + integer :: compid ! component id + integer :: localPet, localPeCount + logical :: initial_run ! startup mode which only requires a minimal initial file + logical :: restart_run ! continue a previous run; requires a restart file + logical :: branch_run ! branch from a previous run; requires a restart file + character(len=CL) :: tempc1,tempc2 + integer :: shrlogunit ! original log unit + real(r8) , parameter :: radtodeg = 180.0_r8/shr_const_pi + integer , parameter :: aqua_perpetual_ymd = 321 + character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + character(len=*), parameter :: format = "('("//trim(subname)//") :',A)" + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + + call shr_log_setLogUnit (iulog) + + !---------------------------------------------------------------------------- + ! generate local mpi comm + !---------------------------------------------------------------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, localpet=localPet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=lmpicom, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(localPeCount == 1) then + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif + +!$ call omp_set_num_threads(nthrds) + + !---------------------------------------------------------------------------- + ! determine instance information + !---------------------------------------------------------------------------- + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + inst_name = 'ATM'//inst_suffix + ! Set filename specifier for restart surface file + ! (%c=caseid, $y=year, $m=month, $d=day, $s=seconds in day) + rsfilename_spec_cam = '%c.cam' // trim(inst_suffix) // '.rs.%y-%m-%d-%s.nc' + + !---------------------------------------------------------------------------- + ! initialize cam mpi (needed for masterproc below) + !---------------------------------------------------------------------------- + + call spmd_init(lmpicom) + + !---------------------- + ! Initialize cam - needed in realize phase to get grid information + !---------------------- + + call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + read(cvalue,*) compid + call cam_instance_init(compid, inst_name, inst_index, inst_suffix) + + !---------------------- + ! Initialize cam - needed in realize phase to get grid information + !---------------------- + + if (masterproc) then + write(iulog,format) "CAM atm model initialization" + end if #if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','atm_comp_nuopc_InitializeRealize:start::',lbnum) - end if + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','atm_comp_nuopc_InitializeRealize:start::',lbnum) + endif #endif - !---------------------- - ! Obtain and load orbital values - !---------------------- - - call cam_orbital_init(gcomp, iulog, masterproc, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, & - lambm0, mvelpp, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) - - !---------------------- - ! Obtain attributes - !---------------------- - - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) caseid - ctitle=caseid - - ! starting info - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) start_type - call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', & - value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) brnch_retain_casename - - ! single column input - call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) scol_lon - call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) scol_lat - call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) scol_spval - call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', & - value=single_column_lnd_domainfile, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (scol_lon > scol_spval .and. scol_lat > scol_spval) then - if (trim(single_column_lnd_domainfile) /= 'UNSET') then - single_column = .true. - else - call shr_sys_abort(subname// & - 'single_column_lnd_domainfile cannot be null for single column mode') - end if - else - single_column = .false. - end if - - ! aqua planet input - call NUOPC_CompAttributeGet(gcomp, name='aqua_planet', & - value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) aqua_planet - - ! perpetual input - call NUOPC_CompAttributeGet(gcomp, name='perpetual', value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) perpetual_run - call NUOPC_CompAttributeGet(gcomp, name='perpetual_ymd', & - value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) perpetual_ymd - - ! TODO: query the config attributes for the number of instances - ! ASSUMES multi-driver - - ! TODO: must obtain model_doi_url from gcomp - for now hardwire to - ! 'not_set' - model_doi_url = 'not_set' - - ! TODO: obtain dart_mode as a attribute variable - ! DART always starts up as an initial run. - if (dart_mode) then - initial_run = .true. - restart_run = .false. - branch_run = .false. - end if - - ! Initialize CAM, allocate cam_in and cam_out and determine - ! atm decomposition (needed to initialize gsmap) - ! for an initial run, cam_in and cam_out are allocated in cam_init - ! for a restart/branch run, cam_in and cam_out are allocated in restart - ! - !TODO: the following strings must not be hard-wired - must have module variables - ! like seq_infodata_start_type_type - maybe another entry in flds_mod? - - initial_run = .false. - restart_run = .false. - branch_run = .false. - if (trim(start_type) == trim('startup')) then - initial_run = .true. - else if (trim(start_type) == trim('continue')) then - restart_run = .true. - else if (trim(start_type) == trim('branch')) then - branch_run = .true. - else - call shr_sys_abort(subname//' ERROR: unknown start_type') - end if - - ! Get properties from clock - call ESMF_ClockGet(clock, & - currTime=currTime, startTime=startTime, stopTime=stopTime, & - refTime=RefTime, timeStep=timeStep, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_TimeGet(currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,curr_ymd) - - call ESMF_TimeGet(startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,start_ymd) - - call ESMF_TimeGet(stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,stop_ymd) - - call ESMF_TimeGet(refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,ref_ymd) - - call ESMF_TimeIntervalGet(timeStep, s=dtime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_TimeGet(currTime, calkindflag=esmf_caltype, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - if (esmf_caltype == ESMF_CALKIND_NOLEAP) then - calendar = shr_cal_noleap - else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then - calendar = shr_cal_gregorian - else - call shr_sys_abort(subname//'ERROR:: bad calendar for ESMF') - end if - - ! Initialize module orbital values and update orbital - - call cam_orbital_init(gcomp, iulog, masterproc, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, & - lambm0, mvelpp, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! Initialize CAM - if (aqua_planet) then - perpetual_run = .true. - perpetual_ymd = aqua_perpetual_ymd - end if - - call cam_init( & - caseid=caseid, ctitle=ctitle, model_doi_url=model_doi_url, & - initial_run_in=initial_run, restart_run_in=restart_run, & - branch_run_in=branch_run, & -! post_assim_in=dart_mode, & - calendar=calendar, brnch_retain_casename=brnch_retain_casename, & - aqua_planet=aqua_planet, & - single_column=single_column, scmlat=scol_lat, scmlon=scol_lon, & - eccen=eccen, obliqr=obliqr, lambm0=lambm0, mvelpp=mvelpp, & - perpetual_run=perpetual_run, perpetual_ymd=perpetual_ymd, & - dtime=dtime, start_ymd=start_ymd, start_tod=start_tod, & - ref_ymd=ref_ymd, ref_tod=ref_tod, & - curr_ymd=curr_ymd, curr_tod=curr_tod, & - stop_ymd=stop_ymd, stop_tod=stop_tod, & - cam_out=cam_out, cam_in=cam_in) - - if (mediator_present) then - - if (single_column) then - - call cam_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - else - - ! generate the dof - lsize = columns_on_task - allocate(dof(lsize), stat=astat) - if (astat /= 0) then - write(tempc1, *) 'Allocate ERROR for dof, '//to_str(astat) - call shr_sys_abort(subname//trim(tempc1)) - end if - do n = 1, lsize - dof(n) = global_index_p(n) - end do - - ! create distGrid from global index array - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=dof, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! read in the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', & - value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - mesh = ESMF_MeshCreate(filename=trim(cvalue), & - fileformat=ESMF_FILEFORMAT_ESMFMESH, & - elementDistgrid=Distgrid, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (masterproc) then - write(iulog,*)'mesh file for cam domain is ',trim(cvalue) - end if - - ! obtain mesh lats and lons - call ESMF_MeshGet(Emesh, spatialDim=spatialDim, & - numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (numOwnedElements /= lsize) then - write(tempc1, '(i10)') numOwnedElements - write(tempc2, '(i10)') lsize - call ESMF_LogWrite(trim(subname)//": ERROR numOwnedElements "// & - trim(tempc1)//" not equal to local size "// & - trim(tempc2), ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - end if - allocate(ownedElemCoords(spatialDim*numOwnedElements), stat=astat) - if (astat /= 0) then - write(tempc1, *) 'Allocate ERROR for ownedElemCoords, ', & - to_str(astat) - call shr_sys_abort(subname//trim(tempc1)) - end if - allocate(lonMesh(lsize), stat=astat) - if (astat /= 0) then - write(tempc1, *) 'Allocate ERROR for lonMesh ', to_str(astat) - call shr_sys_abort(subname//trim(tempc1)) - end if - allocate(latMesh(lsize), stat=astat) - if (astat /= 0) then - write(tempc1, *) 'Allocate ERROR for latMesh ', to_str(astat) - call shr_sys_abort(subname//trim(tempc1)) - end if - call ESMF_MeshGet(Emesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - do n = 1,lsize - lonMesh(n) = ownedElemCoords(2*n-1) - ! Make sure we are 0 to 360 - if (lonMesh(n) < 0.0_r8) then - lonMesh(n) = lonMesh(n) + 180.0_r8 - end if - if (lonMesh(n) >= 360.0_r8) then - lonMesh(n) = lonMesh(n) - 360.0_r8 - end if - latMesh(n) = ownedElemCoords(2*n) - end do - - ! obtain internally generated cam lats and lons - allocate(lon(lsize), stat=astat) - if (astat /= 0) then - write(tempc1, *) 'Allocate ERROR for lon ', to_str(astat) - call shr_sys_abort(subname//trim(tempc1)) - end if - lon(:) = 0._r8 - allocate(lat(lsize), stat=astat) - if (astat /= 0) then - write(tempc1, *) 'Allocate ERROR for lat ', to_str(astat) - call shr_sys_abort(subname//trim(tempc1)) - end if - lat(:) = 0._r8 - n = 0 - ! latitudes and longitudes returned in radians - call get_rlat_all_p(lsize, lats) - call get_rlon_all_p(lsize, lons) - do n = 1, lsize - lat(n) = lats(n)*radtodeg - lon(n) = lons(n)*radtodeg - if (lon(n) >= 360.0_r8) then - lon(n) = lon(n) - 360.0_r8 - end if - end do - - ! Check diffs between internally generated lons and read values - do n = 1, lsize - if (abs(lonMesh(n) - lon(n)) > grid_tol) then - write(local_iulog, 100) n, lon(n), lonMesh(n), & - abs(lonMesh(n)-lon(n)) -100 format('ERROR: CAM n, lonmesh(n), lon(n), diff_lon = ',i6, & - 2(f21.13,3x),d21.5) - end if - if (abs(latMesh(n) - lat(n)) > grid_tol) then - write(local_iulog, 100) n, lat(n), latMesh(n), & - abs(latMesh(n)-lat(n)) -101 format('ERROR: CAM n, latmesh(n), lat(n), diff_lat = ',i6, & - 2(f21.13,3x),d21.5) - end if - end do - - ! deallocate memory - deallocate(ownedElemCoords) - deallocate(lon, lonMesh) - deallocate(lat, latMesh) - - end if ! if single_column - - ! realize the actively coupled fields - call realize_fields(gcomp, Emesh, flds_scalar_name, & - flds_scalar_num, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! Create cam export array and set the state scalars - call export_fields(gcomp, cam_out, rc=rc ) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call get_grid_dims(hdim1_d, hdim2_d) - call State_SetScalar(dble(hdim1_d), flds_scalar_index_nx, & - exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call State_SetScalar(dble(hdim2_d), flds_scalar_index_ny, & - exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! diagnostics - if (dbug_flag > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - end if ! end of mediator_present if-block - - call shr_file_setLogUnit (shrlogunit) + !---------------------- + ! Obtain and load orbital values + !---------------------- + + call cam_orbital_init(gcomp, iulog, masterproc, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) + + !---------------------- + ! Obtain attributes + !---------------------- + + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) caseid + ctitle=caseid + + ! starting info + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) start_type + call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) brnch_retain_casename + + ! single column input + call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_lon + call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_lat + call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_spval + + ! For single column mode in cam need to have a valid single_column_lnd_domainfile for the mask + call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (scol_lon > scol_spval .and. scol_lat > scol_spval) then + if (trim(single_column_lnd_domainfile) /= 'UNSET') then + single_column = .true. + else + call shr_sys_abort('single_column_lnd_domainfile cannot be null for single column mode') + end if + else + single_column = .false. + end if + + ! aqua planet input + call NUOPC_CompAttributeGet(gcomp, name='aqua_planet', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) aqua_planet + + ! perpetual input + call NUOPC_CompAttributeGet(gcomp, name='perpetual', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) perpetual_run + call NUOPC_CompAttributeGet(gcomp, name='perpetual_ymd', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) perpetual_ymd + + ! TODO: query the config attributes for the number of instances - ASSUMES multi-driver + + ! TODO: must obtain model_doi_url from gcomp - for now hardwire to 'not_set' + model_doi_url = 'not_set' + + ! Initialize CAM, allocate cam_in and cam_out and determine + ! atm decomposition (needed to initialize gsmap) + ! for an initial run, cam_in and cam_out are allocated in cam_init + ! for a restart/branch run, cam_in and cam_out are allocated in restart + ! + !TODO: the following strings must not be hard-wired - must have module variables + ! like seq_infodata_start_type_type - maybe another entry in flds_mod? + + initial_run = .false. + restart_run = .false. + branch_run = .false. + if (trim(start_type) == trim('startup')) then + initial_run = .true. + else if (trim(start_type) == trim('continue') ) then + restart_run = .true. + else if (trim(start_type) == trim('branch')) then + branch_run = .true. + else + call shr_sys_abort( subname//' ERROR: unknown start_type' ) + end if + + ! DART always starts up as an initial run. + call NUOPC_CompAttributeGet(gcomp, name='data_assimilation_atm', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) dart_mode + end if + if (dart_mode) then + initial_run = .true. + restart_run = .false. + branch_run = .false. + end if + + ! Get properties from clock + call ESMF_ClockGet( clock, & + currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & + timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,start_ymd) + + call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,stop_ymd) + + call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,ref_ymd) + + call ESMF_TimeIntervalGet( timeStep, s=dtime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (esmf_caltype == ESMF_CALKIND_NOLEAP) then + calendar = shr_cal_noleap + else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then + calendar = shr_cal_gregorian + else + call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) + end if + + ! Initialize module orbital values and update orbital + call cam_orbital_init(gcomp, iulog, masterproc, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize CAM + if (aqua_planet) then + perpetual_run = .true. + perpetual_ymd = aqua_perpetual_ymd + end if + + call cam_init( & + caseid=caseid, & + ctitle=ctitle, & + model_doi_url=model_doi_url, & + initial_run_in=initial_run, & + restart_run_in=restart_run, & + branch_run_in=branch_run, & + post_assim_in=dart_mode, & + calendar=calendar, & + brnch_retain_casename=brnch_retain_casename, & + aqua_planet=aqua_planet, & + single_column=single_column, & + scmlat=scol_lat, & + scmlon=scol_lon, & + eccen=eccen, & + obliqr=obliqr, & + lambm0=lambm0, & + mvelpp=mvelpp, & + perpetual_run=perpetual_run, & + perpetual_ymd=perpetual_ymd, & + dtime=dtime, & + start_ymd=start_ymd, & + start_tod=start_tod, & + ref_ymd=ref_ymd, & + ref_tod=ref_tod, & + stop_ymd=stop_ymd, & + stop_tod=stop_tod, & + curr_ymd=curr_ymd, & + curr_tod=curr_tod, & + cam_out=cam_out, & + cam_in=cam_in) + + if (mediator_present) then + + if (single_column) then + + call cam_set_mesh_for_single_column(scol_lon, scol_lat, model_mesh, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(dof(1), stat=ierr) + call check_allocate(ierr, subname, 'dof(1)', file=__FILE__, line=__LINE__) + dof(1) = 1 + + else + + ! generate the dof + allocate(dof(lsize), stat=ierr) + call check_allocate(ierr, subname, 'dof(lsize)', file=__FILE__, line=__LINE__) + do i = 1, lsize + dof(i) = global_index_p(i) + end do + + ! create distGrid from global index array + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=dof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! read in the mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + model_mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistgrid=Distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,*)'mesh file for cam domain is ',trim(cvalue) + end if + + ! obtain mesh lats and lons + call ESMF_MeshGet(model_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (numOwnedElements /= lsize) then + write(tempc1,'(i10)') numOwnedElements + write(tempc2,'(i10)') lsize + call ESMF_LogWrite(trim(subname)//": ERROR numOwnedElements "// trim(tempc1) // & + " not equal to local size "// trim(tempc2), ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + allocate(ownedElemCoords(spatialDim*numOwnedElements), stat=ierr) + call check_allocate(ierr, subname, 'ownedElemCoords(spatialDim*numOwnedElements)', & + file=__FILE__, line=__LINE__) + call ESMF_MeshGet(model_mesh, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + lonMesh(n) = ownedElemCoords(2*n-1) + latMesh(n) = ownedElemCoords(2*n) + end do + + ! obtain internally generated cam lats and lons + lon(:) = 0._r8 + lat(:) = 0._r8 + ! latitudes and longitudes returned in radians + call get_rlat_all_p(lsize, lat) + call get_rlon_all_p(lsize, lon) + do i=1, lsize + lat(i) = lat(i)*radtodeg + lon(i) = lon(i)*radtodeg + end do + + ! error check differences between internally generated lons and those read in + do n = 1,lsize + if (abs(lonMesh(n) - lon(n)) > grid_tol .and. .not. & + abs(abs(lonMesh(n) - lon(n))- 360._r8) < grid_tol) then + write(6,100)n,lon(n),lonMesh(n), abs(lonMesh(n)-lon(n)) +100 format('ERROR: CAM n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5) + call shr_sys_abort() + end if + if (abs(latMesh(n) - lat(n)) > grid_tol) then + write(6,100)n,lat(n),latMesh(n), abs(latMesh(n)-lat(n)) +101 format('ERROR: CAM n, latmesh(n), lat(n), diff_lat = ',i6,2(f21.13,3x),d21.5) + call shr_sys_abort() + end if + end do + + ! deallocate memory + deallocate(ownedElemCoords) + + end if ! end of if single_column + + ! realize the actively coupled fields + call realize_fields(gcomp, model_mesh, flds_scalar_name, flds_scalar_num, single_column, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create model_clock as a module variable - needed for generating streams + model_clock = clock + + ! Create cam export array and set the state scalars + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call State_SetScalar(dble(hdim1_d), flds_scalar_index_nx, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(dble(hdim2_d), flds_scalar_index_ny, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! diagnostics + if (dbug_flag > 1) then + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + end if ! end of mediator_present if-block + + call shr_log_setLogUnit (shrlogunit) #if (defined _MEMTRACE) - if(masterproc) then - write(iulog,*) TRIM(Sub), ':end::' - lbnum=1 - call memmon_dump_fort('memmon.out','atm_comp_nuopc_InitializeRealize:end::',lbnum) - call memmon_reset_addr() - end if + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','atm_comp_nuopc_InitializeRealize:end::',lbnum) + call memmon_reset_addr() + endif #endif - if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end if - - end subroutine InitializeRealize - - !========================================================================== - subroutine DataInitialize(gcomp, rc) - use string_utils, only: to_str - use cam_comp, only: cam_run1 - use cam_comp, only: cam_timestep_init - - ! Dummy arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! Local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: currTime ! Current time - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Field) :: field - character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) - character(len=ESMF_MAXSTR) :: fieldName - integer :: n, fieldCount - integer :: astat - integer :: shrlogunit ! original log unit - integer(ESMF_KIND_I8) :: stepno ! time step - integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step - integer :: nstep ! CAM nstep - real(r8) :: nextsw_cday ! calendar of next atm shortwave - logical :: importDone ! true => import data is valid - logical :: atCorrectTime ! true => field is at correct time - character(len=CL) :: cvalue - character(len=*),parameter :: subname=trim(modName)//':(DataInitialize) ' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end if + + end subroutine InitializeRealize + + !=============================================================================== + subroutine DataInitialize(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime ! Current time + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Field) :: field + character(ESMF_MAXSTR),allocatable :: fieldNameList(:) + character(ESMF_MAXSTR) :: fieldName + integer :: n, fieldCount + integer :: shrlogunit ! original log unit + integer(ESMF_KIND_I8) :: stepno ! time step + integer :: atm_cpl_dt ! driver atm coupling time step + logical :: importDone ! true => import data is valid + logical :: atCorrectTime ! true => field is at correct time + character(CL) :: cvalue + character(len=*),parameter :: subname=trim(modName)//':(DataInitialize) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + + call shr_log_getLogUnit (shrlogunit) + call shr_log_setLogUnit (iulog) #if (defined _MEMTRACE) - if (masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','atm_comp_nuopc_DataInitialize:start::',lbnum) - end if + if (masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','atm_comp_nuopc_DataInitialize:start::',lbnum) + endif #endif - !-------------------------------- - ! Query the Component for its clock, importState and exportState - !-------------------------------- - - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! get the current time out of the clock - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - if (dbug_flag > 1) then - call log_clock_advance(clock, 'CAM', iulog, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - !--------------------------------------------------------------- - if (mediator_present) then - !--------------------------------------------------------------- - - ! Determine if all the import state has been initialized - ! And if not initialized, then return - - call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - allocate(fieldNameList(fieldCount), stat=astat) - if (astat /= 0) then - write(fieldname, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(fieldname)) - end if - call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - importDone = .true. - do n=1, fieldCount - call ESMF_StateGet(importState, itemName=fieldNameList(n), & - field=field, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - atCorrectTime = NUOPC_IsAtTime(field, currTime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - if (.not. atCorrectTime) then - call ESMF_LogWrite(subname// & - "CAM - Initialize-Data-Dependency NOT YET SATISFIED!!!", & - ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - importDone = .false. - exit ! break out of the loop when first not satisfied found - end if - end do - deallocate(fieldNameList) - - ! *** Import state has not been initialized - RETURN **** - if (.not. importDone) then - ! Simply return if the import has not been initialized - call ESMF_LogWrite(subname//"CAM - Initialize-Data-Dependency "// & - "Returning to mediator without doing tphysbc", & - ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - RETURN - end if - - ! *** Import state has been initialized - continue with tphysbc *** - call ESMF_LogWrite(subname// & - "CAM - Initialize-Data-Dependency doing tphysbc", & - ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! get the current step number and coupling interval - call ESMF_ClockGet(clock, TimeStep=timeStep, advanceCount=stepno, & - rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call ESMF_TimeIntervalGet(timeStep, s=atm_cpl_dt, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! For initial run, unpack the import state, run cam radiation/clouds - ! and return. - ! For restart run, read the import state from the restart and - ! run radiation/clouds and return - - ! Note - cam_run1 is called only for the purposes of finishing the - ! flux averaged calculation to compute cam-out - ! Note - cam_run1 is called on restart only to have cam internal - ! state consistent with the - ! cam_out state sent to the coupler - - if (stepno == 0) then - call import_fields(gcomp, cam_in, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call cam_read_srfrest(gcomp, clock, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call import_fields(gcomp, cam_in, restart_init=.true., rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - call cam_timestep_init () - call cam_run1 (cam_in, cam_out) - call export_fields(gcomp, cam_out, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - !CAMDEN TODO Remove once radiation has been fully implemented. -JN - ! Also note that this will need to be refactored to reflect the - ! recent CAM changes. + !-------------------------------- + ! Query the Component for its clock, importState and exportState + !-------------------------------- + + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get the current time out of the clock + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call log_clock_advance(clock, 'CAM', iulog, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + !--------------------------------------------------------------- + if (mediator_present) then + !--------------------------------------------------------------- + + ! Determine if all the import state has been initialized + ! And if not initialized, then return + + call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldNameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + importDone = .true. + do n=1, fieldCount + call ESMF_StateGet(importState, itemName=fieldNameList(n), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + atCorrectTime = NUOPC_IsAtTime(field, currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. atCorrectTime) then + call ESMF_LogWrite("CAM - Initialize-Data-Dependency NOT YET SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + importDone = .false. + exit ! break out of the loop when first not satisfied found + end if + end do + deallocate(fieldNameList) + + ! *** Import state has not been initialized - RETURN **** + + if (.not. importDone) then + ! Simply return if the import has not been initialized + call ESMF_LogWrite("CAM - Initialize-Data-Dependency Returning to mediator without doing tphysbc", & + ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + RETURN + end if + + ! *** Import state has been initialized - continue with tphysbc *** + + call ESMF_LogWrite("CAM - Initialize-Data-Dependency doing tphysbc", ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get the current step number and coupling interval + call ESMF_ClockGet( clock, TimeStep=timeStep, advanceCount=stepno, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet( timeStep, s=atm_cpl_dt, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! For initial run, unpack the import state, run cam radiation/clouds and return + ! For restart run, read the import state from the restart and run radiation/clouds and return + + ! Note - cam_run1 is called only for the purposes of finishing the + ! flux averaged calculation to compute cam-out + ! Note - cam_run1 is called on restart only to have cam internal state consistent with the + ! cam_out state sent to the coupler + + if (stepno == 0) then + call import_fields( gcomp, cam_in, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call cam_timestep_init() + call cam_run1 ( cam_in, cam_out ) + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call cam_read_srfrest( gcomp, clock, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call import_fields( gcomp, cam_in, restart_init=.true., rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call cam_timestep_init() + call cam_run1 ( cam_in, cam_out ) + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + +!Remove once radiation (nextsw_cday) has been enabled in CAM-SIMA -JN. #if 0 - ! Compute time of next radiation computation, like in run method for exact restart - dtime = get_step_size() - nstep = get_nstep() - if (nstep < 1 .or. dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 - else - call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') - end if - - call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return + ! Compute time of next radiation computation + call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif - ! diagnostics - if (dbug_flag > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if + ! diagnostics + if (dbug_flag > 1) then + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif - ! CAM data is now fully initialized + ! CAM data is now fully initialized - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount), stat=astat) - if (astat /= 0) then - write(fieldname, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(fieldname)) - end if - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return + allocate(fieldNameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n=1, fieldCount - call ESMF_StateGet(exportState, itemName=fieldNameList(n), & - field=field, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return + do n=1, fieldCount + call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end do - deallocate(fieldNameList) + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + deallocate(fieldNameList) - ! check whether all Fields in the exportState are "Updated" - if (NUOPC_IsUpdated(exportState)) then - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", & - value="true", rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return + ! check whether all Fields in the exportState are "Updated" + if (NUOPC_IsUpdated(exportState)) then + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname// & - "CAM - Initialize-Data-Dependency SATISFIED!!!", & - ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if + call ESMF_LogWrite("CAM - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !--------------------------------------------------------------- - else ! mediator is not present - !--------------------------------------------------------------- + !--------------------------------------------------------------- + else ! mediator is not present + !--------------------------------------------------------------- - call cam_timestep_init () - call cam_run1 (cam_in, cam_out) + call cam_timestep_init() + call cam_run1 ( cam_in, cam_out ) - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", & - value="true", rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + end if - ! End redirection of share output to cam log - call shr_file_setLogUnit (shrlogunit) + ! End redirection of share output to cam log + call shr_log_setLogUnit (shrlogunit) #if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','atm_comp_nuopc_DataInitialize:end::',lbnum) - end if + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','atm_comp_nuopc_DataInitialize:end::',lbnum) + endif #endif - if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end if - - end subroutine DataInitialize - - !=========================================================================== - subroutine ModelAdvance(gcomp, rc) - use cam_comp, only: cam_run1 - - use cam_comp, only: cam_run2, cam_run3, cam_run4 - use cam_comp, only: cam_timestep_init - use cam_comp, only: cam_timestep_final - - ! Run CAM - - ! Dummy arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! Local variables - type(ESMF_VM) :: vm - type(ESMF_Clock) :: clock - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: time - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: nextTime ! Next timestep time - type(ESMF_TimeInterval) :: timeStep ! Clock, time-step - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - character(CL) :: cvalue - integer :: shrlogunit ! original log unit - character(CL) :: case_name ! case name - real(r8) :: eccen - real(r8) :: obliqr - real(r8) :: lambm0 - real(r8) :: mvelpp - logical :: dosend ! true => send data back to driver - integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step - integer :: ymd_sync ! Sync ymd - 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 ! CAM current date (YYYYMMDD) - integer :: yr ! CAM current year - integer :: mon ! CAM current month - integer :: day ! CAM current day - integer :: tod ! CAM current time of day (sec) - real(r8) :: caldayp1 ! CAM calendar day for for next cam time step - real(r8) :: nextsw_cday ! calendar of next atm shortwave - logical :: rstwr ! .true. ==> write restart file before returning - logical :: nlend ! Flag signaling last time-step - integer :: lbnum - integer :: localPet, localPeCount - logical :: first_time = .true. - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !$ call omp_set_num_threads(localPeCount) - - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end if + + end subroutine DataInitialize + + !=============================================================================== + subroutine ModelAdvance(gcomp, rc) + + use ESMF, only : ESMF_GridCompGet, esmf_vmget, esmf_vm + ! Run CAM + + ! Input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: time + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: nextTime ! Next timestep time + type(ESMF_TimeInterval) :: timeStep ! Clock, time-step + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + character(CL) :: cvalue + integer :: shrlogunit ! original log unit + character(CL) :: case_name ! case name + real(r8) :: eccen + real(r8) :: obliqr + real(r8) :: lambm0 + real(r8) :: mvelpp + logical :: dosend ! true => send data back to driver + integer :: dtime ! time step increment (sec) + integer :: ymd_sync ! Sync ymd + 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 ! CAM current date (YYYYMMDD) + integer :: yr ! CAM current year + integer :: mon ! CAM current month + integer :: day ! CAM current day + integer :: tod ! CAM current time of day (sec) + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend ! Flag signaling last time-step + integer :: lbnum + integer :: localPet, localPeCount + logical :: first_time = .true. + logical :: do_ncdata_check !Flag notifying SIMA if it is OK to perform a snapshot check + character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + +!$ call omp_set_num_threads(nthrds) + + call shr_log_getLogUnit (shrlogunit) + call shr_log_setLogUnit (iulog) #if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','atm_comp_nuopc_ModelAdvance:start::',lbnum) - end if + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','atm_comp_nuopc_ModelAdvance:start::',lbnum) + endif #endif - !-------------------------------- - ! Query the Component for its clock, importState and exportState - !-------------------------------- - - call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - if (dbug_flag > 1) then - call log_clock_advance(clock, 'CAM', iulog, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - !-------------------------------- - ! Determine current time - !-------------------------------- - - call ESMF_ClockGet(clock, currTime=currTime) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, & - s=tod_sync, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - !---------------------- - ! Update and load orbital parameters - !---------------------- - - if (trim(orb_mode) == trim(orb_variable_year) .or. first_time) then - call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, & - lambm0, mvelpp, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) - end if - first_time = .false. - - !-------------------------------- - ! Run cam - !-------------------------------- - - ! Unpack import state - if (mediator_present) then - call t_startf ('CAM_import') - call State_GetScalar(importState, flds_scalar_index_nextsw_cday, & - nextsw_cday, flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call State_diagnose(importState, string=subname//':IS', rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call import_fields(gcomp, cam_in, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call t_stopf ('CAM_import') - end if - - dosend = .false. - do while (.not. dosend) - - ! TODO: This is currently hard-wired - is there a better way for nuopc? - ! Need to not return when nstep = 0 and return when nstep = 1 - ! Note that the model clock is updated at the end of the time step - ! not at the beginning - if (get_nstep() > 0) then - dosend = .true. - end if - - ! Determine if time to write restart - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', & - alarm=alarm, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ChkErr(rc, __LINE__, u_FILE_u)) return - rstwr = .true. - call ESMF_AlarmRingerOff(alarm, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - rstwr = .false. - end if - - ! Determine if time to stop - call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', & - alarm=alarm, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - nlend = .true. - else - nlend = .false. - end if - - ! Run CAM (run2, run3, run4) - - call t_startf ('CAM_run2') - call cam_run2(cam_out, cam_in) - call t_stopf ('CAM_run2') - - call t_startf ('CAM_run3') - call cam_run3(cam_out) - call t_stopf ('CAM_run3') - - call t_startf ('CAM_run4') - call cam_run4(cam_out, cam_in, rstwr, nlend, yr_spec=yr_sync, & - mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) - call t_stopf ('CAM_run4') - - call cam_timestep_final() - ! Advance cam time step - call t_startf ('CAM_adv_timestep') - call advance_timestep() - call t_stopf ('CAM_adv_timestep') - call cam_timestep_init() - - ! Run CAM4,5,6 radiation/clouds (run1 / tphysbc) - call t_startf ('CAM_run1') - call cam_run1 (cam_in, cam_out) - call t_stopf ('CAM_run1') - end do - - if (mediator_present) then - ! Set export fields - call t_startf ('CAM_export') - call export_fields(gcomp, cam_out, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call t_stopf ('CAM_export') - - ! Set the coupling scalars - ! Return time of next radiation calculation - albedos will need to be - ! calculated by each surface model at this time - - call ESMF_ClockGet(clock, TimeStep=timeStep, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call ESMF_TimeIntervalGet(timeStep, s=atm_cpl_dt, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - !CAMDEN TODO Remove once radiation has been fully implemented. -JN + !-------------------------------- + ! Query the Component for its clock, importState and exportState + !-------------------------------- + + call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call log_clock_advance(clock, 'CAM', iulog, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + !-------------------------------- + ! Determine current time + !-------------------------------- + + call ESMF_ClockGet( clock, currTime=currTime) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Update and load orbital parameters + !---------------------- + + if (trim(orb_mode) == trim(orb_variable_year) .or. first_time) then + call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) + end if + first_time = .false. + + !-------------------------------- + ! Run cam + !-------------------------------- + + ! Unpack import state + if (mediator_present) then + call t_startf ('CAM_import') + call State_diagnose(importState, string=subname//':IS', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call import_fields( gcomp, cam_in, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf ('CAM_import') + end if + + dosend = .false. + do_ncdata_check = .false. + do while (.not. dosend) + + ! TODO: This is currently hard-wired - is there a better way for nuopc? + ! Need to not return when nstep = 0 and return when nstep = 1 + ! Note that the model clock is updated at the end of the time step not at the beginning + if (get_nstep() > 0) then + dosend = .true. + do_ncdata_check = .true. + end if + + ! Determine if time to write restart + + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + rstwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + rstwr = .false. + endif + + ! Determine if time to stop + + call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + nlend = .true. + else + nlend = .false. + endif + + ! Run CAM (run2, run3, run4) + ! This includes the "physics_after_coupler" CCPP physics group. + + call t_startf ('CAM_run2') + call cam_run2( cam_out, cam_in ) + call t_stopf ('CAM_run2') + + call t_startf ('CAM_run3') + call cam_run3( cam_out ) + call t_stopf ('CAM_run3') + + call t_startf ('CAM_run4') + call cam_run4( cam_out, cam_in, rstwr, nlend, & + yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) + call t_stopf ('CAM_run4') + call cam_timestep_final(do_ncdata_check=do_ncdata_check) + + ! Advance cam time step + + call t_startf ('CAM_adv_timestep') + call advance_timestep() + call t_stopf ('CAM_adv_timestep') + call cam_timestep_init() + + ! Run CAM (run1) + ! This includes the "physics_before_coupler" CCPP physics group. + + call t_startf ('CAM_run1') + call cam_run1 ( cam_in, cam_out ) + call t_stopf ('CAM_run1') + + end do + + if (mediator_present) then + ! Set export fields + call t_startf ('CAM_export') + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf ('CAM_export') + + ! Set the coupling scalars +!Remove once radiation (nextsw_cday) has been enabled in CAM-SIMA -JN. #if 0 - dtime = get_step_size() - if (dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 - else - call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') - end if - - call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, & - exportState, flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return + ! Return time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif - ! diagnostics - if (dbug_flag > 1) then - call State_diagnose(exportState, string=subname//':ES',rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (masterproc) then - call log_clock_advance(clock, 'CAM', iulog, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - end if - - ! Write merged surface data restart file if appropriate - if (rstwr) then - call cam_write_srfrest(gcomp, yr_spec=yr_sync, & - mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - else - - ! if there is no mediator, then write the clock info to a driver restart file - if (rstwr) then - call cam_write_clockrest(clock, yr_sync, mon_sync, day_sync, & - tod_sync, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - end if - - ! Check for consistency of internal cam clock with master sync clock - ! Note that the driver clock has not been updated yet - so at this point - ! CAM is actually 2 coupling intervals (or physics time steps) ahead - ! of the driver clock - dtime = get_step_size() - call get_curr_date(yr, mon, day, tod, offset=-2*dtime) - ymd = yr*10000 + mon*100 + day - tod = tod - - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call ESMF_TimeGet(currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, & - s=tod_sync, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) - - if ((ymd /= ymd_sync) .and. (tod /= tod_sync))then - write(iulog,*)' cam ymd=',ymd, ' cam tod= ',tod - write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync - call shr_sys_abort(subname// & - ': CAM clock is not in sync with master Sync Clock') - end if + ! diagnostics + if (dbug_flag > 1) then + call State_diagnose(exportState, string=subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + call log_clock_advance(clock, 'CAM', iulog, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif + + ! Write merged surface data restart file if appropriate + if (rstwr) then + call cam_write_srfrest( gcomp, & + yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + else + + ! if there is no mediator, then write the clock info to a driver restart file + if (rstwr) then + call cam_write_clockrest( clock, yr_sync, mon_sync, day_sync, tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end if + + ! Check for consistency of internal cam clock with master sync clock + ! Note that the driver clock has not been updated yet - so at this point + ! CAM is actually 2 coupling intervals (or physics time steps) ahead of the driver clock + dtime = get_step_size() + call get_curr_date( yr, mon, day, tod, offset=-2*dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) + + if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) )then + write(iulog,*)' cam ymd=',ymd ,' cam tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call shr_sys_abort( subname//': CAM clock is not in sync with master Sync Clock' ) + end if #if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','atm_comp_nuopc_ModelAdvance:end::',lbnum) - end if + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','atm_comp_nuopc_ModelAdvance:end::',lbnum) + endif #endif - !-------------------------------- - ! Reset shr logging to my original values - !-------------------------------- - - call shr_file_setLogUnit (shrlogunit) - - end subroutine ModelAdvance - - !========================================================================== - - subroutine ModelSetRunClock(gcomp, rc) - - ! Dummy arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! Local variables - type(ESMF_Clock) :: mclock, dclock - type(ESMF_Time) :: mcurrtime, dcurrtime - type(ESMF_Time) :: mstoptime - type(ESMF_TimeInterval) :: mtimestep, dtimestep - character(len=256) :: cvalue - character(len=256) :: restart_option ! Restart option units - integer :: restart_n ! Number until restart interval - integer :: restart_ymd ! Restart date (YYYYMMDD) - type(ESMF_ALARM) :: restart_alarm - character(len=256) :: stop_option ! Stop option units - integer :: stop_n ! Number until stop interval - integer :: stop_ymd ! Stop date (YYYYMMDD) - type(ESMF_ALARM) :: stop_alarm - character(len=128) :: name - integer :: alarmcount - character(len=*),parameter :: subname=trim(modName)//':(ModelSetRunClock) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! query the Component for its clocks - call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - !----------------------------------------------------------------------- - ! force model clock currtime and timestep to match driver and set stoptime - !----------------------------------------------------------------------- - - mstoptime = mcurrtime + dtimestep - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, & - stopTime=mstoptime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - !-------------------------------- - ! set restart and stop alarms - !-------------------------------- - - call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, & - alarmCount=alarmCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - if (alarmCount == 0) then - - call ESMF_GridCompGet(gcomp, name=name, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call ESMF_LogWrite(subname//'setting alarms for'//trim(name), & - ESMF_LOGMSG_INFO) - - !---------------- - ! Restart alarm - !---------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_option", & - value=restart_option, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & - rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) restart_n - - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & - rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) restart_ymd - - call alarmInit(mclock, restart_alarm, restart_option, & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - !---------------- - ! Stop alarm - !---------------- - call NUOPC_CompAttributeGet(gcomp, name="stop_option", & - value=stop_option, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) stop_n - - call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, & - rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - read(cvalue,*) stop_ymd - - call alarmInit(mclock, stop_alarm, stop_option, & - opt_n = stop_n, & - opt_ymd = stop_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_stop', rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - end if - - !----------------------------------------------------------------------- - ! Advance model clock to trigger alarms then reset model clock - ! back to currtime - !----------------------------------------------------------------------- - - call ESMF_ClockAdvance(mclock,rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, & - stopTime=mstoptime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - end subroutine ModelSetRunClock - - !========================================================================== - subroutine ModelFinalize(gcomp, rc) - use cam_comp, only: cam_final - use cam_comp, only: cam_timestep_final - - ! Dummy arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! Local variables - integer :: shrlogunit ! original log unit - real(r8) :: nextsw_cday ! calendar of next atm shortwave - type(ESMF_State) :: importState - character(len=*), parameter :: F00 = "('(atm_comp_nuopc) ',8a)" - character(len=*), parameter :: F91 = "('(atm_comp_nuopc) ',73('-'))" - character(len=*), parameter :: subname=trim(modName)//':(ModelFinalize) ' - !------------------------------------------------------------------------ - - !-------------------------------- - ! Finalize routine - !-------------------------------- - - rc = ESMF_SUCCESS - - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) - - !!XXgoldyXX: Is this needed? - ! Unpack import state - if (mediator_present) then - call t_startf('CAM_import') - call State_GetScalar(importState, flds_scalar_index_nextsw_cday, & - nextsw_cday, flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call State_diagnose(importState, string=subname//':IS', rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) then - return - end if - - call import_fields(gcomp, cam_in, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) then - return - end if - call t_stopf('CAM_import') - end if - - call cam_timestep_final() - call cam_final(cam_out, cam_in) - - !CAMDEN TODO: export output state? Needed for finalize? - - if (masterproc) then - write(iulog,F91) - write(iulog,F00) 'CAM: end of main integration loop' - write(iulog,F91) - end if - - call shr_file_setLogUnit(shrlogunit) - - end subroutine ModelFinalize - - !========================================================================== - subroutine cam_orbital_init(gcomp, logunit, mastertask, rc) - - !---------------------------------------------------------- - ! Initialize orbital related values - !---------------------------------------------------------- - - ! Dummy arguments - type(ESMF_GridComp), intent(in) :: gcomp - integer, intent(in) :: logunit - logical, intent(in) :: mastertask - integer, intent(out) :: rc ! output error - - ! Local variables - character(len=CL) :: msgstr ! temporary - character(len=CL) :: cvalue ! temporary - character(len=*), parameter :: subname = "(cam_orbital_init)" - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Determine orbital attributes from input - call NUOPC_CompAttributeGet(gcomp, name="orb_mode", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) orb_mode - - call NUOPC_CompAttributeGet(gcomp, name="orb_iyear", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) orb_iyear - - call NUOPC_CompAttributeGet(gcomp, name="orb_iyear_align", & - value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) orb_iyear_align - - call NUOPC_CompAttributeGet(gcomp, name="orb_obliq", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) orb_obliq - - call NUOPC_CompAttributeGet(gcomp, name="orb_eccen", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) orb_eccen - - call NUOPC_CompAttributeGet(gcomp, name="orb_mvelp", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) orb_mvelp - - ! Error checks - if (trim(orb_mode) == trim(orb_fixed_year)) then - orb_obliq = SHR_ORB_UNDEF_REAL - orb_eccen = SHR_ORB_UNDEF_REAL - orb_mvelp = SHR_ORB_UNDEF_REAL - if (orb_iyear == SHR_ORB_UNDEF_INT) then - if (mastertask) then - write(logunit,*) trim(subname), & - ' ERROR: invalid settings orb_mode =',trim(orb_mode) - write(logunit,*) trim(subname), & - ' ERROR: fixed_year settings = ',orb_iyear - write(msgstr, *) ' ERROR: invalid settings for orb_mode ', & - trim(orb_mode) - end if - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - else if (trim(orb_mode) == trim(orb_variable_year)) then - orb_obliq = SHR_ORB_UNDEF_REAL - orb_eccen = SHR_ORB_UNDEF_REAL - orb_mvelp = SHR_ORB_UNDEF_REAL - if ( (orb_iyear == SHR_ORB_UNDEF_INT) .or. & - (orb_iyear_align == SHR_ORB_UNDEF_INT)) then - if (mastertask) then - write(logunit,*) trim(subname), & - ' ERROR: invalid settings orb_mode =',trim(orb_mode) - write(logunit,*) trim(subname), & - ' ERROR: variable_year settings = ', orb_iyear, & - orb_iyear_align - write(msgstr, *) subname, & - ' ERROR: invalid settings for orb_mode ', trim(orb_mode) - end if - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - else if (trim(orb_mode) == trim(orb_fixed_parameters)) then - !-- force orb_iyear to undef to make sure shr_orb_params works properly - orb_iyear = SHR_ORB_UNDEF_INT - orb_iyear_align = SHR_ORB_UNDEF_INT - if (orb_eccen == SHR_ORB_UNDEF_REAL .or. & - orb_obliq == SHR_ORB_UNDEF_REAL .or. & - orb_mvelp == SHR_ORB_UNDEF_REAL) then - if (mastertask) then - write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) - write(logunit,*) trim(subname), ' ERROR: orb_eccen = ', orb_eccen - write(logunit,*) trim(subname), ' ERROR: orb_obliq = ', orb_obliq - write(logunit,*) trim(subname), ' ERROR: orb_mvelp = ', orb_mvelp - write(msgstr, *) subname, & - ' ERROR: invalid settings for orb_mode ', trim(orb_mode) - end if - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - else - write(msgstr, *) subname, ' ERROR: invalid orb_mode ', trim(orb_mode) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, & - line=__LINE__, file=__FILE__, rcToReturn=rc) - rc = ESMF_FAILURE - return ! bail out - end if - - end subroutine cam_orbital_init - - !========================================================================== - subroutine cam_orbital_update(clock, logunit, mastertask, eccen, & - obliqr, lambm0, mvelpp, rc) - - !---------------------------------------------------------- - ! Update orbital settings - !---------------------------------------------------------- - - ! Dummy arguments - type(ESMF_Clock), intent(in) :: clock - integer, intent(in) :: logunit - logical, intent(in) :: mastertask - real(R8), intent(inout) :: eccen ! orbital eccentricity - real(R8), intent(inout) :: obliqr ! Earths obliquity in rad - ! lambm0: The mean longitude of perihelion at vernal equinox (radians) - real(R8), intent(inout) :: lambm0 - ! mvelpp: Moving vernal equinox longitude of perihelion plus pi (radians) - real(R8), intent(inout) :: mvelpp - integer, intent(out) :: rc ! output error - - ! Local variables - type(ESMF_Time) :: CurrTime ! current time - integer :: year ! model year at current time - integer :: orb_year ! orbital year for current orbital computation - character(len=CL) :: msgstr ! temporary - character(len=*), parameter :: subname = "(cam_orbital_update)" - !------------------------------------------- - - rc = ESMF_SUCCESS - - if (trim(orb_mode) == trim(orb_variable_year)) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(CurrTime, yy=year, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - orb_year = orb_iyear + (year - orb_iyear_align) - else - orb_year = orb_iyear - end if - - eccen = orb_eccen - call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, & - lambm0, mvelpp, mastertask) - - if ( (eccen == SHR_ORB_UNDEF_REAL) .or. & - (obliqr == SHR_ORB_UNDEF_REAL) .or. & - (mvelpp == SHR_ORB_UNDEF_REAL) .or. & - (lambm0 == SHR_ORB_UNDEF_REAL)) then - write(msgstr, *) subname, ' ERROR: orb params incorrect' - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - - end subroutine cam_orbital_update - - !========================================================================== - subroutine cam_read_srfrest(gcomp, clock, rc) - use string_utils, only: to_str - use ioFileMod, only: cam_get_file - - ! Dummy arguments - type(ESMF_GridComp) :: gcomp - type(ESMF_Clock), intent(inout) :: clock - integer, intent(out) :: rc - - ! Local variables - type(ESMF_State) :: importState, exportState - type(ESMF_Field) :: lfield - integer :: lrank - integer :: rcode ! return error code - integer :: nf,n - type(file_desc_t) :: file - type(io_desc_t), pointer :: iodesc - integer :: fieldCount - integer :: astat - character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - type(var_desc_t) :: varid - real(r8), pointer :: fldptr(:) - real(r8), pointer :: tmpptr(:) - real(r8), pointer :: fldptr2d(:,:) - type(ESMF_Time) :: currTime ! time at previous interval - integer :: yr_spec ! Current year - integer :: mon_spec ! Current month - integer :: day_spec ! Current day - integer :: sec_spec ! Current time of day (sec) - character(len=CL) :: fname_srf_cam ! surface restart filename - character(len=CL) :: pname_srf_cam ! surface restart full pathname - character(len=PIO_MAX_NAME) :: varname - integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds - integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds - integer :: lsize - integer :: err_handling - character(len=8) :: cvalue - integer :: nloop - character(len=4) :: prefix - character(len=*), parameter :: subname = "(cam_read_srfrest) " - - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! ------------------------------ - ! Get surface restart dataset - ! ------------------------------ - - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_TimeGet(currTime, yy=yr_spec, mm=mon_spec, dd=day_spec, & - s=sec_spec, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - fname_srf_cam = interpret_filename_spec(rsfilename_spec_cam, & - case=cam_initfiles_get_caseid(), yr_spec=yr_spec, & - mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec) - pname_srf_cam = trim(cam_initfiles_get_restdir())//fname_srf_cam - call cam_get_file(pname_srf_cam, fname_srf_cam) - - ! ------------------------------ - ! Open restart file - ! ------------------------------ - call cam_pio_openfile(File, fname_srf_cam, 0) - call cam_pio_newdecomp(iodesc, (/num_global_phys_cols/), dof, pio_double) - call pio_seterrorhandling(File, pio_bcast_error, oldmethod=err_handling) - - ! ------------------------------ - ! Read in import and export fields - ! ------------------------------ - do nloop = 1, 2 - if (nloop == 1) then - prefix = 'x2a_' ! import fields - call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - allocate(fieldnameList(fieldCount), stat=astat) - if (astat /= 0) then - write(varname, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(varname)) - end if - call ESMF_StateGet(importState, itemNameList=fieldnameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - prefix = 'a2x_' ! export fields - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - allocate(fieldnameList(fieldCount), stat=astat) - if (astat /= 0) then - write(varname, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(varname)) - end if - call ESMF_StateGet(exportState, itemNameList=fieldnameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - ! Loop over fields in import or export state - do nf = 1, fieldCount - - if (trim(fieldnameList(nf)) == flds_scalar_name) CYCLE - - ! Determine dimension of field - if (nloop == 1) then - call ESMF_StateGet(importState, & - itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call ESMF_StateGet(exportState, & - itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - call ESMF_FieldGet(lfield, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 1) then - - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - varname = trim(prefix)//trim(fieldnameList(nf)) - rcode = pio_inq_varid(File,trim(varname), varid) - if (rcode == pio_noerr) then - call pio_read_darray(File, varid, iodesc, fldptr, rcode) - else - if (masterproc) then - write(iulog,*) 'cam_read_srfrest warning: field ', & - trim(varname),' is not on restart file' - write(iulog,*) & - ' for backwards compatibility will set it to 0' - end if - fldptr(:) = 0._r8 - end if - - else if (lrank == 2) then - - ! There is an output variable for each element of the - ! undistributed dimension - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, & - gridToFieldMap=gridToFieldMap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - if (gridToFieldMap(1) == 1) then - lsize = size(fldptr2d, dim=1) - else if (gridToFieldMap(1) == 2) then - lsize = size(fldptr2d, dim=2) - end if - - allocate(tmpptr(lsize), stat=astat) - if (astat /= 0) then - write(varname, *) 'Allocate ERROR for tmpptr ', to_str(astat) - call shr_sys_abort(subname//trim(varname)) - end if - do n = 1, ungriddedUBound(1) - write(cvalue,'(i0)') n - varname = trim(prefix)//trim(fieldnameList(nf))//trim(cvalue) - rcode = pio_inq_varid(File,trim(varname), varid) - - if (rcode == pio_noerr) then - call pio_read_darray(File, varid, iodesc, tmpptr, rcode) - else - if (masterproc) then - write(iulog,*) 'cam_read_srfrest warning: field ', & - trim(varname),' is not on restart file' - write(iulog,*) & - 'for backwards compatibility will set it to 0' - end if - tmpptr(:) = 0._r8 - end if - if (gridToFieldMap(1) == 1) then - fldptr2d(:,n) = tmpptr(:) - else if (gridToFieldMap(1) == 2) then - fldptr2d(n,:) = tmpptr(:) - end if - end do - deallocate(tmpptr) - - end if ! end lrank if block - end do - deallocate(fieldnameList) - end do - - ! ------------------------------ - ! Close file - ! ------------------------------ - call pio_seterrorhandling(File, err_handling) - call pio_freedecomp(File, iodesc) - call cam_pio_closefile(File) - - end subroutine cam_read_srfrest - - !========================================================================= - subroutine cam_write_srfrest(gcomp, yr_spec, mon_spec, day_spec, & - sec_spec, rc) - use string_utils, only: to_str - - ! Dummy Arguments - type(ESMF_GridComp) :: gcomp - integer, intent(in) :: yr_spec ! Simulation year - integer, intent(in) :: mon_spec ! Simulation month - integer, intent(in) :: day_spec ! Simulation day - integer, intent(in) :: sec_spec ! Seconds into current simulation day - integer, intent(out) :: rc ! error code - - ! Local variables - type(ESMF_State) :: importState, exportState - type(ESMF_Field) :: lField - integer :: lrank - integer :: rcode ! return error code - integer :: dimid(1), nf, n - type(file_desc_t) :: file - type(io_desc_t), pointer :: iodesc - integer :: astat - integer :: fieldCount - character(ESMF_MAXSTR), allocatable :: fieldnameList(:) - type(var_desc_t) :: varid - real(r8), pointer :: fldptr1d(:) - real(r8), pointer :: fldptr2d(:,:) - character(len=PIO_MAX_NAME) :: varname - character(len=CL) :: fname_srf_cam ! surface restart filename - character(len=8) :: cvalue - integer :: nloop - character(len=4) :: prefix - integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds - integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds - character(len=*), parameter :: subname = "(cam_write_srfrest) " - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! ---------------------- - ! Get import and export states - ! ---------------------- - - call ESMF_GridCompGet(gcomp, importState=importState, & - exportState=exportState, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! ---------------------- - ! Open surface restart dataset - ! ---------------------- - - fname_srf_cam = interpret_filename_spec(rsfilename_spec_cam, & - yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, & - sec_spec=sec_spec) - - call cam_pio_createfile(File, fname_srf_cam, 0) - call cam_pio_newdecomp(iodesc, (/num_global_phys_cols/), dof, pio_double) - - ! ---------------------- - ! Define dimensions - ! ---------------------- - - rcode = pio_def_dim(File, 'x2a_nx', num_global_phys_cols, dimid(1)) - rcode = pio_def_dim(File, 'a2x_nx', num_global_phys_cols, dimid(1)) - - ! ---------------------- - ! Define import and export variable ids - ! ---------------------- - - do nloop = 1, 2 - - if (nloop == 1) then - prefix = 'x2a_' ! import fields - call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - allocate(fieldNameList(fieldCount), stat=astat) - if (astat /= 0) then - write(fname_srf_cam, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(fname_srf_cam)) - end if - call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - prefix = 'a2x_' ! export fields - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - allocate(fieldNameList(fieldCount), stat=astat) - if (astat /= 0) then - write(fname_srf_cam, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(fname_srf_cam)) - end if - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - do nf = 1,fieldCount - - if (trim(fieldNameList(nf)) == flds_scalar_name) CYCLE - - if (nloop == 1) then - call ESMF_StateGet(importState, & - itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call ESMF_StateGet(exportState, & - itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - call ESMF_FieldGet(lfield, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 1) then - - varname = trim(prefix)//trim(fieldNameList(nf)) - rcode = pio_def_var(File,trim(varname), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(File, varid, "_fillvalue", fillvalue) - - else if (lrank == 2) then - - ! Determine the size of the ungridded dimension and the - ! index where the undistributed dimension is located - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, & - gridToFieldMap=gridToFieldMap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Output for each ungriddedUbound index - do n = 1,ungriddedUBound(1) - write(cvalue,'(i0)') n - varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue) - rcode = pio_def_var(File,trim(varname), PIO_DOUBLE, & - dimid, varid) - rcode = pio_put_att(File, varid, "_fillvalue", fillvalue) - end do - - end if ! end if-block over rank size - - end do ! end loop over import or export fieldsfields - deallocate(fieldNameList) - end do - - ! ---------------------- - ! End definition phase - ! ---------------------- - - rcode = pio_enddef(File)! don't check return code, might be enddef already - - ! ---------------------- - ! Write the restart data for the import fields and export fields - ! ---------------------- - - do nloop = 1, 2 - - if (nloop == 1) then - prefix = 'x2a_' ! import fields - call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - allocate(fieldNameList(fieldCount), stat=astat) - if (astat /= 0) then - write(fname_srf_cam, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(fname_srf_cam)) - end if - call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - prefix = 'a2x_' ! export fields - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - allocate(fieldNameList(fieldCount), stat=astat) - if (astat /= 0) then - write(fname_srf_cam, *) 'Allocate ERROR for fieldNameList ', & - to_str(astat) - call shr_sys_abort(subname//trim(fname_srf_cam)) - end if - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - - do nf = 1,fieldCount - - if (trim(fieldNameList(nf)) == flds_scalar_name) CYCLE - - if (nloop == 1) then - call ESMF_StateGet(importState, & - itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - else - call ESMF_StateGet(exportState, & - itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - end if - call ESMF_FieldGet(lfield, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 1) then - - varname = trim(prefix)//trim(fieldNameList(nf)) - rcode = pio_inq_varid(File, trim(varname), varid) - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call pio_write_darray(File, varid, iodesc, fldptr1d, rcode) - - else if (lrank == 2) then - - ! There is an output variable for each element of the - ! undistributed dimension - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - do n = 1,ungriddedUBound(1) - write(cvalue,'(i0)') n - varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue) - rcode = pio_inq_varid(File, trim(varname), varid) - if (gridToFieldMap(1) == 1) then - call pio_write_darray(File, varid, iodesc, & - fldptr2d(:,n), rcode, fillval=fillvalue) - else if (gridToFieldMap(1) == 2) then - call pio_write_darray(File, varid, iodesc, & - fldptr2d(n,:), rcode, fillval=fillvalue) - end if - end do - - end if - end do ! end loop over import or export fields - deallocate(fieldNameList) - - end do ! end of nloop - - ! ---------------------- - ! close the file - ! ---------------------- - - call pio_freedecomp(File,iodesc) - call cam_pio_closefile(File) - - end subroutine cam_write_srfrest - - !========================================================================== - subroutine cam_write_clockrest(clock, yr_spec, mon_spec, day_spec, & - sec_spec, rc) - - ! When there is no mediator, the driver needs to have - ! restart information to start up - ! This routine writes this out and the driver reads it - ! back in on a restart run - - ! Arguments - type(ESMF_Clock), intent(in) :: clock - integer, intent(in) :: yr_spec ! Simulation year - integer, intent(in) :: mon_spec ! Simulation month - integer, intent(in) :: day_spec ! Simulation day - integer, intent(in) :: sec_spec ! Seconds into current simulation day - integer, intent(out) :: rc ! error code - - ! Local variables - type(ESMF_Time) :: startTime - type(ESMF_Time) :: currTime - type(ESMF_Time) :: nextTime - integer :: unitn - type(file_desc_t) :: File - integer :: start_ymd - integer :: start_tod - integer :: curr_ymd - integer :: curr_tod - integer :: yy,mm,dd ! Temporaries for time query - type(var_desc_t) :: varid_start_ymd - type(var_desc_t) :: varid_start_tod - type(var_desc_t) :: varid_curr_ymd - type(var_desc_t) :: varid_curr_tod - integer :: rcode - character(ESMF_MAXSTR) :: restart_pfile - character(ESMF_MAXSTR) :: restart_file - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Get properties from clock - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - call ESMF_TimeGet(startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,start_ymd) - - call ESMF_TimeGet(nextTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc) - !call ESMF_TimeGet(currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,curr_ymd) - - ! Open clock info restart dataset - restart_file = interpret_filename_spec('%c.cpl.r.%y-%m-%d-%s.nc', & - yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, & - sec_spec=sec_spec) - - if (masterproc) then - write(iulog,*) " In this configuration, there is no mediator" - write(iulog,*) " Normally, the mediator restart file provides ", & - "the restart time info" - write(iulog,*) " In this case, CAM will create the ", & - "rpointer.cpl and cpl restart file" - write(iulog,*) " containing this information" - write(iulog,*) " writing rpointer file for driver clock info, ", & - "rpointer.cpl" - write(iulog,*) " writing restart clock info for driver= ", & - trim(restart_file) - open(newunit=unitn, file='rpointer.cpl', form='FORMATTED') - write(unitn,'(a)') trim(restart_file) - close(unitn) - end if - - call cam_pio_createfile(File, trim(restart_file), 0) - rcode = pio_def_var(File, 'start_ymd', PIO_INT, varid_start_ymd) - rcode = pio_def_var(File, 'start_tod', PIO_INT, varid_start_tod) - rcode = pio_def_var(File, 'curr_ymd', PIO_INT, varid_curr_ymd) - rcode = pio_def_var(File, 'curr_tod', PIO_INT, varid_curr_tod) - rcode = pio_enddef(File) - rcode = pio_put_var(File, varid_start_ymd, start_ymd) - rcode = pio_put_var(File, varid_start_tod, start_tod) - rcode = pio_put_var(File, varid_curr_ymd, curr_ymd) - rcode = pio_put_var(File, varid_curr_tod, curr_tod) - call cam_pio_closefile(File) - - end subroutine cam_write_clockrest - - !========================================================================== - subroutine cam_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) - ! Generate a mesh for single column - - ! Dummy arguments - real(r8), intent(in) :: scol_lon - real(r8), intent(in) :: scol_lat - type(ESMF_Mesh), intent(out) :: mesh - integer, intent(out) :: rc - - ! Local variables - type(ESMF_Grid) :: lgrid - integer :: maxIndex(2) - real(r8) :: mincornerCoord(2) - real(r8) :: maxcornerCoord(2) - character(len=*), parameter :: subname= ' (cam_set_mesh_for_single_column) ' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Use center and come up with arbitrary area delta lon and lat = .1 degree - maxIndex(1) = 1 ! number of lons - maxIndex(2) = 1 ! number of lats - mincornerCoord(1) = scol_lon - .1_r8 ! min lon - mincornerCoord(2) = scol_lat - .1_r8 ! min lat - maxcornerCoord(1) = scol_lon + .1_r8 ! max lon - maxcornerCoord(2) = scol_lat + .1_r8 ! max lat - - ! create the ESMF grid - lgrid = ESMF_GridCreateNoPeriDimUfrm(maxindex=maxindex, & - mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & - staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & - rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - ! create the mesh from the lgrid - mesh = ESMF_MeshCreate(lgrid, rc=rc) - if (ChkErr(rc, __LINE__, u_FILE_u)) return - - end subroutine cam_set_mesh_for_single_column + !-------------------------------- + ! Reset shr logging to my original values + !-------------------------------- + + call shr_log_setLogUnit (shrlogunit) + + end subroutine ModelAdvance + + !=============================================================================== + + subroutine ModelSetRunClock(gcomp, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock, dclock + type(ESMF_Time) :: mcurrtime, dcurrtime + type(ESMF_Time) :: mstoptime + type(ESMF_TimeInterval) :: mtimestep, dtimestep + character(len=256) :: cvalue + character(len=256) :: restart_option ! Restart option units + integer :: restart_n ! Number until restart interval + integer :: restart_ymd ! Restart date (YYYYMMDD) + type(ESMF_ALARM) :: restart_alarm + character(len=256) :: stop_option ! Stop option units + integer :: stop_n ! Number until stop interval + integer :: stop_ymd ! Stop date (YYYYMMDD) + type(ESMF_ALARM) :: stop_alarm + character(len=128) :: name + integer :: alarmcount + character(len=*),parameter :: subname=trim(modName)//':(ModelSetRunClock) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! query the Component for its clocks + call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !-------------------------------- + ! force model clock currtime and timestep to match driver and set stoptime + !-------------------------------- + + mstoptime = mcurrtime + dtimestep + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !-------------------------------- + ! set restart and stop alarms + !-------------------------------- + + call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (alarmCount == 0) then + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) + + !---------------- + ! Restart alarm + !---------------- + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_n + + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_ymd + + call alarmInit(mclock, restart_alarm, restart_option, & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_restart', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------- + ! Stop alarm + !---------------- + call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_n + + call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_ymd + + call alarmInit(mclock, stop_alarm, stop_option, & + opt_n = stop_n, & + opt_ymd = stop_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_stop', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + !-------------------------------- + ! Advance model clock to trigger alarms then reset model clock back to currtime + !-------------------------------- + + call ESMF_ClockAdvance(mclock,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine ModelSetRunClock + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: shrlogunit ! original log unit + character(*), parameter :: F00 = "('(atm_comp_nuopc) ',8a)" + character(*), parameter :: F91 = "('(atm_comp_nuopc) ',73('-'))" + character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' + !------------------------------------------------------------------------------- + + !-------------------------------- + ! Finalize routine + !-------------------------------- + + rc = ESMF_SUCCESS + + call shr_log_getLogUnit(shrlogunit) + call shr_log_setLogUnit(iulog) + + call cam_timestep_final(do_ncdata_check=.false.) + call cam_final(cam_out, cam_in) + + if (masterproc) then + write(iulog,F91) + write(iulog,F00) 'CAM: end of main integration loop' + write(iulog,F91) + end if + + call shr_log_setLogUnit (shrlogunit) + + end subroutine ModelFinalize + + !=============================================================================== + subroutine cam_orbital_init(gcomp, logunit, mastertask, rc) + + !---------------------------------------------------------- + ! Initialize orbital related values + !---------------------------------------------------------- + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + integer , intent(in) :: logunit + logical , intent(in) :: mastertask + integer , intent(out) :: rc ! output error + + ! local variables + character(len=CL) :: msgstr ! temporary + character(len=CL) :: cvalue ! temporary + character(len=*) , parameter :: subname = "(cam_orbital_init)" + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine orbital attributes from input + call NUOPC_CompAttributeGet(gcomp, name="orb_mode", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mode + + call NUOPC_CompAttributeGet(gcomp, name="orb_iyear", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear + + call NUOPC_CompAttributeGet(gcomp, name="orb_iyear_align", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear_align + + call NUOPC_CompAttributeGet(gcomp, name="orb_obliq", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_obliq + + call NUOPC_CompAttributeGet(gcomp, name="orb_eccen", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_eccen + + call NUOPC_CompAttributeGet(gcomp, name="orb_mvelp", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mvelp + + ! Error checks + if (trim(orb_mode) == trim(orb_fixed_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: fixed_year settings = ',orb_iyear + write (msgstr, *) ' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_variable_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT .or. orb_iyear_align == SHR_ORB_UNDEF_INT) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: variable_year settings = ',orb_iyear, orb_iyear_align + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_fixed_parameters)) then + !-- force orb_iyear to undef to make sure shr_orb_params works properly + orb_iyear = SHR_ORB_UNDEF_INT + orb_iyear_align = SHR_ORB_UNDEF_INT + if (orb_eccen == SHR_ORB_UNDEF_REAL .or. & + orb_obliq == SHR_ORB_UNDEF_REAL .or. & + orb_mvelp == SHR_ORB_UNDEF_REAL) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: orb_eccen = ',orb_eccen + write(logunit,*) trim(subname),' ERROR: orb_obliq = ',orb_obliq + write(logunit,*) trim(subname),' ERROR: orb_mvelp = ',orb_mvelp + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + else + write (msgstr, *) subname//' ERROR: invalid orb_mode '//trim(orb_mode) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + rc = ESMF_FAILURE + return ! bail out + endif + + end subroutine cam_orbital_init + + !=============================================================================== + subroutine cam_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) + + !---------------------------------------------------------- + ! Update orbital settings + !---------------------------------------------------------- + + ! input/output variables + type(ESMF_Clock) , intent(in) :: clock + integer , intent(in) :: logunit + logical , intent(in) :: mastertask + real(R8) , intent(inout) :: eccen ! orbital eccentricity + real(R8) , intent(inout) :: obliqr ! Earths obliquity in rad + real(R8) , intent(inout) :: lambm0 ! Mean long of perihelion at vernal equinox (radians) + real(R8) , intent(inout) :: mvelpp ! moving vernal equinox longitude of perihelion plus pi (radians) + integer , intent(out) :: rc ! output error + + ! local variables + type(ESMF_Time) :: CurrTime ! current time + integer :: year ! model year at current time + integer :: orb_year ! orbital year for current orbital computation + character(len=CL) :: msgstr ! temporary + logical, save :: logprint = .true. + character(len=*) , parameter :: subname = "(cam_orbital_update)" + !------------------------------------------- + + rc = ESMF_SUCCESS + + if (trim(orb_mode) == trim(orb_variable_year)) then + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(CurrTime, yy=year, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + orb_year = orb_iyear + (year - orb_iyear_align) + else + orb_year = orb_iyear + end if + if(.not. (logprint .and. mastertask)) then + logprint = .false. + endif + + eccen = orb_eccen + + call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, logprint) + logprint = .false. + if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. & + mvelpp == SHR_ORB_UNDEF_REAL .or. lambm0 == SHR_ORB_UNDEF_REAL) then + write (msgstr, *) subname//' ERROR: orb params incorrect' + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + end subroutine cam_orbital_update + + !=============================================================================== + subroutine cam_read_srfrest( gcomp, clock, rc ) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_Clock), intent(inout) :: clock + integer , intent(out) :: rc + + ! local variables + type(ESMF_State) :: importState, exportState + type(ESMF_Field) :: lfield + integer :: lrank + integer :: rcode ! return error code + integer :: nf,n + type(file_desc_t) :: file + type(io_desc_t) :: iodesc + integer :: fieldCount + character(ESMF_MAXSTR),allocatable :: fieldNameList(:) + type(var_desc_t) :: varid + real(r8), pointer :: fldptr(:) + real(r8), pointer :: tmpptr(:) + real(r8), pointer :: fldptr2d(:,:) + type(ESMF_Time) :: currTime ! time at previous interval + integer :: yr_spec ! Current year + integer :: mon_spec ! Current month + integer :: day_spec ! Current day + integer :: sec_spec ! Current time of day (sec) + character(len=256) :: fname_srf_cam ! surface restart filename + character(len=256) :: pname_srf_cam ! surface restart full pathname + character(len=PIO_MAX_NAME) :: varname + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: lsize + character(len=8) :: cvalue + integer :: nloop + character(len=4) :: prefix + character(len=*), parameter :: subname = "cam_read_srfrest" + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ------------------------------ + ! Get surface restart dataset + ! ------------------------------ + + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yr_spec, mm=mon_spec, dd=day_spec, s=sec_spec, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, case=cam_initfiles_get_caseid(), & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + pname_srf_cam = trim(cam_initfiles_get_restdir() )//fname_srf_cam + call cam_get_file(pname_srf_cam, fname_srf_cam) + + ! ------------------------------ + ! Open restart file + ! ------------------------------ + + call cam_pio_openfile(File, fname_srf_cam, 0) + call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc) + call pio_seterrorhandling(File, pio_bcast_error) + + ! ------------------------------ + ! Read in import and export fields + ! ------------------------------ + + do nloop = 1,2 + + if (nloop == 1) then + prefix = 'x2a_' ! import fields + call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(importState, itemNameList=fieldnameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + prefix = 'a2x_' ! export fields + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(exportState, itemNameList=fieldnameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Loop over fields in import or export state + do nf = 1,fieldCount + + if (trim(fieldnameList(nf)) == flds_scalar_name) CYCLE + + ! Determine dimension of field + if (nloop == 1) then + call ESMF_StateGet(importState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_StateGet(exportState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 1) then + + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + varname = trim(prefix)//trim(fieldnameList(nf)) + rcode = pio_inq_varid(File,trim(varname) ,varid) + if (rcode == pio_noerr) then + call pio_read_darray(File, varid, iodesc, fldptr, rcode) + else + if (masterproc) then + write(iulog,*)'cam_read_srfrest warning: field ',trim(varname),' is not on restart file' + write(iulog,*)'for backwards compatibility will set it to 0' + end if + fldptr(:) = 0._r8 + end if + + else if (lrank == 2) then + + ! There is an output variable for each element of the undistributed dimension + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap(1) == 1) then + lsize = size(fldptr2d, dim=1) + else if (gridToFieldMap(1) == 2) then + lsize = size(fldptr2d, dim=2) + end if + + allocate(tmpptr(lsize), stat=ierr) + call check_allocate(ierr, subname, 'tmpptr(lsize)', & + file=__FILE__, line=__LINE__) + do n = 1,ungriddedUBound(1) + write(cvalue,'(i0)') n + varname = trim(prefix)//trim(fieldnameList(nf))//trim(cvalue) + rcode = pio_inq_varid(File,trim(varname) ,varid) + + if (rcode == pio_noerr) then + call pio_read_darray(File, varid, iodesc, tmpptr, rcode) + else + if (masterproc) then + write(iulog,*)'cam_read_srfrest warning: field ',trim(varname),' is not on restart file' + write(iulog,*)'for backwards compatibility will set it to 0' + end if + tmpptr(:) = 0._r8 + end if + if (gridToFieldMap(1) == 1) then + fldptr2d(:,n) = tmpptr(:) + else if (gridToFieldMap(1) == 2) then + fldptr2d(n,:) = tmpptr(:) + end if + end do + deallocate(tmpptr) + + end if ! end lrank if block + end do + deallocate(fieldnameList) + end do + + ! ------------------------------ + ! Close file + ! ------------------------------ + + call pio_seterrorhandling(File, pio_internal_error) + call pio_freedecomp(File, iodesc) + call cam_pio_closefile(File) + + end subroutine cam_read_srfrest + + !=========================================================================================== + subroutine cam_write_srfrest( gcomp, yr_spec, mon_spec, day_spec, sec_spec, rc ) + + ! Arguments + type(ESMF_GridComp) :: gcomp + integer , intent(in) :: yr_spec ! Simulation year + integer , intent(in) :: mon_spec ! Simulation month + integer , intent(in) :: day_spec ! Simulation day + integer , intent(in) :: sec_spec ! Seconds into current simulation day + integer , intent(out) :: rc ! error code + + ! Local variables + type(ESMF_State) :: importState, exportState + type(ESMF_Field) :: lField + integer :: lrank + integer :: rcode ! return error code + integer :: dimid(1), nf, n + type(file_desc_t) :: file + type(io_desc_t) :: iodesc + integer :: fieldCount + character(ESMF_MAXSTR),allocatable :: fieldnameList(:) + type(var_desc_t) :: varid + real(r8), pointer :: fldptr1d(:) + real(r8), pointer :: fldptr2d(:,:) + character(len=PIO_MAX_NAME) :: varname + character(len=256) :: fname_srf_cam ! surface restart filename + character(len=8) :: cvalue + integer :: nloop + character(len=4) :: prefix + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds + character(len=*), parameter :: subname = "cam_write_srfrest" + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ---------------------- + ! Get import and export states + ! ---------------------- + + call ESMF_GridCompGet(gcomp, importState=importState, exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ---------------------- + ! Open surface restart dataset + ! ---------------------- + + fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + + call cam_pio_createfile(File, fname_srf_cam, 0) + call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc) + + ! ---------------------- + ! Define dimensions + ! ---------------------- + + rcode = pio_def_dim(File, 'x2a_nx', ngcols, dimid(1)) + rcode = pio_def_dim(File, 'a2x_nx', ngcols, dimid(1)) + + ! ---------------------- + ! Define import and export variable ids + ! ---------------------- + + do nloop = 1,2 + + if (nloop == 1) then + prefix = 'x2a_' ! import fields + call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + prefix = 'a2x_' ! export fields + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + do nf = 1,fieldCount + + if (trim(fieldNameList(nf)) == flds_scalar_name) CYCLE + + if (nloop == 1) then + call ESMF_StateGet(importState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_StateGet(exportState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 1) then + + varname = trim(prefix)//trim(fieldNameList(nf)) + rcode = pio_def_var(File,trim(varname), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(File, varid, "_fillvalue", fillvalue) + + else if (lrank == 2) then + + ! Determine the size of the ungridded dimension and the + ! index where the undistributed dimension is located + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Output for each ungriddedUbound index + do n = 1,ungriddedUBound(1) + write(cvalue,'(i0)') n + varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue) + rcode = pio_def_var(File,trim(varname), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(File, varid, "_fillvalue", fillvalue) + end do + + end if ! end if-block over rank size + + end do ! end loop over import or export fieldsfields + deallocate(fieldNameList) + end do + + ! ---------------------- + ! End definition phase + ! ---------------------- + + rcode = pio_enddef(File) ! don't check return code, might be enddef already + + ! ---------------------- + ! Write the restart data for the import fields and export fields + ! ---------------------- + + do nloop = 1,2 + + if (nloop == 1) then + prefix = 'x2a_' ! import fields + call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + prefix = 'a2x_' ! export fields + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount), stat=ierr) + call check_allocate(ierr, subname, 'fieldNameList(fieldCount)', & + file=__FILE__, line=__LINE__) + call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + do nf = 1,fieldCount + + if (trim(fieldNameList(nf)) == flds_scalar_name) CYCLE + + if (nloop == 1) then + call ESMF_StateGet(importState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_StateGet(exportState, itemName=trim(fieldnameList(nf)), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 1) then + + varname = trim(prefix)//trim(fieldNameList(nf)) + rcode = pio_inq_varid(File, trim(varname), varid) + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_write_darray(File, varid, iodesc, fldptr1d, rcode) + + else if (lrank == 2) then + + ! There is an output variable for each element of the undistributed dimension + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ungriddedUBound(1) + write(cvalue,'(i0)') n + varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue) + rcode = pio_inq_varid(File, trim(varname), varid) + if (gridToFieldMap(1) == 1) then + call pio_write_darray(File, varid, iodesc, fldptr2d(:,n), rcode, fillval=fillvalue) + else if (gridToFieldMap(1) == 2) then + call pio_write_darray(File, varid, iodesc, fldptr2d(n,:), rcode, fillval=fillvalue) + end if + end do + + end if + end do ! end loop over import or export fields + deallocate(fieldNameList) + + end do ! end of nloop + + ! ---------------------- + ! close the file + ! ---------------------- + + call pio_freedecomp(File,iodesc) + call cam_pio_closefile(File) + + end subroutine cam_write_srfrest + + !=============================================================================== + subroutine cam_write_clockrest( clock, yr_spec, mon_spec, day_spec, sec_spec, rc ) + + ! When there is no mediator, the driver needs to have restart information to start up + ! This routine writes this out and the driver reads it back in on a restart run + + ! Arguments + type(ESMF_Clock) , intent(in) :: clock + integer , intent(in) :: yr_spec ! Simulation year + integer , intent(in) :: mon_spec ! Simulation month + integer , intent(in) :: day_spec ! Simulation day + integer , intent(in) :: sec_spec ! Seconds into current simulation day + integer , intent(out) :: rc ! error code + + ! Local variables + type(ESMF_Time) :: startTime + type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime + integer :: unitn + type(file_desc_t) :: File + integer :: start_ymd + integer :: start_tod + integer :: curr_ymd + integer :: curr_tod + integer :: yy,mm,dd ! Temporaries for time query + type(var_desc_t) :: varid_start_ymd + type(var_desc_t) :: varid_start_tod + type(var_desc_t) :: varid_curr_ymd + type(var_desc_t) :: varid_curr_tod + integer :: rcode + character(ESMF_MAXSTR) :: restart_pfile + character(ESMF_MAXSTR) :: restart_file + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get properties from clock + call ESMF_ClockGet( clock, startTime=startTime, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,start_ymd) + + call ESMF_TimeGet( nextTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + !call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + ! Open clock info restart dataset + restart_file = interpret_filename_spec( '%c.cpl.r.%y-%m-%d-%s.nc', & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + + if (masterproc) then + write(iulog,*) " In this configuration, there is no mediator" + write(iulog,*) " Normally, the mediator restart file provides the restart time info" + write(iulog,*) " In this case, CAM will create the rpointer.cpl and cpl restart file" + write(iulog,*) " containing this information" + write(iulog,*) " writing rpointer file for driver clock info, rpointer.cpl" + write(iulog,*) " writing restart clock info for driver= "//trim(restart_file) + open(newunit=unitn, file='rpointer.cpl', form='FORMATTED') + write(unitn,'(a)') trim(restart_file) + close(unitn) + endif + + call cam_pio_createfile(File, trim(restart_file), 0) + rcode = pio_def_var(File, 'start_ymd', PIO_INT, varid_start_ymd) + rcode = pio_def_var(File, 'start_tod', PIO_INT, varid_start_tod) + rcode = pio_def_var(File, 'curr_ymd' , PIO_INT, varid_curr_ymd) + rcode = pio_def_var(File, 'curr_tod' , PIO_INT, varid_curr_tod) + rcode = pio_enddef(File) + rcode = pio_put_var(File, varid_start_ymd, start_ymd) + rcode = pio_put_var(File, varid_start_tod, start_tod) + rcode = pio_put_var(File, varid_curr_ymd, curr_ymd) + rcode = pio_put_var(File, varid_curr_tod, curr_tod) + call cam_pio_closefile(File) + + end subroutine cam_write_clockrest + + !=============================================================================== + subroutine cam_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) + + ! Generate a mesh for single column + use netcdf + + ! input/output variables + real(r8) , intent(in) :: scol_lon + real(r8) , intent(in) :: scol_lat + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: rc + + ! local variables + type(ESMF_Grid) :: lgrid + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + character(len=*), parameter :: subname= ' (lnd_set_mesh_for_single_column) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Use center and come up with arbitrary area delta lon and lat = .1 degree + maxIndex(1) = 1 ! number of lons + maxIndex(2) = 1 ! number of lats + mincornerCoord(1) = scol_lon - .1_r8 ! min lon + mincornerCoord(2) = scol_lat - .1_r8 ! min lat + maxcornerCoord(1) = scol_lon + .1_r8 ! max lon + maxcornerCoord(2) = scol_lat + .1_r8 ! max lat + + ! create the ESMF grid + lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & + mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & + staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create the mesh from the lgrid + mesh = ESMF_MeshCreate(lgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine cam_set_mesh_for_single_column + + !=============================================================================== + subroutine cam_pio_checkerr(ierror, description) + use pio, only : PIO_NOERR + integer , intent(in) :: ierror + character(*), intent(in) :: description + if (ierror /= PIO_NOERR) then + write (*,'(6a)') 'ERROR ', trim(description) + call shr_sys_abort() + endif + end subroutine cam_pio_checkerr end module atm_comp_nuopc diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index 0c074139..733e93d5 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -1,38 +1,25 @@ module atm_import_export - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected - use NUOPC_Model , only : NUOPC_ModelGet - use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet - use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError - use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag - use ESMF , only : operator(/=), operator(==) - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx - use shr_sys_mod , only : shr_sys_abort - use nuopc_shr_methods , only : chkerr - use cam_logfile , only : iulog - use srf_field_check , only : set_active_Sl_ram1 - use srf_field_check , only : set_active_Sl_fv - use srf_field_check , only : set_active_Sl_soilw - use srf_field_check , only : set_active_Fall_flxdst1 - use srf_field_check , only : set_active_Fall_flxvoc - use srf_field_check , only : set_active_Fall_flxfire - use srf_field_check , only : set_active_Fall_fco2_lnd - use srf_field_check , only : set_active_Faoo_fco2_ocn - use srf_field_check , only : set_active_Faxa_nhx - use srf_field_check , only : set_active_Faxa_noy + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected + use NUOPC_Model , only : NUOPC_ModelGet + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet, ESMF_Field + use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogWrite + use ESMF , only : operator(/=), operator(==) + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx implicit none private ! except + public :: read_surface_fields_namelists public :: advertise_fields public :: realize_fields public :: import_fields public :: export_fields - public :: state_getfldptr private :: fldlist_add private :: fldlist_realize + private :: state_getfldptr type fldlist_type character(len=128) :: stdname @@ -46,31 +33,68 @@ module atm_import_export type (fldlist_type) , public, protected :: fldsToAtm(fldsMax) type (fldlist_type) , public, protected :: fldsFrAtm(fldsMax) - character(len=cx) :: carma_fields ! list of CARMA fields from lnd->atm - integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm - integer :: megan_nflds ! number of MEGAN voc fields from lnd-> atm - integer :: emis_nflds ! number of fire emission fields from lnd-> atm - integer, public :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn - integer :: dbug_flag = 0 ! ESMF log output - integer, parameter :: debug_import = 0 ! internal debug level - integer, parameter :: debug_export = 0 ! internal debug level + ! area correction factors for fluxes send and received from mediator + real(r8), allocatable :: mod2med_areacor(:) + real(r8), allocatable :: med2mod_areacor(:) + + character(len=cx) :: carma_fields = ' ' ! list of CARMA fields from lnd->atm + integer :: drydep_nflds = -huge(1) ! number of dry deposition velocity fields lnd-> atm + integer :: megan_nflds = -huge(1) ! number of MEGAN voc fields from lnd-> atm + integer :: emis_nflds = -huge(1) ! number of fire emission fields from lnd-> atm + integer, public :: ndep_nflds = -huge(1) ! number of nitrogen deposition fields from atm->lnd/ocn + logical :: atm_provides_lightning = .false. ! cld to grnd lightning flash freq (min-1) character(*),parameter :: F01 = "('(cam_import_export) ',a,i8,2x,i8,2x,d21.14)" character(*),parameter :: F02 = "('(cam_import_export) ',a,i8,2x,i8,2x,i8,2x,d21.14)" - character(*),parameter :: u_FILE_u = & - __FILE__ + character(*),parameter :: u_FILE_u = __FILE__ !=============================================================================== contains !=============================================================================== - subroutine advertise_fields(gcomp, flds_scalar_name, rc) + !----------------------------------------------------------- + ! read mediator fields namelist file + !----------------------------------------------------------- + subroutine read_surface_fields_namelists() - use spmd_utils , only : masterproc - use seq_drydep_mod , only : seq_drydep_readnl + use shr_drydep_mod , only : shr_drydep_readnl use shr_megan_mod , only : shr_megan_readnl use shr_fire_emis_mod , only : shr_fire_emis_readnl use shr_carma_mod , only : shr_carma_readnl use shr_ndep_mod , only : shr_ndep_readnl + use shr_lightning_coupling_mod, only : shr_lightning_coupling_readnl + + character(len=*), parameter :: nl_file_name = 'drv_flds_in' + + ! read mediator fields options + call shr_ndep_readnl(nl_file_name, ndep_nflds) + call shr_drydep_readnl(nl_file_name, drydep_nflds) + call shr_megan_readnl(nl_file_name, megan_nflds) + call shr_fire_emis_readnl(nl_file_name, emis_nflds) + call shr_carma_readnl(nl_file_name, carma_fields) + call shr_lightning_coupling_readnl(nl_file_name, atm_provides_lightning) + + end subroutine read_surface_fields_namelists + + !----------------------------------------------------------- + ! advertise fields + !----------------------------------------------------------- + subroutine advertise_fields(gcomp, flds_scalar_name, rc) + + ! use statements + use ESMF , only : ESMF_MAXSTR + use nuopc_shr_methods , only : chkerr + use srf_field_check , only : set_active_Sl_ram1 + use srf_field_check , only : set_active_Sl_fv + use srf_field_check , only : set_active_Sl_soilw + use srf_field_check , only : set_active_Fall_flxdst1 + use srf_field_check , only : set_active_Fall_flxvoc + use srf_field_check , only : set_active_Fall_flxfire + use srf_field_check , only : set_active_Fall_fco2_lnd + use srf_field_check , only : set_active_Faoo_fco2_ocn + use srf_field_check , only : set_active_Faxa_nhx + use srf_field_check , only : set_active_Faxa_noy + use spmd_utils , only : masterproc + use cam_logfile , only : iulog ! input/output variables type(ESMF_GridComp) :: gcomp @@ -82,18 +106,15 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) type(ESMF_State) :: exportState character(ESMF_MAXSTR) :: stdname character(ESMF_MAXSTR) :: cvalue - character(len=2) :: nec_str integer :: n, num logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case - integer :: ndep_nflds, megan_nflds, emis_nflds character(len=128) :: fldname character(len=*), parameter :: subname='(atm_import_export:advertise_fields)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -105,25 +126,25 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a - call ESMF_LogWrite(trim(subname)//'flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2a = '// trim(cvalue) call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2b - call ESMF_LogWrite(trim(subname)//'flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2b = '// trim(cvalue) call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2c - call ESMF_LogWrite(trim(subname)//'flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2c = '// trim(cvalue) !-------------------------------- ! Export fields !-------------------------------- - call ESMF_LogWrite(trim(subname)//' export fields', ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrAtm_num, fldsFrAtm, trim(flds_scalar_name)) + if (masterproc) write(iulog,'(a)') trim(subname)//'export_fields ' + call fldlist_add(fldsFrAtm_num, fldsFrAtm, trim(flds_scalar_name)) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_topo' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_z' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_u' ) @@ -134,6 +155,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pbot' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_dens' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pslv' ) + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_o3' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainc' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc' ) @@ -169,16 +191,25 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_co2diag' ) end if - ! from atm - nitrogen deposition - call shr_ndep_readnl("drv_flds_in", ndep_nflds) if (ndep_nflds > 0) then - call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=ndep_nflds) + ! The following is when CAM/WACCM computes ndep call set_active_Faxa_nhx(.true.) call set_active_Faxa_noy(.true.) + else + ! The following is used for reading in stream data + call set_active_Faxa_nhx(.false.) + call set_active_Faxa_noy(.false.) + end if + ! Assume that 2 fields are always sent as part of Faxa_ndep + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) + + ! lightning flash freq + if (atm_provides_lightning) then + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lightning') end if ! Now advertise above export fields - call ESMF_LogWrite(trim(subname)//' advertise export fields ', ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,*) trim(subname)//' advertise export fields' do n = 1,fldsFrAtm_num call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) @@ -189,10 +220,9 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) ! Import fields !----------------- - call ESMF_LogWrite(trim(subname)//' Import Fields', ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//' import fields ' call fldlist_add(fldsToAtm_num, fldsToAtm, trim(flds_scalar_name)) - call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_anidr' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_avsdf' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_anidf' ) @@ -210,7 +240,10 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Si_snowh' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ssq' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_re' ) + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ustar' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_u10' ) + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ugustOut') + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_u10withGust') call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_taux' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_tauy' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_lat' ) @@ -232,40 +265,30 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call set_active_Faoo_fco2_ocn(.true.) end if - call ESMF_LogWrite(trim(subname)//' here1', ESMF_LOGMSG_INFO) ! dry deposition velocities from land - ALSO initialize drydep here - call seq_drydep_readnl("drv_flds_in", drydep_nflds) if (drydep_nflds > 0) then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) end if - call ESMF_LogWrite(trim(subname)//' here2', ESMF_LOGMSG_INFO) ! MEGAN VOC emissions fluxes from land - call shr_megan_readnl('drv_flds_in', megan_nflds) if (megan_nflds > 0) then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) call set_active_Fall_flxvoc(.true.) end if - call ESMF_LogWrite(trim(subname)//' here3', ESMF_LOGMSG_INFO) ! fire emissions fluxes from land - call shr_fire_emis_readnl('drv_flds_in', emis_nflds) if (emis_nflds > 0) then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_fztop') call set_active_Fall_flxfire(.true.) end if - call ESMF_LogWrite(trim(subname)//' here4', ESMF_LOGMSG_INFO) ! CARMA volumetric soil water from land - call shr_carma_readnl('drv_flds_in', carma_fields) if (carma_fields /= ' ') then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_soilw') ! optional for carma call set_active_Sl_soilw(.true.) ! check for carma end if - call ESMF_LogWrite(trim(subname)//' here5', ESMF_LOGMSG_INFO) - ! ------------------------------------------ ! Now advertise above import fields ! ------------------------------------------ @@ -276,24 +299,50 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo - call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) - end subroutine advertise_fields !=============================================================================== - subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) + subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, single_column, rc) + + use ESMF , only : ESMF_MeshGet, ESMF_StateGet + use ESMF , only : ESMF_FieldRegridGetArea,ESMF_FieldGet + use nuopc_shr_methods , only : chkerr + use shr_mpi_mod , only : shr_mpi_min, shr_mpi_max + use spmd_utils , only : masterproc, mpicom + use physics_grid , only : get_area_p + use cam_abortutils , only : check_allocate + use cam_logfile , only : iulog ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp type(ESMF_Mesh) , intent(in) :: Emesh character(len=*) , intent(in) :: flds_scalar_name integer , intent(in) :: flds_scalar_num + logical , intent(in) :: single_column integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState - type(ESMF_State) :: exportState + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Field) :: lfield + integer :: numOwnedElements + integer :: n, ierr + real(r8), allocatable :: mesh_areas(:) + real(r8), pointer :: dataptr(:) + real(r8) :: max_mod2med_areacor + real(r8) :: max_med2mod_areacor + real(r8) :: min_mod2med_areacor + real(r8) :: min_med2mod_areacor + real(r8) :: max_mod2med_areacor_glob + real(r8) :: max_med2mod_areacor_glob + real(r8) :: min_mod2med_areacor_glob + real(r8) :: min_med2mod_areacor_glob + character(len=cl) :: cvalue + character(len=cl) :: mesh_atm + character(len=cl) :: mesh_lnd + character(len=cl) :: mesh_ocn + logical :: samegrid_atm_lnd_ocn character(len=*), parameter :: subname='(atm_import_export:realize_fields)' !--------------------------------------------------------------------------- @@ -324,6 +373,78 @@ subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) mesh=Emesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine if atm/lnd/ocn are on the same grid - if so set area correction factors to 1 + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=mesh_atm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=mesh_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=mesh_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + samegrid_atm_lnd_ocn = .false. + if ( trim(mesh_lnd) /= 'UNSET' .and. trim(mesh_atm) == trim(mesh_lnd) .and. & + trim(mesh_ocn) /= 'UNSET' .and. trim(mesh_atm) == trim(mesh_ocn)) then + samegrid_atm_lnd_ocn = .true. + elseif ( trim(mesh_lnd) == 'UNSET' .and. trim(mesh_atm) == trim(mesh_ocn)) then + samegrid_atm_lnd_ocn = .true. + elseif ( trim(mesh_ocn) == 'UNSET' .and. trim(mesh_atm) == trim(mesh_lnd)) then + samegrid_atm_lnd_ocn = .true. + end if + + ! allocate area correction factors + call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate (mod2med_areacor(numOwnedElements), stat=ierr) + call check_allocate(ierr, subname, 'mod2med_areacor(numOwnedElements)', & + file=__FILE__, line=__LINE__) + allocate (med2mod_areacor(numOwnedElements), stat=ierr) + call check_allocate(ierr, subname, 'med2mod_areacor(numOwnedElements)', & + file=__FILE__, line=__LINE__) + + if (single_column .or. samegrid_atm_lnd_ocn) then + + mod2med_areacor(:) = 1._r8 + med2mod_areacor(:) = 1._r8 + + else + + ! Determine areas for regridding + call ESMF_StateGet(exportState, itemName=trim(fldsFrAtm(2)%stdname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(mesh_areas(numOwnedElements), stat=ierr) + call check_allocate(ierr, subname, 'mesh_areas(numOwnedElements)', & + file=__FILE__, line=__LINE__) + mesh_areas(:) = dataptr(:) + + ! Determine flux correction factors (module variables) + do n = 1,numOwnedElements + mod2med_areacor(n) = get_area_p(n) / mesh_areas(n) + med2mod_areacor(n) = 1._r8 / mod2med_areacor(n) + end do + deallocate(mesh_areas) + + end if + + min_mod2med_areacor = minval(mod2med_areacor) + max_mod2med_areacor = maxval(mod2med_areacor) + min_med2mod_areacor = minval(med2mod_areacor) + max_med2mod_areacor = maxval(med2mod_areacor) + call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpicom) + call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpicom) + call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpicom) + call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpicom) + + if (masterproc) then + write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',& + min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'CAM' + write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',& + min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'CAM' + end if + call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) end subroutine realize_fields @@ -334,19 +455,20 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) ! ----------------------------------------------------- ! Set field pointers in import state and - ! copy from field pointer to chunk array data structure + ! copy from field pointer to CAM-SIMA array data structure ! ----------------------------------------------------- - use spmd_utils , only : masterproc use camsrfexch , only : cam_in_t - use physics_grid , only : columns_on_task use shr_const_mod , only : shr_const_stebol -!CAMDEN TODO Need to uncomment these once carbon cycling is enabled in CAMDEN: + use shr_sys_mod , only : shr_sys_abort + use nuopc_shr_methods , only : chkerr +!CAM-SIMA NOTE: Need to uncomment these once carbon cycling is enabled in SIMA. ! use co2_cycle , only : c_i, co2_readFlux_ocn, co2_readFlux_fuel ! use co2_cycle , only : co2_transport, co2_time_interp_ocn, co2_time_interp_fuel ! use co2_cycle , only : data_flux_ocn, data_flux_fuel use physconst , only : mwco2 use time_manager , only : is_first_step, get_nstep + use physics_grid , only : columns_on_task ! input/output variabes type(ESMF_GridComp) :: gcomp @@ -356,8 +478,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) ! local variables type(ESMF_State) :: importState - integer :: i,n,c,g, num ! indices - integer :: ncols ! number of columns + integer :: i,n ! loop indices integer :: nstep logical :: overwrite_flds logical :: exists @@ -391,7 +512,6 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 10) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Get import state call NUOPC_ModelGet(gcomp, importState=importState, rc=rc) @@ -418,15 +538,11 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(importState, 'Faxx_evap', fldptr=fldptr_evap, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%wsx(i) = -fldptr_taux(g) - cam_in(c)%wsy(i) = -fldptr_tauy(g) - cam_in(c)%shf(i) = -fldptr_sen(g) - cam_in(c)%cflx(i,1) = -fldptr_evap(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%wsx(i) = -fldptr_taux(i) * med2mod_areacor(i) + cam_in%wsy(i) = -fldptr_tauy(g) * med2mod_areacor(i) + cam_in%shf(i) = -fldptr_sen(i) * med2mod_areacor(i) + cam_in%cflx(i,1) = -fldptr_evap(i) * med2mod_areacor(i) end do end if ! end of overwrite_flds @@ -462,27 +578,25 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(importState, 'Sl_lfrac', fldptr=fldptr_lfrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%lhf(i) = -fldptr_lat(g) - cam_in(c)%lwup(i) = -fldptr_lwup(g) - cam_in(c)%asdir(i) = fldptr_avsdr(g) - cam_in(c)%aldir(i) = fldptr_anidr(g) - cam_in(c)%asdif(i) = fldptr_avsdf(g) - cam_in(c)%aldif(i) = fldptr_anidf(g) - cam_in(c)%ts(i) = fldptr_tsurf(g) - cam_in(c)%sst(i) = fldptr_tocn(g) - cam_in(c)%tref(i) = fldptr_tref(g) - cam_in(c)%qref(i) = fldptr_qref(g) - cam_in(c)%u10(i) = fldptr_u10(g) - cam_in(c)%snowhland(i) = fldptr_snowhland(g) - cam_in(c)%snowhice(i) = fldptr_snowhice(g) - cam_in(c)%icefrac(i) = fldptr_ifrac(g) - cam_in(c)%ocnfrac(i) = fldptr_ofrac(g) - cam_in(c)%landfrac(i) = fldptr_lfrac(g) - g = g + 1 - end do + + ! Only do area correction on fluxes + do i = 1, columns_on_task + cam_in%lhf(i) = -fldptr_lat(i) * med2mod_areacor(i) + cam_in%lwup(i) = -fldptr_lwup(i) * med2mod_areacor(i) + cam_in%asdir(i) = fldptr_avsdr(i) + cam_in%aldir(i) = fldptr_anidr(i) + cam_in%asdif(i) = fldptr_avsdf(i) + cam_in%aldif(i) = fldptr_anidf(i) + cam_in%ts(i) = fldptr_tsurf(i) + cam_in%sst(i) = fldptr_tocn(i) + cam_in%tref(i) = fldptr_tref(i) + cam_in%qref(i) = fldptr_qref(i) + cam_in%u10(i) = fldptr_u10(i) + cam_in%snowhland(i) = fldptr_snowhland(i) + cam_in%snowhice(i) = fldptr_snowhice(i) + cam_in%icefrac(i) = fldptr_ifrac(i) + cam_in%ocnfrac(i) = fldptr_ofrac(i) + cam_in%landfrac(i) = fldptr_lfrac(i) end do ! Optional fields @@ -490,104 +604,76 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) call state_getfldptr(importState, 'Sl_ram1', fldptr=fldptr1d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - if ( associated(cam_in(c)%ram1) ) then - do i = 1, get_ncols_p(c) - cam_in(c)%ram1(i) = fldptr1d(g) - g = g + 1 - end do - end if - end do + if ( associated(cam_in%ram1) ) then + do i = 1, columns_on_task + cam_in%ram1(i) = fldptr1d(i) + end do + end if end if call state_getfldptr(importState, 'Sl_fv', fldptr=fldptr1d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - if ( associated(cam_in(c)%fv) ) then - do i = 1,get_ncols_p(c) - cam_in(c)%fv(i) = fldptr1d(g) - g = g + 1 - end do - end if - end do + if ( associated(cam_in%fv) ) then + do i = 1, columns_on_task + cam_in%fv(i) = fldptr1d(i) + end do + end if end if ! For CARMA - soil water from land call state_getfldptr(importState, 'Sl_soilw', fldptr=fldptr1d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - if ( associated(cam_in(c)%soilw)) then - do i = 1,get_ncols_p(c) - cam_in(c)%soilw(i) = fldptr1d(g) - g = g+1 - end do - end if - end do + if ( associated(cam_in%soilw)) then + do i = 1, columns_on_task + cam_in%soilw(i) = fldptr1d(i) + end do + end if end if ! dry deposition fluxes from land call state_getfldptr(importState, 'Fall_flxdst', fldptr2d=fldptr2d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - if ( associated(cam_in(c)%dstflx) ) then - do i = 1,get_ncols_p(c) - do n = 1, size(fldptr2d, dim=1) - cam_in(c)%dstflx(i,n) = fldptr2d(n,g) - end do - g = g + 1 + if ( associated(cam_in%dstflx) ) then + do i = 1, columns_on_task + do n = 1, size(fldptr2d, dim=1) + cam_in%dstflx(i,n) = fldptr2d(n,i) * med2mod_areacor(i) end do - end if - end do + end do + end if end if ! MEGAN VOC emis fluxes from land call state_getfldptr(importState, 'Fall_voc', fldptr2d=fldptr2d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c=begchunk,endchunk - if ( associated(cam_in(c)%meganflx) ) then - do i = 1,get_ncols_p(c) - do n = 1, size(fldptr2d, dim=1) - cam_in(c)%meganflx(i,n) = fldptr2d(n,g) - end do - g = g + 1 + if ( associated(cam_in%meganflx) ) then + do i = 1, columns_on_task + do n = 1, size(fldptr2d, dim=1) + cam_in%meganflx(i,n) = fldptr2d(n,i) * med2mod_areacor(i) end do - end if - end do + end do + end if end if ! fire emission fluxes from land call state_getfldptr(importState, 'Fall_fire', fldptr2d=fldptr2d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - if ( associated(cam_in(c)%fireflx) .and. associated(cam_in(c)%fireztop) ) then - do i = 1,get_ncols_p(c) - do n = 1, size(fldptr2d, dim=1) - cam_in(c)%fireflx(i,n) = fldptr2d(n,g) - end do - g = g + 1 + if ( associated(cam_in%fireflx) .and. associated(cam_in%fireztop) ) then + do i = 1, columns_on_task + do n = 1, size(fldptr2d, dim=1) + cam_in%fireflx(i,n) = fldptr2d(n,i) * med2mod_areacor(i) end do - end if - end do + end do + end if end if call state_getfldptr(importState, 'Sl_fztop', fldptr=fldptr1d, exists=exists, rc=rc) if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%fireztop(i) = fldptr1d(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%fireztop(i) = fldptr1d(i) end do end if @@ -595,13 +681,9 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) call state_getfldptr(importState, 'Sl_ddvel', fldptr2d=fldptr2d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - do n = 1, size(fldptr2d, dim=1) - cam_in(c)%depvel(i,n) = fldptr2d(n,g) - end do - g = g + 1 + do i = 1, columns_on_task + do n = 1, size(fldptr2d, dim=1) + cam_in%depvel(i,n) = fldptr2d(n,i) end do end do end if @@ -610,34 +692,38 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) call state_getfldptr(importState, 'So_ustar', fldptr=fldptr1d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%ustar(i) = fldptr1d(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%ustar(i) = fldptr1d(i) end do end if call state_getfldptr(importState, 'So_re', fldptr=fldptr1d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%re(i)= fldptr1d(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%re(i)= fldptr1d(i) end do end if call state_getfldptr(importState, 'So_ssq', fldptr=fldptr1d, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%ssq(i) = fldptr1d(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%ssq(i) = fldptr1d(i) + end do + end if + + call state_getfldptr(importState, 'So_ugustOut', fldptr=fldptr1d, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + do i = 1, columns_on_task + cam_in%ugustOut(i) = fldptr1d(i) + end do + end if + + call state_getfldptr(importState, 'So_u10withGust', fldptr=fldptr1d, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + do i = 1, columns_on_task + cam_in%u10withGusts(i) = fldptr1d(i) end do end if @@ -645,23 +731,15 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) call state_getfldptr(importState, 'Fall_fco2_lnd', fldptr=fldptr1d, exists=exists_fco2_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists_fco2_lnd) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%fco2_lnd(i) = -fldptr1d(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%fco2_lnd(i) = -fldptr1d(i) * med2mod_areacor(i) end do end if call state_getfldptr(importState, 'Faoo_fco2_ocn', fldptr=fldptr1d, exists=exists_fco2_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists_fco2_ocn) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%fco2_ocn(i) = -fldptr1d(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%fco2_ocn(i) = -fldptr1d(i) * med2mod_areacor(i) end do else ! Consistency check @@ -671,12 +749,8 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) end if call state_getfldptr(importState, 'Faoo_dms_ocn', fldptr=fldptr1d, exists=exists, rc=rc) if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - cam_in(c)%fdms(i) = -fldptr1d(g) - g = g + 1 - end do + do i = 1, columns_on_task + cam_in%fdms(i) = -fldptr1d(i) * med2mod_areacor(i) end do end if @@ -701,36 +775,35 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) ! from lnd : through coupler or zero ! all co2 fluxes in unit kgCO2/m2/s - do c=begchunk,endchunk - do i=1, get_ncols_p(c) + do i=1, columns_on_task - ! co2 flux from ocn - if (exists_fco2_ocn) then - cam_in(c)%cflx(i,c_i(1)) = cam_in(c)%fco2_ocn(i) - else if (co2_readFlux_ocn) then - ! convert from molesCO2/m2/s to kgCO2/m2/s - cam_in(c)%cflx(i,c_i(1)) = & - -data_flux_ocn%co2flx(i,c)*(1._r8- cam_in(c)%landfrac(i))*mwco2*1.0e-3_r8 + ! co2 flux from ocn + if (exists_fco2_ocn) then + cam_in%cflx(i,c_i(1)) = cam_in%fco2_ocn(i) + else if (co2_readFlux_ocn) then + ! convert from molesCO2/m2/s to kgCO2/m2/s + cam_in%cflx(i,c_i(1)) = & + -data_flux_ocn%co2flx(i,c)*(1._r8- cam_in%landfrac(i))*mwco2*1.0e-3_r8 else - cam_in(c)%cflx(i,c_i(1)) = 0._r8 + cam_in%cflx(i,c_i(1)) = 0._r8 end if ! co2 flux from fossil fuel if (co2_readFlux_fuel) then - cam_in(c)%cflx(i,c_i(2)) = data_flux_fuel%co2flx(i,c) + cam_in%cflx(i,c_i(2)) = data_flux_fuel%co2flx(i) else - cam_in(c)%cflx(i,c_i(2)) = 0._r8 + cam_in%cflx(i,c_i(2)) = 0._r8 end if ! co2 flux from land (cpl already multiplies flux by land fraction) if (exists_fco2_lnd) then - cam_in(c)%cflx(i,c_i(3)) = cam_in(c)%fco2_lnd(i) + cam_in%cflx(i,c_i(3)) = cam_in%fco2_lnd(i) else - cam_in(c)%cflx(i,c_i(3)) = 0._r8 + cam_in%cflx(i,c_i(3)) = 0._r8 end if ! merged co2 flux - cam_in(c)%cflx(i,c_i(4)) = cam_in(c)%cflx(i,c_i(1)) + cam_in(c)%cflx(i,c_i(2)) + cam_in(c)%cflx(i,c_i(3)) + cam_in%cflx(i,c_i(4)) = cam_in%cflx(i,c_i(1)) + cam_in%cflx(i,c_i(2)) + cam_in%cflx(i,c_i(3)) end do end do end if @@ -738,85 +811,52 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) ! if first step, determine longwave up flux from the surface temperature if (first_time) then if (is_first_step()) then - do c=begchunk, endchunk - do i=1, get_ncols_p(c) - cam_in(c)%lwup(i) = shr_const_stebol*(cam_in(c)%ts(i)**4) - end do + do i=1, columns_on_task + cam_in%lwup(i) = shr_const_stebol*(cam_in%ts(i)**4) end do end if first_time = .false. end if - !----------------------------------------------------------------- - ! Debug import - !----------------------------------------------------------------- - - if (debug_import > 0 .and. masterproc .and. get_nstep()<5) then - nstep = get_nstep() - g=1 - do c=begchunk, endchunk - do i=1, get_ncols_p(c) - write(iulog,F01)'import: nstep, g, Faxx_tauy = ',nstep,g,-cam_in(c)%wsy(i) - write(iulog,F01)'import: nstep, g, Faxx_taux = ',nstep,g,-cam_in(c)%wsx(i) - write(iulog,F01)'import: nstep, g, Faxx_shf = ',nstep,g,-cam_in(c)%shf(i) - write(iulog,F01)'import: nstep, g, Faxx_lhf = ',nstep,g,-cam_in(c)%lhf(i) - write(iulog,F01)'import: nstep, g, Faxx_evap = ',nstep,g,-cam_in(c)%cflx(i,1) - write(iulog,F01)'import: nstep, g, Faxa_lwup = ',nstep,g,-cam_in(c)%lwup(i) - write(iulog,F01)'import: nstep, g, Sx_asdir = ',nstep,g, cam_in(c)%asdir(i) - write(iulog,F01)'import: nstep, g, Sx_aldir = ',nstep,g, cam_in(c)%aldir(i) - write(iulog,F01)'import: nstep, g, Sx_asdif = ',nstep,g, cam_in(c)%asdif(i) - write(iulog,F01)'import: nstep, g, Sx_aldif = ',nstep,g, cam_in(c)%aldif(i) - write(iulog,F01)'import: nstep, g, Sx_t = ',nstep,g, cam_in(c)%ts(i) - write(iulog,F01)'import: nstep, g, So_t = ',nstep,g, cam_in(c)%sst(i) - write(iulog,F01)'import: nstep, g, Sl_snowh = ',nstep,g, cam_in(c)%snowhland(i) - write(iulog,F01)'import: nstep, g, Si_snowh = ',nstep,g, cam_in(c)%snowhice(i) - write(iulog,F01)'import: nstep, g, Si_ifrac = ',nstep,g, cam_in(c)%icefrac(i) - write(iulog,F01)'import: nstep, g, So_ofrac = ',nstep,g, cam_in(c)%ocnfrac(i) - write(iulog,F01)'import: nstep, g, Sl_lfrac = ',nstep,g, cam_in(c)%landfrac(i) - write(iulog,F01)'import: nstep, g, Sx_tref = ',nstep,g, cam_in(c)%tref(i) - write(iulog,F01)'import: nstep, g, Sx_qref = ',nstep,g, cam_in(c)%qref(i) - write(iulog,F01)'import: nstep, g, Sx_qu10 = ',nstep,g, cam_in(c)%u10(i) - g = g + 1 - end do - end do - end if - !Remove once the "cam_in" object has been fully implemented. -JN #endif - if (dbug_flag > 10) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end subroutine import_fields !=============================================================================== - subroutine export_fields( gcomp, cam_out, rc) + subroutine export_fields( gcomp, model_mesh, model_clock, cam_out, rc) ! ----------------------------------------------------- ! Set field pointers in export set - ! Copy from chunk array data structure into state fldptr + ! Copy from CAM-SIMA array data structure into state fldptr ! ----------------------------------------------------- - use camsrfexch , only : cam_out_t - use physics_grid , only : columns_on_task - use time_manager , only : is_first_step, get_nstep - use spmd_utils , only : masterproc + use ESMF , only : ESMF_Clock + use nuopc_shr_methods , only : chkerr + use srf_field_check , only : active_Faxa_nhx, active_Faxa_noy + use camsrfexch , only : cam_out_t + use time_manager , only : is_first_step, get_nstep + use physics_grid , only : columns_on_task + use atm_stream_ndep , only : stream_ndep_init, stream_ndep_interp + use atm_stream_ndep , only : stream_ndep_is_initialized !------------------------------- ! Pack the export state !------------------------------- ! input/output variables - type(ESMF_GridComp) :: gcomp - type(cam_out_t) , intent(in) :: cam_out - integer , intent(out) :: rc + type(ESMF_GridComp) :: gcomp + type(ESMF_Mesh) , intent(in) :: model_mesh + type(ESMF_Clock), intent(in) :: model_clock + type(cam_out_t) , intent(inout) :: cam_out + integer , intent(out) :: rc ! local variables type(ESMF_State) :: exportState - integer :: i,m,c,n,g ! indices - integer :: ncols ! Number of columns - integer :: nstep + integer :: i ! index variable logical :: exists + real(r8) :: scale_ndep ! 2d pointers real(r8), pointer :: fldptr_ndep(:,:) real(r8), pointer :: fldptr_bcph(:,:) , fldptr_ocph(:,:) @@ -833,6 +873,8 @@ subroutine export_fields( gcomp, cam_out, rc) real(r8), pointer :: fldptr_shum(:) , fldptr_dens(:) real(r8), pointer :: fldptr_ptem(:) , fldptr_pslv(:) real(r8), pointer :: fldptr_co2prog(:) , fldptr_co2diag(:) + real(r8), pointer :: fldptr_ozone(:) + real(r8), pointer :: fldptr_lght(:) character(len=*), parameter :: subname='(atm_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -866,25 +908,21 @@ subroutine export_fields( gcomp, cam_out, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(exportState, 'Sa_pslv', fldptr=fldptr_pslv, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - fldptr_topo(g) = cam_out(c)%topo(i) - fldptr_zbot(g) = cam_out(c)%zbot(i) - fldptr_ubot(g) = cam_out(c)%ubot(i) - fldptr_vbot(g) = cam_out(c)%vbot(i) - fldptr_pbot(g) = cam_out(c)%pbot(i) - fldptr_tbot(g) = cam_out(c)%tbot(i) - fldptr_shum(g) = cam_out(c)%qbot(i,1) - fldptr_dens(g) = cam_out(c)%rho(i) - fldptr_ptem(g) = cam_out(c)%thbot(i) - fldptr_pslv(g) = cam_out(c)%psl(i) - g = g + 1 - end do + do i = 1, columns_on_task + fldptr_topo(i) = cam_out%topo(i) + fldptr_zbot(i) = cam_out%zbot(i) + fldptr_ubot(i) = cam_out%ubot(i) + fldptr_vbot(i) = cam_out%vbot(i) + fldptr_pbot(i) = cam_out%pbot(i) + fldptr_tbot(i) = cam_out%tbot(i) + fldptr_shum(i) = cam_out%qbot(i,1) + fldptr_dens(i) = cam_out%rho(i) + fldptr_ptem(i) = cam_out%thbot(i) + fldptr_pslv(i) = cam_out%psl(i) end do ! required export flux variables - call state_getfldptr(exportState, 'Faxa_swnet', fldptr=fldptr_swnet, rc=rc) + call state_getfldptr(exportState, 'Faxa_swnet', fldptr=fldptr_swnet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(exportState, 'Faxa_lwdn' , fldptr=fldptr_lwdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -904,21 +942,17 @@ subroutine export_fields( gcomp, cam_out, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(exportState, 'Faxa_swvdf', fldptr=fldptr_solsd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - fldptr_lwdn(g) = cam_out(c)%flwds(i) - fldptr_swnet(g) = cam_out(c)%netsw(i) - fldptr_snowc(g) = cam_out(c)%precsc(i)*1000._r8 - fldptr_snowl(g) = cam_out(c)%precsl(i)*1000._r8 - fldptr_rainc(g) = (cam_out(c)%precc(i)-cam_out(c)%precsc(i))*1000._r8 - fldptr_rainl(g) = (cam_out(c)%precl(i)-cam_out(c)%precsl(i))*1000._r8 - fldptr_soll(g) = cam_out(c)%soll(i) - fldptr_sols(g) = cam_out(c)%sols(i) - fldptr_solld(g) = cam_out(c)%solld(i) - fldptr_solsd(g) = cam_out(c)%solsd(i) - g = g + 1 - end do + do i = 1, columns_on_task + fldptr_lwdn(i) = cam_out%flwds(i) * mod2med_areacor(i) + fldptr_swnet(i) = cam_out%netsw(i) * mod2med_areacor(i) + fldptr_snowc(i) = cam_out%precsc(i)*1000._r8 * mod2med_areacor(i) + fldptr_snowl(i) = cam_out%precsl(i)*1000._r8 * mod2med_areacor(i) + fldptr_rainc(i) = (cam_out%precc(i) - cam_out(c)%precsc(i))*1000._r8 * mod2med_areacor(i) + fldptr_rainl(i) = (cam_out%precl(i) - cam_out(c)%precsl(i))*1000._r8 * mod2med_areacor(i) + fldptr_soll(i) = cam_out%soll(i) * mod2med_areacor(i) + fldptr_sols(i) = cam_out%sols(i) * mod2med_areacor(i) + fldptr_solld(i) = cam_out%solld(i) * mod2med_areacor(i) + fldptr_solsd(i) = cam_out%solsd(i) * mod2med_areacor(i) end do ! aerosol deposition fluxes @@ -932,114 +966,79 @@ subroutine export_fields( gcomp, cam_out, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! (1) => bcphidry, (2) => bcphodry, (3) => bcphiwet ! (1) => ocphidry, (2) => ocphodry, (3) => ocphiwet - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - fldptr_bcph(1,g) = cam_out(c)%bcphidry(i) - fldptr_bcph(2,g) = cam_out(c)%bcphodry(i) - fldptr_bcph(3,g) = cam_out(c)%bcphiwet(i) - fldptr_ocph(1,g) = cam_out(c)%ocphidry(i) - fldptr_ocph(2,g) = cam_out(c)%ocphodry(i) - fldptr_ocph(3,g) = cam_out(c)%ocphiwet(i) - fldptr_dstdry(1,g) = cam_out(c)%dstdry1(i) - fldptr_dstdry(2,g) = cam_out(c)%dstdry2(i) - fldptr_dstdry(3,g) = cam_out(c)%dstdry3(i) - fldptr_dstdry(4,g) = cam_out(c)%dstdry4(i) - fldptr_dstwet(1,g) = cam_out(c)%dstwet1(i) - fldptr_dstwet(2,g) = cam_out(c)%dstwet2(i) - fldptr_dstwet(3,g) = cam_out(c)%dstwet3(i) - fldptr_dstwet(4,g) = cam_out(c)%dstwet4(i) - g = g + 1 - end do + do i = 1, columns_on_task + fldptr_bcph(1,i) = cam_out%bcphidry(i) * mod2med_areacor(i) + fldptr_bcph(2,i) = cam_out%bcphodry(i) * mod2med_areacor(i) + fldptr_bcph(3,i) = cam_out%bcphiwet(i) * mod2med_areacor(i) + fldptr_ocph(1,i) = cam_out%ocphidry(i) * mod2med_areacor(i) + fldptr_ocph(2,i) = cam_out%ocphodry(i) * mod2med_areacor(i) + fldptr_ocph(3,i) = cam_out%ocphiwet(i) * mod2med_areacor(i) + fldptr_dstdry(1,i) = cam_out%dstdry1(i) * mod2med_areacor(i) + fldptr_dstdry(2,i) = cam_out%dstdry2(i) * mod2med_areacor(i) + fldptr_dstdry(3,i) = cam_out%dstdry3(i) * mod2med_areacor(i) + fldptr_dstdry(4,i) = cam_out%dstdry4(i) * mod2med_areacor(i) + fldptr_dstwet(1,i) = cam_out%dstwet1(i) * mod2med_areacor(i) + fldptr_dstwet(2,i) = cam_out%dstwet2(i) * mod2med_areacor(i) + fldptr_dstwet(3,i) = cam_out%dstwet3(i) * mod2med_areacor(i) + fldptr_dstwet(4,i) = cam_out%dstwet4(i) * mod2med_areacor(i) end do - call state_getfldptr(exportState, 'Sa_co2prog', fldptr=fldptr_co2prog, exists=exists, rc=rc) + call state_getfldptr(exportState, 'Sa_o3', fldptr=fldptr_ozone, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - fldptr_co2prog(g) = cam_out(c)%co2prog(i) ! atm prognostic co2 - g = g + 1 - end do + do i = 1, columns_on_task + fldptr_ozone(i) = cam_out%ozone(i) ! atm ozone end do end if - call state_getfldptr(exportState, 'Sa_co2diag', fldptr=fldptr_co2diag, exists=exists, rc=rc) + call state_getfldptr(exportState, 'Sa_lightning', fldptr=fldptr_lght, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - fldptr_co2diag(g) = cam_out(c)%co2diag(i) ! atm diagnostic co2 - g = g + 1 - end do + do i = 1, columns_on_task + fldptr_lght(i) = cam_out%lightning_flash_freq(i) ! cloud-to-ground lightning flash frequency (/min) end do end if - call state_getfldptr(exportState, 'Faxa_ndep', fldptr2d=fldptr_ndep, exists=exists, rc=rc) + call state_getfldptr(exportState, 'Sa_co2prog', fldptr=fldptr_co2prog, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - ! (1) => nhx, (2) => noy - g = 1 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - fldptr_ndep(1,g) = cam_out(c)%nhx_nitrogen_flx(i) - fldptr_ndep(2,g) = cam_out(c)%noy_nitrogen_flx(i) - g = g + 1 - end do + do i = 1, columns_on_task + fldptr_co2prog(i) = cam_out%co2prog(i) ! atm prognostic co2 end do end if - !----------------------------------------------------------------- - ! Debug export - !----------------------------------------------------------------- - - if (debug_export > 0 .and. masterproc .and. get_nstep()<5) then - nstep = get_nstep() - g=1 - do c=begchunk, endchunk - do i=1, get_ncols_p(c) - write(iulog,F01)'export: nstep, g, Sa_z = ',nstep,g,cam_out(c)%zbot(i) - write(iulog,F01)'export: nstep, g, Sa_topo = ',nstep,g,cam_out(c)%topo(i) - write(iulog,F01)'export: nstep, g, Sa_u = ',nstep,g,cam_out(c)%ubot(i) - write(iulog,F01)'export: nstep, g, Sa_v = ',nstep,g,cam_out(c)%vbot(i) - write(iulog,F01)'export: nstep, g, Sa_tbot = ',nstep,g,cam_out(c)%tbot(i) - write(iulog,F01)'export: nstep, g, Sa_ptem = ',nstep,g,cam_out(c)%thbot(i) - write(iulog,F01)'export: nstep, g, Sa_pbot = ',nstep,g,cam_out(c)%pbot(i) - write(iulog,F01)'export: nstep, g, Sa_shum = ',nstep,g,cam_out(c)%qbot(i,1) - write(iulog,F01)'export: nstep, g, Sa_dens = ',nstep,g,cam_out(c)%rho(i) - write(iulog,F01)'export: nstep, g, Faxa_swnet = ',nstep,g,cam_out(c)%netsw(i) - write(iulog,F01)'export: nstep, g, Faxa_lwdn = ',nstep,g,cam_out(c)%flwds(i) - write(iulog,F01)'export: nstep, g, Faxa_rainc = ',nstep,g,(cam_out(c)%precc(i)-cam_out(c)%precsc(i))*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_rainl = ',nstep,g,(cam_out(c)%precl(i)-cam_out(c)%precsl(i))*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_snowc = ',nstep,g,cam_out(c)%precsc(i)*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_snowl = ',nstep,g,cam_out(c)%precsl(i)*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_swndr = ',nstep,g,cam_out(c)%soll(i) - write(iulog,F01)'export: nstep, g, Faxa_swvdr = ',nstep,g,cam_out(c)%sols(i) - write(iulog,F01)'export: nstep, g, Faxa_swndf = ',nstep,g,cam_out(c)%solld(i) - write(iulog,F01)'export: nstep, g, Faxa_swvdf = ',nstep,g,cam_out(c)%solsd(i) - write(iulog,F01)'export: nstep, g, Faxa_bcphidry = ',nstep,g,cam_out(c)%bcphidry(i) - write(iulog,F01)'export: nstep, g, Faxa_bcphodry = ',nstep,g,cam_out(c)%bcphodry(i) - write(iulog,F01)'export: nstep, g, Faxa_bcphiwet = ',nstep,g,cam_out(c)%bcphiwet(i) - write(iulog,F01)'export: nstep, g, Faxa_ocphidry = ',nstep,g,cam_out(c)%ocphidry(i) - write(iulog,F01)'export: nstep, g, Faxa_ocphodry = ',nstep,g,cam_out(c)%ocphodry(i) - write(iulog,F01)'export: nstep, g, Faxa_ocphidry = ',nstep,g,cam_out(c)%ocphiwet(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet1 = ',nstep,g,cam_out(c)%dstwet1(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet1 = ',nstep,g,cam_out(c)%dstdry1(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet2 = ',nstep,g,cam_out(c)%dstwet2(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet2 = ',nstep,g,cam_out(c)%dstdry2(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet3 = ',nstep,g,cam_out(c)%dstwet3(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet3 = ',nstep,g,cam_out(c)%dstdry3(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet4 = ',nstep,g,cam_out(c)%dstwet4(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet4 = ',nstep,g,cam_out(c)%dstdry4(i) - write(iulog,F01)'export: nstep, g, Sa_co2prog = ',nstep,g,cam_out(c)%co2prog(i) - write(iulog,F01)'export: nstep, g, Sa_co2diag = ',nstep,g,cam_out(c)%co2diag(i) - g = g + 1 - end do + call state_getfldptr(exportState, 'Sa_co2diag', fldptr=fldptr_co2diag, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + do i = 1, columns_on_task + fldptr_co2diag(i) = cam_out%co2diag(i) ! atm diagnostic co2 end do end if + ! If ndep fields are not computed in cam and must be obtained from the ndep input stream + call state_getfldptr(exportState, 'Faxa_ndep', fldptr2d=fldptr_ndep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. active_Faxa_nhx .and. .not. active_Faxa_noy) then + if (.not. stream_ndep_is_initialized) then + call stream_ndep_init(model_mesh, model_clock, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + stream_ndep_is_initialized = .true. + end if + call stream_ndep_interp(cam_out, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! NDEP read from forcing is expected to be in units of gN/m2/sec - but the mediator + ! expects units of kgN/m2/sec + scale_ndep = .001_r8 + else + ! If waccm computes ndep, then its in units of kgN/m2/s - and the mediator expects + ! units of kgN/m2/sec, so the following conversion needs to happen + scale_ndep = 1._r8 + end if + do i = 1, columns_on_task + fldptr_ndep(1,i) = cam_out(c)%nhx_nitrogen_flx(i) * scale_ndep * mod2med_areacor(i) + fldptr_ndep(2,i) = cam_out(c)%noy_nitrogen_flx(i) * scale_ndep * mod2med_areacor(i) + end do + !Remove once the "cam_in" object has been fully implemented. -JN #endif @@ -1049,6 +1048,9 @@ end subroutine export_fields subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) + ! use statements + use ESMF , only : ESMF_LOGMSG_ERROR + ! input/otuput variables integer , intent(inout) :: num type(fldlist_type) , intent(inout) :: fldlist(:) @@ -1081,14 +1083,18 @@ end subroutine fldlist_add subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) - use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize - use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove - use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU + use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize + use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove + use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_LOGERR_PASSTHRU + use nuopc_shr_methods , only : chkerr + use spmd_utils , only : masterproc + use cam_logfile , only : iulog + ! input/output variables type(ESMF_State) , intent(inout) :: state - type(fldlist_type) , intent(in) :: fldList(:) + type(fldlist_type) , intent(in) :: fldList(:) integer , intent(in) :: numflds character(len=*) , intent(in) :: flds_scalar_name integer , intent(in) :: flds_scalar_num @@ -1110,8 +1116,9 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala stdname = fldList(n)%stdname if (NUOPC_IsConnected(state, fieldName=stdname)) then if (stdname == trim(flds_scalar_name)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & - ESMF_LOGMSG_INFO) + if (masterproc) then + write(iulog,'(a)') trim(subname)//trim(tag)//" field = "//trim(stdname)//" is connected on root pe" + end if ! Create the scalar field call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return @@ -1123,14 +1130,17 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & gridToFieldMap=(/2/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(msg,*) trim(subname)// trim(tag)//" Field = "//trim(stdname)// " is connected using mesh ", & - "with lbound ", fldlist(n)%ungridded_lbound,' and with ubound ',fldlist(n)%ungridded_ubound - call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) + if (masterproc) then + write(iulog,'(a,i8,a,i8)') trim(subname)// trim(tag)//" Field = "//trim(stdname)// & + " is connected using mesh with lbound ", fldlist(n)%ungridded_lbound,& + " and with ubound ",fldlist(n)%ungridded_ubound + end if else field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - write(msg,*) trim(subname)// trim(tag)//" Field = "//trim(stdname)// " is connected using mesh " - call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) + if (masterproc) then + write(iulog,'(a)') trim(subname)// trim(tag)//" Field = "//trim(stdname)// " is connected using mesh " + end if end if endif @@ -1139,8 +1149,9 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else if (stdname /= trim(flds_scalar_name)) then - call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO) + if (masterproc) then + write(iulog,'(a)')trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is not connected" + end if call ESMF_StateRemove(state, (/stdname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if @@ -1188,16 +1199,17 @@ end subroutine SetScalarField end subroutine fldlist_realize !=============================================================================== - subroutine state_getfldptr(State, fldname, fldptr, fldptr2d, exists, rc) ! ---------------------------------------------- ! Get pointer to a state field ! ---------------------------------------------- - use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet + use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + use nuopc_shr_methods , only : chkerr ! input/output variables type(ESMF_State) , intent(in) :: State @@ -1213,56 +1225,27 @@ subroutine state_getfldptr(State, fldname, fldptr, fldptr2d, exists, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh integer :: nnodes, nelements + logical :: lexists character(len=*), parameter :: subname='(atm_import_export:state_getfldptr)' ! ---------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif + lexists = .true. ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (present(exists)) then - ! if field exists then create output array - else do nothing - if (itemflag == ESMF_STATEITEM_NOTFOUND) then - exists = .false. - RETURN - else - exists = .true. - end if - else + call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (itemflag == ESMF_STATEITEM_NOTFOUND) then - call shr_sys_abort('variable '//trim(fldname)//' must be present ') + lexists = .false. end if + exists = lexists end if - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, status=status, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (lexists) then + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (present(fldptr)) then call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1270,11 +1253,7 @@ subroutine state_getfldptr(State, fldname, fldptr, fldptr2d, exists, rc) call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - endif ! status - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif + end if end subroutine state_getfldptr diff --git a/src/cpl/nuopc/atm_stream_ndep.F90 b/src/cpl/nuopc/atm_stream_ndep.F90 new file mode 100644 index 00000000..dc8616ad --- /dev/null +++ b/src/cpl/nuopc/atm_stream_ndep.F90 @@ -0,0 +1,262 @@ +module atm_stream_ndep + + !----------------------------------------------------------------------- + ! Contains methods for reading in nitrogen deposition data file + ! Also includes functions for dynamic ndep file handling and + ! interpolation. + !----------------------------------------------------------------------- + ! + use ESMF , only : ESMF_Clock + use dshr_strdata_mod , only : shr_strdata_type + use shr_kind_mod , only : CS => shr_kind_cs + + implicit none + private + + public :: stream_ndep_init ! position datasets for dynamic ndep + public :: stream_ndep_interp ! interpolates between two years of ndep file data + + private :: stream_ndep_check_units ! Check the units and make sure they can be used + + type(shr_strdata_type) :: sdat_ndep ! input data stream + logical, public :: stream_ndep_is_initialized = .false. + character(len=CS) :: stream_varlist_ndep(2) + type(ESMF_Clock) :: model_clock + + character(len=*), parameter :: sourcefile = & + __FILE__ + +!============================================================================== +contains +!============================================================================== + + subroutine stream_ndep_init(model_mesh, model_clock, rc) + ! + ! Initialize data stream information. + + ! Uses: + use ESMF , only: ESMF_Mesh + use ESMF , only: ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only: ESMF_Finalize, ESMF_LogFoundError + use cam_instance , only: inst_suffix + use shr_nl_mod , only: shr_nl_find_group_name + use shr_kind_mod , only: CL => shr_kind_cl + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_log_mod , only: errMsg => shr_log_errMsg + use dshr_strdata_mod , only: shr_strdata_init_from_inline + use mpi , only: mpi_character, mpi_integer + use spmd_utils , only: mpicom, masterproc, iam + use cam_logfile , only: iulog + use cam_abortutils , only: endrun + + ! input/output variables + type(ESMF_CLock), intent(in) :: model_clock + type(ESMF_Mesh) , intent(in) :: model_mesh + integer , intent(out) :: rc + + ! local variables + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + character(len=CL) :: stream_ndep_data_filename + character(len=CL) :: stream_ndep_mesh_filename + character(len=CL) :: filein ! atm namelist file + integer :: stream_ndep_year_first ! first year in stream to use + integer :: stream_ndep_year_last ! last year in stream to use + integer :: stream_ndep_year_align ! align stream_year_firstndep with + integer :: ierr + character(*), parameter :: subName = "('stream_ndep_init')" + !----------------------------------------------------------------------- + + namelist /ndep_stream_nl/ & + stream_ndep_data_filename, & + stream_ndep_mesh_filename, & + stream_ndep_year_first, & + stream_ndep_year_last, & + stream_ndep_year_align + + rc = ESMF_SUCCESS + + ! Default values for namelist + stream_ndep_data_filename = ' ' + stream_ndep_mesh_filename = ' ' + stream_ndep_year_first = 1 ! first year in stream to use + stream_ndep_year_last = 1 ! last year in stream to use + stream_ndep_year_align = 1 ! align stream_ndep_year_first with this model year + + ! For now variable list in stream data file is hard-wired + stream_varlist_ndep = (/'NDEP_NHx_month', 'NDEP_NOy_month'/) + + ! Read ndep_stream namelist + if (masterproc) then + filein = "atm_in" // trim(inst_suffix) + open( newunit=nu_nml, file=trim(filein), status='old', iostat=nml_error ) + if (nml_error /= 0) then + call endrun(subName//': ERROR opening '//trim(filein)//errMsg(sourcefile, __LINE__)) + end if + call shr_nl_find_group_name(nu_nml, 'ndep_stream_nl', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndep_stream_nl, iostat=nml_error) + if (nml_error /= 0) then + call endrun(' ERROR reading ndep_stream_nl namelist'//errMsg(sourcefile, __LINE__)) + end if + else + call endrun(' ERROR finding ndep_stream_nl namelist'//errMsg(sourcefile, __LINE__)) + end if + close(nu_nml) + endif + call mpi_bcast(stream_ndep_mesh_filename, len(stream_ndep_mesh_filename), mpi_character, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_mesh_filename") + call mpi_bcast(stream_ndep_data_filename, len(stream_ndep_data_filename), mpi_character, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_data_filename") + call mpi_bcast(stream_ndep_year_first, 1, mpi_integer, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_year_first") + call mpi_bcast(stream_ndep_year_last, 1, mpi_integer, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_year_last") + call mpi_bcast(stream_ndep_year_align, 1, mpi_integer, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_year_align") + + if (masterproc) then + write(iulog,'(a)' ) ' ' + write(iulog,'(a,i8)') 'stream ndep settings:' + write(iulog,'(a,a)' ) ' stream_ndep_data_filename = ',trim(stream_ndep_data_filename) + write(iulog,'(a,a)' ) ' stream_ndep_mesh_filename = ',trim(stream_ndep_mesh_filename) + write(iulog,'(a,a,a)') ' stream_varlist_ndep = ',trim(stream_varlist_ndep(1)), trim(stream_varlist_ndep(2)) + write(iulog,'(a,i8)') ' stream_ndep_year_first = ',stream_ndep_year_first + write(iulog,'(a,i8)') ' stream_ndep_year_last = ',stream_ndep_year_last + write(iulog,'(a,i8)') ' stream_ndep_year_align = ',stream_ndep_year_align + write(iulog,'(a)' ) ' ' + endif + + ! Read in units + call stream_ndep_check_units(stream_ndep_data_filename) + + ! Initialize the cdeps data type sdat_ndep + call shr_strdata_init_from_inline(sdat_ndep, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(stream_ndep_mesh_filename), & + stream_filenames = (/trim(stream_ndep_data_filename)/), & + stream_yearFirst = stream_ndep_year_first, & + stream_yearLast = stream_ndep_year_last, & + stream_yearAlign = stream_ndep_year_align, & + stream_fldlistFile = stream_varlist_ndep, & + stream_fldListModel = stream_varlist_ndep, & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'cycle', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = 'linear', & + stream_name = 'Nitrogen deposition data ', & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + end subroutine stream_ndep_init + + !================================================================ + subroutine stream_ndep_check_units( stream_fldFileName_ndep) + + !-------------------------------------------------------- + ! Check that units are correct on the file and if need any conversion + !-------------------------------------------------------- + + use cam_pio_utils , only : cam_pio_createfile, cam_pio_openfile, cam_pio_closefile, pio_subsystem + use pio , only : file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim + use pio , only : pio_bcast_error, pio_seterrorhandling, pio_inq_varid, pio_get_att + use pio , only : PIO_NOERR, PIO_NOWRITE + use shr_log_mod , only : errMsg => shr_log_errMsg + use cam_abortutils , only : endrun + + ! Arguments + character(len=*), intent(in) :: stream_fldFileName_ndep ! ndep filename + ! + ! Local variables + type(file_desc_t) :: File ! NetCDF filehandle for ndep file + type(var_desc_t) :: vardesc ! variable descriptor + integer :: ierr ! error status + integer :: err_handling ! temporary + character(len=CS) :: ndepunits! ndep units + !----------------------------------------------------------------------- + + call cam_pio_openfile( File, trim(stream_fldFileName_ndep), PIO_NOWRITE) + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, stream_varlist_ndep(1), vardesc) + if (ierr /= PIO_NOERR) then + call endrun(' ERROR finding variable: '//trim(stream_varlist_ndep(1))//" in file: "// & + trim(stream_fldFileName_ndep)//errMsg(sourcefile, __LINE__)) + else + ierr = PIO_get_att(File, vardesc, "units", ndepunits) + end if + call pio_seterrorhandling(File, err_handling) + call cam_pio_closefile(File) + + ! Now check to make sure they are correct + if (.not. trim(ndepunits) == "g(N)/m2/s" )then + call endrun(' ERROR in units for nitrogen deposition equal to: '//trim(ndepunits)//" not units expected"// & + errMsg(sourcefile, __LINE__)) + end if + + end subroutine stream_ndep_check_units + + !================================================================ + subroutine stream_ndep_interp(cam_out, rc) + + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_Finalize, ESMF_LogFoundError + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use dshr_strdata_mod , only : shr_strdata_advance + use shr_kind_mod , only : r8 => shr_kind_r8 + use camsrfexch , only : cam_out_t + use time_manager , only : get_curr_date + use physics_grid , only : columns_on_task + use cam_logfile , only : iulog + + ! input/output variables + type(cam_out_t) , intent(inout) :: cam_out + integer , intent(out) :: rc + + ! local variables + integer :: i + 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) + real(r8), pointer :: dataptr1d_nhx(:) + real(r8), pointer :: dataptr1d_noy(:) + !----------------------------------------------------------------------- + + ! Advance sdat stream + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + call shr_strdata_advance(sdat_ndep, ymd=mcdate, tod=sec, logunit=iulog, istr='ndepdyn', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! Get pointer for stream data that is time and spatially interpolated to model time and grid + call dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(1), fldptr1=dataptr1d_nhx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + call dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(2), fldptr1=dataptr1d_noy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + +!Un-comment once cam_out data structure has been populated -JN +#if 0 + do i = 1, columns_on_task + cam_out%nhx_nitrogen_flx(i) = dataptr1d_nhx(g) + cam_out%noy_nitrogen_flx(i) = dataptr1d_noy(g) + end do +#endif + + end subroutine stream_ndep_interp + +end module atm_stream_ndep diff --git a/src/data/physconst.meta b/src/data/physconst.meta index 095dd0b8..313033aa 100644 --- a/src/data/physconst.meta +++ b/src/data/physconst.meta @@ -292,7 +292,7 @@ dimensions = () protected = True [ cappa ] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + standard_name = ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure units = 1 type = real | kind = kind_phys dimensions = () diff --git a/src/data/registry.xml b/src/data/registry.xml index 3d8863f2..57a9ae3b 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -314,12 +314,18 @@ phys_timestep_init_zero="true"> Total tendency from physics suite - + timestep for physics + + current timestep number + 0 + 0) then - hdim1_d = fv_nphys*fv_nphys*nelem_d - else - hdim1_d = ngcols_d - end if - if (present(hdim2_d)) then - hdim2_d = 1 - end if - -end subroutine get_horiz_grid_dim_d - !========================================================================================= subroutine get_horiz_grid_int(nxy, clat_d_out, clon_d_out, area_d_out, & diff --git a/src/physics/utils/phys_comp.F90 b/src/physics/utils/phys_comp.F90 index c3e91bf9..abe0428a 100644 --- a/src/physics/utils/phys_comp.F90 +++ b/src/physics/utils/phys_comp.F90 @@ -185,11 +185,9 @@ subroutine phys_timestep_init() ! Physics needs to read in all data not read in by the dycore ncdata => initial_file_get_id() - ! data_frame is the next input frame for physics input fields - ! Frame 1 is skipped for snapshot files - !!XXgoldyXX: This section needs to have better logic once we know if - !! this is a physics test bench run. - data_frame = get_nstep() + 2 + ! data_frame is the next input frame for + ! physics fields that must be read from a file: + data_frame = get_nstep() ! Initialize host model variables that must be done each time step: call physics_types_tstep_init() @@ -237,15 +235,18 @@ subroutine phys_run2() end subroutine phys_run2 - subroutine phys_timestep_final() + subroutine phys_timestep_final(do_ncdata_check) use time_manager, only: get_nstep use cam_abortutils, only: endrun use cam_initfiles, only: unset_path_str use cam_ccpp_cap, only: cam_ccpp_physics_timestep_final use physics_inputs, only: physics_check_data + ! Subroutine inputs + logical, intent(in) :: do_ncdata_check + ! Local variables - integer :: data_frame + integer :: data_frame ! Finalize the time step call cam_ccpp_physics_timestep_final(phys_suite_name) @@ -253,16 +254,16 @@ subroutine phys_timestep_final() call endrun('cam_ccpp_physics_timestep_final: '//trim(errmsg)) end if - ! data_frame is the next input frame for physics input fields - ! Frame 1 is skipped for snapshot files - !!XXgoldyXX: This section needs to have better logic once we know if - !! this is a physics test bench run. - data_frame = get_nstep() + 2 + ! data_frame is the next input frame for + ! physics snapshot validation fields + data_frame = get_nstep() ! Determine if physics_check should be run: if (trim(ncdata_check) /= trim(unset_path_str)) then - call physics_check_data(ncdata_check, suite_names, data_frame, & - min_difference, min_relative_value) + if (do_ncdata_check) then + call physics_check_data(ncdata_check, suite_names, data_frame, & + min_difference, min_relative_value) + end if end if end subroutine phys_timestep_final diff --git a/src/physics/utils/physics_grid.F90 b/src/physics/utils/physics_grid.F90 index de59b560..39fc0f99 100644 --- a/src/physics/utils/physics_grid.F90 +++ b/src/physics/utils/physics_grid.F90 @@ -56,7 +56,7 @@ module physics_grid ! dynamics field grid information ! hdim1_d and hdim2_d are dimensions of rectangular horizontal grid ! data structure, If 1D data structure, then hdim2_d == 1. - integer :: hdim1_d, hdim2_d + integer, protected, public :: hdim1_d, hdim2_d logical :: dycore_unstructured = .false. ! Dycore name and properties character(len=8), protected, public :: dycore_name = '' diff --git a/src/utils/cam_pio_utils.F90 b/src/utils/cam_pio_utils.F90 index 5421d9e2..ad7a796a 100644 --- a/src/utils/cam_pio_utils.F90 +++ b/src/utils/cam_pio_utils.F90 @@ -45,7 +45,7 @@ module cam_pio_utils integer :: pio_rearranger ! This variable should be private ? - type(iosystem_desc_t), pointer, public, protected :: pio_subsystem => null() + type(iosystem_desc_t), pointer, public :: pio_subsystem => null() ! Some private string length parameters integer, parameter :: errormsg_str_len = 128 diff --git a/src/utils/time_manager.F90 b/src/utils/time_manager.F90 index 91114ccd..803a47e9 100644 --- a/src/utils/time_manager.F90 +++ b/src/utils/time_manager.F90 @@ -520,6 +520,13 @@ subroutine advance_timestep() ! Increment the timestep number. +! Use statements + use ESMF, only: ESMF_ClockAdvance + use cam_logfile, only: iulog + use physics_types, only: nstep + use spmd_utils, only: masterproc + use string_utils, only: stringify + ! Local variables character(len=*), parameter :: sub = 'advance_timestep' integer :: rc @@ -528,6 +535,17 @@ subroutine advance_timestep() call ESMF_ClockAdvance( tm_clock, rc=rc ) call chkrc(rc, sub//': error return from ESMF_ClockAdvance') +! Set current timestep number for use in CCPP physics schemes: + nstep = get_nstep() + +! Write new timestep to CAM log file. + + if (masterproc) then + write(iulog,*) '------------------------' + write(iulog,*) 'CAM-SIMA time step advanced (nstep = '//stringify([nstep])//')' + write(iulog,*) '------------------------' + end if + ! Set first step flag off. tm_first_restart_step = .false. diff --git a/test/run_tests.sh b/test/run_unit_tests.sh similarity index 100% rename from test/run_tests.sh rename to test/run_unit_tests.sh