diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 37d34eeb..66cf95b6 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -2,48 +2,54 @@ + + - none - - -1 - -1 - -1 - -1 - -1 - -1 - -1 - -1 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + none + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + - none - + none + -8 -8 -8 @@ -52,35 +58,40 @@ -8 -8 -8 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + - none - + none + -8 -8 -8 @@ -89,102 +100,144 @@ -8 -8 -8 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + - none - - -2 - -2 - -2 - -2 - -2 - -2 - -2 - -2 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + none + + -2 + -2 + -2 + -2 + -2 + -2 + -2 + -2 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + - none - - -1 - -1 - -1 - -1 - -1 - -1 - -1 - -1 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + none + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + none + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + - diff --git a/drivers/cpl/mct/glc_comp_mct.F90 b/drivers/cpl/mct/glc_comp_mct.F90 deleted file mode 100644 index 49cbb589..00000000 --- a/drivers/cpl/mct/glc_comp_mct.F90 +++ /dev/null @@ -1,581 +0,0 @@ -module glc_comp_mct - - ! !uses: - - use shr_sys_mod - use shr_kind_mod, only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, & - CS=>SHR_KIND_CS, CL=>SHR_KIND_CL - use shr_file_mod, only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use mct_mod - use esmf - - use seq_cdata_mod , only: seq_cdata_getdata=>seq_cdata_setptrs, seq_cdata - use seq_infodata_mod - use seq_timemgr_mod - - use glc_import_export - use glc_cpl_indices - use glc_constants, only: verbose, stdout, stderr, radius - use glc_constants, only: zero_gcm_fluxes_for_all_icesheets, model_doi_url, icesheet_names - use glc_InitMod, only: glc_initialize - use glc_RunMod, only: glc_run - use glc_FinalMod, only: glc_final - use glc_io, only: glc_io_write_restart - use glc_communicate, only: init_communicate, my_task, master_task - use glc_time_management, only: iyear,imonth,iday,ihour,iminute,isecond,runtype - use glc_fields, only: ice_sheet - - ! Public types: - implicit none - save - private ! except - - ! Public interfaces - public :: glc_init_mct - public :: glc_run_mct - public :: glc_final_mct - - ! Private data interfaces - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - ! my_task_local and master_task_local are needed for some checks that are done before - ! init_communicate is called (although, it's possible that init_communicate could be - ! moved to earlier to prevent the need for these copies) - integer(IN) :: my_task_local ! my task in mpi communicator mpicom - integer(IN),parameter :: master_task_local=0 ! task number of master task - - type(seq_infodata_type), pointer :: infodata - -!=============================================================================== -CONTAINS -!=============================================================================== - - subroutine glc_init_mct( EClock, cdata, x2g, g2x, NLFilename ) - - ! description: - ! initialize glc model - - ! uses: - - use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name - use glc_ensemble , only : set_inst_vars, write_inst_vars, get_inst_name - use glc_files , only : set_filenames, ionml_filename - use glc_coupling_flags , only : has_ocn_coupling, has_ice_coupling - use glc_indexing , only : get_nx_tot, get_ny_tot, get_npts - - ! input/output parameters: - - type(ESMF_Clock) , intent(inout) :: EClock - type(seq_cdata) , intent(inout) :: cdata - type(mct_aVect) , intent(inout) :: x2g, g2x - character(len=*), optional , intent(in) :: NLFilename ! Namelist filename - - !--- local variables --- - integer(IN) :: ierr ! error code - integer(IN) :: i,j,n - integer(IN) :: COMPID - integer(IN) :: mpicom - type(mct_gsMap), pointer :: gsMap - type(mct_gGrid), pointer :: dom - integer(IN) :: shrlogunit, shrloglev - character(CL) :: starttype - character(CS) :: myModelName - logical :: lnd_present - logical :: glc_coupled_fluxes ! are we sending fluxes to other components? - integer :: inst_index ! number of current instance (e.g., 1) - character(len=16) :: inst_name ! full name of current instance (e.g., GLC_0001) - character(len=16) :: inst_suffix ! character string associated with instance number - ! (e.g., "_0001", or "" for the single-instance case) - !--- formats --- - character(*), parameter :: F00 = "('(glc_init_mct) ',8a)" - character(*), parameter :: F01 = "('(glc_init_mct) ',a,8i8)" - character(*), parameter :: F02 = "('(glc_init_mct) ',a,4es13.6)" - character(*), parameter :: F91 = "('(glc_init_mct) ',73('-'))" - character(*), parameter :: subName = "(glc_init_mct) " - !------------------------------------------------------------------------------- - - !---------------------------------------------------------------------------- - ! Determine attribute vector indices - !---------------------------------------------------------------------------- - - call glc_cpl_indices_set() - - !---------------------------------------------------------------------------- - ! Set cdata pointers - !---------------------------------------------------------------------------- - - call seq_cdata_getdata(cdata, & - id=compid, mpicom=mpicom, gsMap=gsMap, dom=dom, infodata=infodata) - - call mpi_comm_rank(mpicom, my_task_local, ierr) - - !--------------------------------------------------------------------------- - ! set variables that depend on ensemble index - !--------------------------------------------------------------------------- - - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - call set_inst_vars(inst_index, inst_name, inst_suffix) - call get_inst_name(myModelName) - call set_filenames() - - !--------------------------------------------------------------------------- - ! use infodata to determine type of run - !--------------------------------------------------------------------------- - - call seq_infodata_GetData( infodata, & - start_type=starttype) - - if ( trim(starttype) == trim(seq_infodata_start_type_start)) then - runtype = "initial" - else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then - runtype = "continue" - else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then - runtype = "branch" - else - write(*,*) 'glc_comp_mct ERROR: unknown starttype' - call shr_sys_abort() - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - !--- open log file --- - if (my_task_local == master_task_local) then - stdout = shr_file_getUnit() - call shr_file_setIO(ionml_filename,stdout) - else - stdout = 6 - endif - stderr = stdout - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (stdout) - - if (verbose .and. my_task_local == master_task_local) then - write(stdout,F00) ' Starting' - write(stdout,*) subname, 'COMPID: ', COMPID - call write_inst_vars - call shr_sys_flush(stdout) - endif - - ! ------------------------------------------------------------------------ - ! Perform initial sanity checks, making sure we're okay to run - ! ------------------------------------------------------------------------ - - ! The coupler allows running glc without lnd. MPAS-LI can handle that configuration, - ! but CISM cannot. So abort if there is no land model (data or active) present. - call seq_infodata_GetData(infodata, & - lnd_present=lnd_present) - if (.not. lnd_present) then - call shr_sys_abort('ERROR: CISM requires a land component (either active land or dlnd)& - & - it cannot be run with a stub land') - end if - - ! ------------------------------------------------------------------------ - ! Get other info from the coupler - ! ------------------------------------------------------------------------ - - call seq_infodata_GetData(infodata, & - model_doi_url=model_doi_url) - - ! ------------------------------------------------------------------------ - ! Do main initialization - ! ------------------------------------------------------------------------ - - call init_communicate(mpicom) - - call glc_initialize(EClock) - if (verbose .and. my_task == master_task) then - write(stdout,F01) ' GLC Initial Date ',iyear,imonth,iday,ihour,iminute,isecond - write(stdout,F00) ' Initialize Done' - call shr_sys_flush(stdout) - endif - - ! Initialize MCT gsmap - - call glc_SetgsMap_mct(mpicom, COMPID, gsMap) - - ! Initialize MCT domain - - call glc_domain_mct(gsMap,dom) - - ! Set flags in infodata - - glc_coupled_fluxes = (.not. zero_gcm_fluxes_for_all_icesheets) - call seq_infodata_PutData(infodata, & - glc_present= .true., & - glclnd_present = .true., & - glcocn_present = has_ocn_coupling(), & - glcice_present = has_ice_coupling(), & - glc_prognostic = .true., & - glc_coupled_fluxes = glc_coupled_fluxes, & - glc_nx=get_nx_tot(instance_index=1), & - glc_ny=get_ny_tot(instance_index=1)) - - ! Initialize MCT attribute vectors - - call mct_aVect_init(g2x, rList=seq_flds_g2x_fields, lsize=get_npts(instance_index=1)) - call mct_aVect_zero(g2x) - - call mct_aVect_init(x2g, rList=seq_flds_x2g_fields, lsize=get_npts(instance_index=1)) - call mct_aVect_zero(x2g) - - ! Create initial glc export state - - call glc_export(g2x%rattr) - - if (my_task == master_task) then - write(stdout,F91) - write(stdout,F00) trim(myModelName),': start of main integration loop' - write(stdout,F91) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(stdout) - -end subroutine glc_init_mct - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_run_mct -! -! !DESCRIPTION: -! run method for glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_run_mct( EClock, cdata, x2g, g2x) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - - type(ESMF_Clock) ,intent(inout) :: EClock - type(seq_cdata) ,intent(inout) :: cdata - type(mct_aVect) ,intent(inout) :: x2g ! driver -> glc - type(mct_aVect) ,intent(inout) :: g2x ! glc -> driver - -!EOP - !--- local --- - integer(IN) :: cesmYMD ! cesm model date - integer(IN) :: cesmTOD ! cesm model sec - integer(IN) :: glcYMD ! glc model date - integer(IN) :: glcTOD ! glc model sec - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: ki ! index of ifrac - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: shrlogunit, shrloglev - logical :: stop_alarm ! is it time to stop - logical :: rest_alarm ! is it time to write a restart - logical :: done ! time loop logical - integer :: num - character(len= 2) :: cnum - character(len=64) :: name - logical :: valid_inputs - - character(*), parameter :: F00 = "('(glc_run_mct) ',8a)" - character(*), parameter :: F01 = "('(glc_run_mct) ',a,8i8)" - character(*), parameter :: F04 = "('(glc_run_mct) ',2a,2i8,'s')" - character(*), parameter :: subName = "(glc_run_mct) " -!------------------------------------------------------------------------------- - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (stdout) - - ! Set internal time info - - call seq_timemgr_EClockGetData(EClock,curr_ymd=cesmYMD, curr_tod=cesmTOD) - - stop_alarm = seq_timemgr_StopAlarmIsOn( EClock ) - - glcYMD = iyear*10000 + imonth*100 + iday - glcTOD = ihour*3600 + iminute*60 + isecond - if (verbose .and. my_task == master_task) then - write(stdout,F01) ' Run Starting ',glcYMD,glcTOD - call shr_sys_flush(stdout) - endif - - ! Unpack - - call glc_import(x2g%rattr) - - ! Run - - call seq_infodata_GetData( infodata, glc_valid_input=valid_inputs) - - done = .false. - if (glcYMD == cesmYMD .and. glcTOD == cesmTOD) done = .true. - do while (.not. done) - if (glcYMD > cesmYMD .or. (glcYMD == cesmYMD .and. glcTOD > cesmTOD)) then - write(stdout,*) subname,' ERROR overshot coupling time ',glcYMD,glcTOD,cesmYMD,cesmTOD - call shr_sys_abort('glc error overshot time') - endif - - call glc_run(EClock, valid_inputs) - - glcYMD = iyear*10000 + imonth*100 + iday - glcTOD = ihour*3600 + iminute*60 + isecond - if (glcYMD == cesmYMD .and. glcTOD == cesmTOD) done = .true. - if (verbose .and. my_task == master_task) then - write(stdout,F01) ' GLC Date ',glcYMD,glcTOD - endif - enddo - - if (verbose .and. my_task == master_task) then - write(stdout,F01) ' Run Done',glcYMD,glcTOD - call shr_sys_flush(stdout) - endif - - ! Pack - - call glc_export(g2x%rattr) - - ! Log output for model date - - if (my_task == master_task) then - call seq_timemgr_EClockGetData(EClock,curr_ymd=cesmYMD, curr_tod=cesmTOD) - write(stdout,F01) ' CESM Date ', cesmYMD,cesmTOD - glcYMD = iyear*10000 + imonth*100 + iday - glcTOD = ihour*3600 + iminute*60 + isecond - write(stdout,F01) ' GLC Date ',glcYMD,glcTOD - write(stdout,*) '(glc_run_mct) valid Inputs = ', valid_inputs - call shr_sys_flush(stdout) - end if - - ! If time to write restart, do so - - rest_alarm = seq_timemgr_RestartAlarmIsOn( EClock ) - if (rest_alarm) then - call glc_io_write_restart(ice_sheet%instances(1), icesheet_names(1), EClock) - endif - - ! Reset shr logging to original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(stdout) - -end subroutine glc_run_mct - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_final_mct -! -! !DESCRIPTION: -! finalize method for glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ -! -subroutine glc_final_mct( EClock, cdata, x2d, d2x) - -! !USES: - - use glc_ensemble, only : get_inst_name - -! !INPUT/OUTPUT PARAMETERS: - - type(ESMF_Clock) ,intent(inout) :: EClock - type(seq_cdata) ,intent(inout) :: cdata - type(mct_aVect) ,intent(inout) :: x2d - type(mct_aVect) ,intent(inout) :: d2x - -!EOP - - integer(IN) :: shrlogunit, shrloglev - character(CS) :: myModelName - - - !--- formats --- - character(*), parameter :: F00 = "('(glc_final_mct) ',8a)" - character(*), parameter :: F01 = "('(glc_final_mct) ',a,8i8)" - character(*), parameter :: F91 = "('(glc_final_mct) ',73('-'))" - character(*), parameter :: subName = "(glc_final_mct) " - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - ! Reset shr logging to my log file - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (stdout) - - call get_inst_name(myModelName) - - if (my_task == master_task) then - write(stdout,F91) - write(stdout,F00) trim(myModelName),': end of main integration loop' - write(stdout,F91) - end if - - call glc_final() - - if (verbose .and. my_task == master_task) then - write(stdout,F00) ' Done' - call shr_sys_flush(stdout) - endif - - ! Reset shr logging to original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(stdout) - -end subroutine glc_final_mct - -!================================================================================= - -subroutine glc_setgsmap_mct( mpicom_g, GLCID, gsMap_g ) - - ! Initialize MCT global seg map - - use glc_indexing, only : local_to_global_indices, get_npts_tot - - integer , intent(in) :: mpicom_g - integer , intent(in) :: GLCID - type(mct_gsMap), intent(out) :: gsMap_g - - ! Local Variables - - integer :: ier - - !--- formats --- - character(*), parameter :: F02 = "('(glc_SetgsMap_mct) ',a,4es13.6)" - character(*), parameter :: subName = "(glc_SetgsMap_mct) " - !------------------------------------------------------------------- - - ! npts_tot is the number of grid cells on CISM's global grid. It is passed to - ! mct_gsMapinit in case there are ice-free grid cells on the global grid that are not - ! assigned to any processor. - call mct_gsMap_init( gsMap_g, local_to_global_indices(instance_index=1), mpicom_g, GLCID, & - gsize = get_npts_tot(instance_index=1)) - -end subroutine glc_SetgsMap_mct - -!=============================================================================== - - subroutine glc_domain_mct( gsMap_g, dom_g ) - - use glc_indexing, only : get_npts, get_nx, get_ny, spatial_to_vector - use glad_main, only : glad_get_lat_lon, glad_get_areas - - !------------------------------------------------------------------- - type(mct_gsMap), intent(inout) :: gsMap_g - type(mct_ggrid), intent(out) :: dom_g - - ! Local Variables - - integer :: npts, nx, ny - integer :: i,n ! index - real(r8), pointer :: data(:) ! temporary - integer , pointer :: idata(:) ! temporary - real(r8), allocatable :: lats(:,:) ! latitude of each point (degrees) - real(r8), allocatable :: lons(:,:) ! longitude of each point (degrees) - real(r8), allocatable :: areas(:,:) ! area of each point (square meters) - character(*), parameter :: subName = "(glc_domain_mct) " - !------------------------------------------------------------------- - - npts = get_npts(instance_index=1) - nx = get_nx(instance_index=1) - ny = get_ny(instance_index=1) - - ! Initialize mct domain type - - call mct_gGrid_init( GGrid=dom_g, CoordChars=trim(seq_flds_dom_coord), & - OtherChars=trim(seq_flds_dom_other), lsize=npts ) - - ! Initialize attribute vector with special value - - allocate(data(npts)) - dom_g%data%rAttr(:,:) = -9999.0_R8 - dom_g%data%iAttr(:,:) = -9999 - data(:) = 0.0_R8 - call mct_gGrid_importRAttr(dom_g,"mask" ,data,npts) - call mct_gGrid_importRAttr(dom_g,"frac" ,data,npts) - - ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT - - call mct_gsMap_orderedPoints(gsMap_g, my_task, idata) - call mct_gGrid_importIAttr(dom_g,'GlobGridNum',idata,npts) - - ! Fill in correct values for domain components - ! lat/lon in degrees, area in radians^2, real-valued mask and frac - - allocate(lats(nx, ny)) - allocate(lons(nx, ny)) - allocate(areas(nx, ny)) - - call glad_get_lat_lon(ice_sheet, instance_index = 1, & - lats = lats, lons = lons) - call glad_get_areas(ice_sheet, instance_index = 1, areas = areas) - - call spatial_to_vector(instance_index=1, & - arr_spatial = lons, & - arr_vector = data) - call mct_gGrid_importRattr(dom_g,"lon",data,npts) - - call spatial_to_vector(instance_index=1, & - arr_spatial = lats, & - arr_vector = data) - call mct_gGrid_importRattr(dom_g,"lat",data,npts) - - call spatial_to_vector(instance_index=1, & - arr_spatial = areas, & - arr_vector = data) - ! convert from m^2 to radians^2 - data = data/(radius*radius) - call mct_gGrid_importRattr(dom_g,"area",data,npts) - - ! For now, assume mask and frac are 1 everywhere. This may need to be changed in the - ! future. - data(:) = 1._r8 - call mct_gGrid_importRattr(dom_g,"mask",data,npts) - call mct_gGrid_importRattr(dom_g,"frac",data,npts) - - deallocate(data) - deallocate(idata) - deallocate(lats) - deallocate(lons) - deallocate(areas) - - if (verbose .and. my_task==master_task) then - i = mct_aVect_nIattr(dom_g%data) - do n = 1,i - write(stdout,*) subname,' dom_g ',n,minval(dom_g%data%iAttr(n,:)),maxval(dom_g%data%iAttr(n,:)) - enddo - i = mct_aVect_nRattr(dom_g%data) - do n = 1,i - write(stdout,*) subname,' dom_g ',n,minval(dom_g%data%rAttr(n,:)),maxval(dom_g%data%rAttr(n,:)) - enddo - call shr_sys_flush(stdout) - endif - - end subroutine glc_domain_mct - -!=============================================================================== - -end module glc_comp_mct diff --git a/drivers/cpl/mct/glc_cpl_indices.F90 b/drivers/cpl/mct/glc_cpl_indices.F90 deleted file mode 100644 index fd829dc9..00000000 --- a/drivers/cpl/mct/glc_cpl_indices.F90 +++ /dev/null @@ -1,70 +0,0 @@ -module glc_cpl_indices - - use seq_flds_mod - use mct_mod - use glc_constants, only : glc_smb - use shr_sys_mod , only : shr_sys_abort - - implicit none - - SAVE - public - - ! drv -> glc - - integer, public :: index_x2g_Sl_tsrf = 0 - integer, public :: index_x2g_Flgl_qice = 0 - - ! glc -> drv - - integer, public :: index_g2x_Fogg_rofi = 0 ! frozen runoff -> ocn - integer, public :: index_g2x_Figg_rofi = 0 ! frozen runoff -> ice - integer, public :: index_g2x_Fogg_rofl = 0 ! liquid runoff -> ocn - integer, public :: index_g2x_Sg_ice_covered = 0 - integer, public :: index_g2x_Sg_topo = 0 - integer, public :: index_g2x_Flgg_hflx = 0 - integer, public :: index_g2x_Sg_icemask = 0 - integer, public :: index_g2x_Sg_icemask_coupled_fluxes = 0 - -contains - - subroutine glc_cpl_indices_set( ) - - !------------------------------------------------------------- - type(mct_aVect) :: g2x ! temporary - type(mct_aVect) :: x2g ! temporary - !------------------------------------------------------------- - - ! create temporary attribute vectors - - call mct_aVect_init(x2g, rList=seq_flds_x2g_fields, lsize=1) - call mct_aVect_init(g2x, rList=seq_flds_g2x_fields, lsize=1) - - ! glc -> drv - - index_g2x_Fogg_rofi = mct_avect_indexra(g2x,'Fogg_rofi') - index_g2x_Figg_rofi = mct_avect_indexra(g2x,'Figg_rofi') - index_g2x_Fogg_rofl = mct_avect_indexra(g2x,'Fogg_rofl') - index_g2x_Sg_ice_covered = mct_avect_indexra(g2x,'Sg_ice_covered') - index_g2x_Sg_topo = mct_avect_indexra(g2x,'Sg_topo') - index_g2x_Flgg_hflx = mct_avect_indexra(g2x,'Flgg_hflx') - index_g2x_Sg_icemask = mct_avect_indexra(g2x,'Sg_icemask') - index_g2x_Sg_icemask_coupled_fluxes = mct_avect_indexra(g2x,'Sg_icemask_coupled_fluxes') - - ! drv -> glc - index_x2g_Sl_tsrf = mct_avect_indexra(x2g,'Sl_tsrf') - index_x2g_Flgl_qice = mct_avect_indexra(x2g,'Flgl_qice') - - call mct_aVect_clean(x2g) - call mct_aVect_clean(g2x) - - ! Set glc_smb - ! true => get surface mass balance from CLM via coupler (in multiple elev classes) - ! false => use PDD scheme in GLIMMER - ! For now, we always use true - - glc_smb = .true. - - end subroutine glc_cpl_indices_set - -end module glc_cpl_indices diff --git a/drivers/cpl/mct/glc_import_export.F90 b/drivers/cpl/mct/glc_import_export.F90 deleted file mode 100644 index 3592dfb6..00000000 --- a/drivers/cpl/mct/glc_import_export.F90 +++ /dev/null @@ -1,184 +0,0 @@ -module glc_import_export - - use shr_sys_mod - use shr_kind_mod, only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8 - use shr_kind_mod, only: CS=>SHR_KIND_CS, CL=>SHR_KIND_CL - use glc_constants, only: verbose, stdout, stderr, tkfrz, enable_frac_overrides - use glc_communicate, only: my_task, master_task - use glc_cpl_indices - - implicit none - save - public - - ! Public interfaces - public :: glc_import - -!================================================================================= -contains -!================================================================================= - - subroutine glc_import(x2g) - - !------------------------------------------------------------------- - use glc_indexing, only : vector_to_spatial - use glc_fields, only: cpl_bundles - - real(r8) , intent(in) :: x2g(:,:) - - character(*), parameter :: subName = "(glc_import) " - !------------------------------------------------------------------- - - associate(& - tsfc => cpl_bundles(1)%tsfc, & - qsmb => cpl_bundles(1)%qsmb) - - call vector_to_spatial(instance_index=1, & - arr_vector = x2g(index_x2g_Sl_tsrf,:), & - arr_spatial = tsfc) - call vector_to_spatial(instance_index=1, & - arr_vector = x2g(index_x2g_Flgl_qice,:), & - arr_spatial = qsmb) - - tsfc = tsfc - tkfrz - - !Jer hack fix: - !For some land points where CLM sees ocean, and all ocean points, CLM doesn't provide a temperature, - !and so the incoming temperature is 0.d0. This gets dropped to -273.15, in the above code. So, - !manually reverse this, below, to set to 0C. - where (tsfc < -250.d0) tsfc=0.d0 - - end associate - - end subroutine glc_import - -!================================================================================= - - subroutine glc_export(g2x) - - !------------------------------------------------------------------- - use glc_indexing, only : get_nx, get_ny, spatial_to_vector - use glc_fields, only : cpl_bundles, ice_sheet - use glc_route_ice_runoff, only: route_ice_runoff - use glc_override_frac , only: do_frac_overrides - - real(r8) ,intent(inout) :: g2x(:,:) - - integer :: nx, ny - - ! if doing frac overrides, these are the modified versions sent to the coupler; - ! otherwise they point to the real fields - real(r8), pointer :: ice_covered_to_cpl(:,:) - real(r8), pointer :: topo_to_cpl(:,:) - logical :: fields_to_cpl_allocated ! whether we allocated the above fields - - ! Note that there are two separate mask fields. Both of them provide information about - ! where CISM is running. The difference is that ice_sheet_grid_mask includes icesheet - ! areas that are diagtostic-only, whereas icemask_coupled_fluxes excludes icesheet - ! areas where we are zeroing the fluxes sent to the coupler (thus, icesheets that are - ! "diagnostic" in some sense). We need two separate maps, as opposed to a single map - ! plus a scalar logical variable, in case we're running with multiple icesheet - ! instances (e.g., Greenland & Antarctica), one of which is fully prognostic and one - ! of which is diagnostic-only: in that case, ice_sheet_grid_mask would be non-zero - ! over both Greenland and Antarctica, whereas icemask_coupled_fluxes would be non-zero - ! over (e.g.) Greenland, but 0 over Antarctica. - real(r8), allocatable :: icemask_coupled_fluxes(:,:) ! mask of ice sheet grid coverage where we are potentially sending non-zero fluxes - - real(r8), allocatable :: hflx_to_cpl(:,:) - real(r8), allocatable :: rofl_to_cpl(:,:) - real(r8), allocatable :: rofi_to_ocn(:,:) - real(r8), allocatable :: rofi_to_ice(:,:) - - character(*), parameter :: subName = "(glc_export) " - !------------------------------------------------------------------- - - associate( & - ice_covered => cpl_bundles(1)%ice_covered, & - topo => cpl_bundles(1)%topo, & - rofi => cpl_bundles(1)%rofi, & - rofl => cpl_bundles(1)%rofl, & - hflx => cpl_bundles(1)%hflx, & - ice_sheet_grid_mask => cpl_bundles(1)%ice_sheet_grid_mask) - - ! If overrides of glc fraction are enabled (for testing purposes), then apply - ! these overrides, otherwise use the real version of ice_covered and topo - if (enable_frac_overrides) then - allocate(ice_covered_to_cpl(lbound(ice_covered,1):ubound(ice_covered,1), & - lbound(ice_covered,2):ubound(ice_covered,2))) - allocate(topo_to_cpl(lbound(topo,1):ubound(topo,1), & - lbound(topo,2):ubound(topo,2))) - - ice_covered_to_cpl = ice_covered - topo_to_cpl = topo - call do_frac_overrides(ice_covered_to_cpl, topo_to_cpl, ice_sheet_grid_mask) - fields_to_cpl_allocated = .true. - else - ice_covered_to_cpl => ice_covered - topo_to_cpl => topo - fields_to_cpl_allocated = .false. - end if - - nx = get_nx(instance_index=1) - ny = get_ny(instance_index=1) - - allocate(icemask_coupled_fluxes(nx, ny)) - allocate(hflx_to_cpl(nx, ny)) - allocate(rofl_to_cpl(nx, ny)) - allocate(rofi_to_ocn(nx, ny)) - allocate(rofi_to_ice(nx, ny)) - - if (ice_sheet%instances(1)%zero_gcm_fluxes) then - icemask_coupled_fluxes = 0._r8 - hflx_to_cpl = 0._r8 - rofl_to_cpl = 0._r8 - rofi_to_ocn = 0._r8 - rofi_to_ice = 0._r8 - else - icemask_coupled_fluxes = ice_sheet_grid_mask - hflx_to_cpl = hflx - rofl_to_cpl = rofl - call route_ice_runoff(rofi, rofi_to_ocn, rofi_to_ice) - end if - - call spatial_to_vector(instance_index = 1, & - arr_spatial = rofi_to_ocn, & - arr_vector = g2x(index_g2x_Fogg_rofi,:)) - call spatial_to_vector(instance_index = 1, & - arr_spatial = rofi_to_ice, & - arr_vector = g2x(index_g2x_Figg_rofi,:)) - call spatial_to_vector(instance_index = 1, & - arr_spatial = rofl_to_cpl, & - arr_vector = g2x(index_g2x_Fogg_rofl,:)) - - call spatial_to_vector(instance_index = 1, & - arr_spatial = ice_covered_to_cpl, & - arr_vector = g2x(index_g2x_Sg_ice_covered,:)) - call spatial_to_vector(instance_index = 1, & - arr_spatial = topo_to_cpl, & - arr_vector = g2x(index_g2x_Sg_topo,:)) - call spatial_to_vector(instance_index = 1, & - arr_spatial = hflx_to_cpl, & - arr_vector = g2x(index_g2x_Flgg_hflx,:)) - - call spatial_to_vector(instance_index = 1, & - arr_spatial = ice_sheet_grid_mask, & - arr_vector = g2x(index_g2x_Sg_icemask,:)) - call spatial_to_vector(instance_index = 1, & - arr_spatial = icemask_coupled_fluxes, & - arr_vector = g2x(index_g2x_Sg_icemask_coupled_fluxes,:)) - - deallocate(icemask_coupled_fluxes) - deallocate(hflx_to_cpl) - deallocate(rofl_to_cpl) - deallocate(rofi_to_ocn) - deallocate(rofi_to_ice) - if (fields_to_cpl_allocated) then - deallocate(ice_covered_to_cpl) - deallocate(topo_to_cpl) - end if - - end associate - - end subroutine glc_export - -end module glc_import_export diff --git a/drivers/cpl/mct/history_tape_coupler.F90 b/drivers/cpl/mct/history_tape_coupler.F90 deleted file mode 100644 index aad67118..00000000 --- a/drivers/cpl/mct/history_tape_coupler.F90 +++ /dev/null @@ -1,93 +0,0 @@ -module history_tape_coupler - - ! Defines a class for controlling history frequency based on the coupler's history - ! frequency. - - use history_tape_base, only : history_tape_base_type - - implicit none - private - save - - public :: history_tape_coupler_type - type, extends(history_tape_base_type) :: history_tape_coupler_type - private - contains - ! Logical function saying whether it's time to write a history file - procedure :: is_time_to_write_hist - - ! Function returning a string describing the history frequency - procedure :: history_frequency_string - end type history_tape_coupler_type - - interface history_tape_coupler_type - module procedure constructor - end interface history_tape_coupler_type - -contains - - !----------------------------------------------------------------------- - function constructor(icesheet_name, history_vars) - ! - ! !DESCRIPTION: - ! Creates a history_tape_coupler_type object - ! - ! !USES: - ! - ! !ARGUMENTS: - type(history_tape_coupler_type) :: constructor ! function result - - ! Name of this ice sheet - character(len=*), intent(in) :: icesheet_name - - ! List of variables to write to file - character(len=*), intent(in) :: history_vars - - !----------------------------------------------------------------------- - - call constructor%set_icesheet_name(icesheet_name) - call constructor%set_history_vars(history_vars) - end function constructor - - !----------------------------------------------------------------------- - logical function is_time_to_write_hist(this, EClock) - ! - ! !DESCRIPTION: - ! Returns true if it is time to write the history tape associated with this controller. - ! - ! !USES: - use esmf, only: ESMF_Clock - use seq_timemgr_mod, only : seq_timemgr_HistoryAlarmIsOn - ! - ! !ARGUMENTS: - class(history_tape_coupler_type), intent(in) :: this - type(ESMF_Clock), intent(in) :: EClock - - !----------------------------------------------------------------------- - - is_time_to_write_hist = seq_timemgr_HistoryAlarmIsOn(EClock) - - end function is_time_to_write_hist - - !----------------------------------------------------------------------- - function history_frequency_string(this) - ! - ! !DESCRIPTION: - ! Returns a string representation of this history frequency - ! - ! TODO(wjs, 2015-02-17) This needs to be implemented. It is currently difficult (or - ! impossible) to extract the frequency information from the coupler. Hopefully this - ! will become easier once the coupler implements the necessary functionality for - ! metadata on its own history files. - ! - ! !ARGUMENTS: - character(len=:), allocatable :: history_frequency_string ! function result - class(history_tape_coupler_type), intent(in) :: this - - !----------------------------------------------------------------------- - - history_frequency_string = '(matches coupler history frequency)' - - end function history_frequency_string - -end module history_tape_coupler diff --git a/drivers/cpl/nuopc/glc_comp_nuopc.F90 b/drivers/cpl/nuopc/glc_comp_nuopc.F90 index 60530e9b..c3f6f9d1 100644 --- a/drivers/cpl/nuopc/glc_comp_nuopc.F90 +++ b/drivers/cpl/nuopc/glc_comp_nuopc.F90 @@ -194,7 +194,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Set filenames which depend on instance information call set_filenames() - ! Determine if cism will evolve + ! Determine if cism will evolve - if not will not import any fields from the mediator call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -214,7 +214,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if ! Advertise fields - call advertise_fields(gcomp, num_icesheets_from_mediator, rc) + call advertise_fields(gcomp, cism_evolve, num_icesheets_from_mediator, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug > 5) then diff --git a/drivers/cpl/nuopc/glc_import_export.F90 b/drivers/cpl/nuopc/glc_import_export.F90 index c4c0ee81..94aa491d 100644 --- a/drivers/cpl/nuopc/glc_import_export.F90 +++ b/drivers/cpl/nuopc/glc_import_export.F90 @@ -43,11 +43,16 @@ module glc_import_export type fld_list_type character(len=128) :: stdname + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type ! Field names character(len=*), parameter :: field_in_tsrf = 'Sl_tsrf' character(len=*), parameter :: field_in_qice = 'Flgl_qice' + character(len=*), parameter :: field_in_so_t_depth = 'So_t_depth' + character(len=*), parameter :: field_in_so_s_depth = 'So_s_depth' + character(len=*), parameter :: field_out_area = 'Sg_area' character(len=*), parameter :: field_out_ice_covered = 'Sg_ice_covered' character(len=*), parameter :: field_out_topo = 'Sg_topo' @@ -55,8 +60,14 @@ module glc_import_export character(len=*), parameter :: field_out_icemask_coupled_fluxes = 'Sg_icemask_coupled_fluxes' character(len=*), parameter :: field_out_hflx_to_lnd = 'Flgg_hflx' character(len=*), parameter :: field_out_rofi_to_ice = 'Figg_rofi' - character(len=*), parameter :: field_out_rofi_to_ocn = 'Fogg_rofi' - character(len=*), parameter :: field_out_rofl_to_ocn = 'Fogg_rofl' + character(len=*), parameter :: field_out_rofi_to_ocn = 'Fgrg_rofi' + character(len=*), parameter :: field_out_rofl_to_ocn = 'Fgrg_rofl' + + integer, parameter :: nlev_import = 30 + real(r8) :: vertical_levels(nlev_import) = (/ & + 30., 90., 150., 210., 270., 330., 390., 450., 510., 570., & + 630., 690., 750., 810., 870., 930., 990., 1050., 1110., 1170., & + 1230., 1290., 1350., 1410., 1470., 1530., 1590., 1650., 1710., 1770. /) integer, parameter :: fldsMax = 100 integer :: fldsToGlc_num = 0 @@ -76,12 +87,13 @@ module glc_import_export contains !=============================================================================== - subroutine advertise_fields(gcomp, num_icesheets_in, rc) + subroutine advertise_fields(gcomp, cism_evolve, num_icesheets_in, rc) use glc_constants, only : glc_smb ! input/output variables type(ESMF_GridComp) :: gcomp + logical , intent(in) :: cism_evolve integer , intent(in) :: num_icesheets_in integer , intent(out) :: rc @@ -200,26 +212,27 @@ subroutine advertise_fields(gcomp, num_icesheets_in, rc) ! Advertise import fields !-------------------------------- - ! Note that we advertise the import fields even if running with a non-evolving ice - ! sheet; this is needed for the MED -> GLC mapping to work (which we do even for a - ! non-evolving ice sheet). call fldlist_add(fldsToGlc_num, fldsToGlc, trim(flds_scalar_name)) call fldlist_add(fldsToGlc_num, fldsToGlc, field_in_tsrf) call fldlist_add(fldsToGlc_num, fldsToGlc, field_in_qice) + if (cism_evolve) then + call fldlist_add(fldsToGlc_num, fldsToGlc, field_in_so_t_depth, ungridded_lbound=1, ungridded_ubound=nlev_import) + call fldlist_add(fldsToGlc_num, fldsToGlc, field_in_so_s_depth, ungridded_lbound=1, ungridded_ubound=nlev_import) + end if - ! Now advertise import fields - do ns = 1,num_icesheets + ! Now advertise import fields + do ns = 1,num_icesheets do nf = 1,fldsToGlc_num - call NUOPC_Advertise(NStateImp(ns), standardName=fldsToGlc(nf)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - if (my_task == master_task) then - write(cnum,'(i0)') ns - write(stdout,'(a)') 'Advertised import field: '//trim(fldsToGlc(nf)%stdname)//' for ice sheet '//trim(cnum) - end if - call ESMF_LogWrite(subname//'Import field'//': '//trim(fldsToGlc(nf)%stdname), ESMF_LOGMSG_INFO) + call NUOPC_Advertise(NStateImp(ns), standardName=fldsToGlc(nf)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + write(cnum,'(i0)') ns + write(stdout,'(a)') 'Advertised import field: '//trim(fldsToGlc(nf)%stdname)//' for ice sheet '//trim(cnum) + end if + call ESMF_LogWrite(subname//'Import field'//': '//trim(fldsToGlc(nf)%stdname), ESMF_LOGMSG_INFO) end do - enddo + enddo ! Set glc_smb ! true => get surface mass balance from land model via coupler (in multiple elev classes) @@ -510,12 +523,14 @@ end function get_num_icesheets !=============================================================================== - subroutine fldlist_add(num, fldlist, stdname) + subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) ! intput/output variables - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname + integer , intent(inout) :: num + type(fld_list_type) , intent(inout) :: fldlist(:) + character(len=*) , intent(in) :: stdname + integer , optional , intent(in) :: ungridded_lbound + integer , optional , intent(in) :: ungridded_ubound ! local variables integer :: rc @@ -532,6 +547,11 @@ subroutine fldlist_add(num, fldlist, stdname) endif fldlist(num)%stdname = trim(stdname) + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound + end if + end subroutine fldlist_add !=============================================================================== @@ -558,6 +578,7 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala integer :: n type(ESMF_Field) :: field character(len=80) :: stdname + character(CL) :: msg character(len=*),parameter :: subname='(glc_import_export:fldlist_realize)' ! ---------------------------------------------- @@ -578,13 +599,24 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala write(stdout,'(a)') trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe only" end if else - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO) ! Create the field - 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 - if (my_task == master_task) then - write(stdout,'(a)') trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh" + if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & + ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & + gridToFieldMap=(/2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + write(stdout,'(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 + if (my_task == master_task) then + write(stdout,'(a)') trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh" + end if end if endif