diff --git a/cime_config/stream_cdeps.py b/cime_config/stream_cdeps.py index f80586e80..0763589a7 100644 --- a/cime_config/stream_cdeps.py +++ b/cime_config/stream_cdeps.py @@ -344,7 +344,8 @@ def create_stream_xml( # Check that key is valid expect( - mod_dict[var_key] in valid_values[var_key], + (mod_dict[var_key] in valid_values[var_key]) or + (var_key == 'mapalgo' and 'mapfile:' in mod_dict[var_key]), "{} can only have values of {} for stream {} in file {}".format( var_key, valid_values[var_key], diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index 225b2ae47..5758916a6 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -37,7 +37,6 @@ module cdeps_datm_comp use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_log_clock_advance use dshr_mod , only : dshr_mesh_init, dshr_check_restart_alarm, dshr_restart_read use dshr_mod , only : dshr_orbital_init, dshr_orbital_update - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add, dshr_fldlist_realize use datm_datamode_core2_mod , only : datm_datamode_core2_advertise @@ -85,10 +84,11 @@ module cdeps_datm_comp use datm_pres_co2_mod , only : datm_pres_co2_advance implicit none - private ! except + private public :: SetServices public :: SetVM + private :: InitializeAdvertise private :: InitializeRealize private :: ModelAdvance @@ -108,7 +108,7 @@ module cdeps_datm_comp integer :: flds_scalar_index_nextsw_cday = 0 integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom - logical :: mainproc ! true of my_task == main_task + logical :: mainproc ! true of my_task == main_task integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number @@ -126,11 +126,11 @@ module cdeps_datm_comp logical :: nextsw_cday_calc_cam7 ! true => use logic appropriate to cam7 (and later) for calculating nextsw_cday character(CL) :: factorFn_mesh = 'null' ! file containing correction factors mesh character(CL) :: factorFn_data = 'null' ! file containing correction factors data + logical :: flds_presaero = .false. ! true => send valid prescribed aero fields to mediator logical :: flds_presndep = .false. ! true => send valid prescribed ndep fields to mediator logical :: flds_preso3 = .false. ! true => send valid prescribed ozone fields to mediator logical :: flds_co2 = .false. ! true => send prescribed co2 to mediator - logical :: flds_wiso = .false. ! true => send water isotopes to mediator character(CL) :: bias_correct = nullstr ! send bias correction fields to coupler character(CL) :: anomaly_forcing(8) = nullstr ! send anomaly forcing fields to coupler @@ -140,27 +140,27 @@ module cdeps_datm_comp integer :: ny_global ! global ny logical :: skip_restart_read = .false. ! true => skip restart read in continuation run logical :: export_all = .false. ! true => export all fields, do not check connected or not + logical :: first_call = .true. ! linked lists type(fldList_type) , pointer :: fldsImport => null() type(fldList_type) , pointer :: fldsExport => null() - type(dfield_type) , pointer :: dfields => null() ! model mask and model fraction real(r8), pointer :: model_frac(:) => null() integer , pointer :: model_mask(:) => null() ! constants - integer :: idt ! integer model timestep + integer :: idt ! integer model timestep logical :: diagnose_data = .true. integer , parameter :: main_task = 0 ! task number of main task #ifdef CESMCOUPLED - character(*) , parameter :: modName = "(atm_comp_nuopc)" + character(len=*) , parameter :: modName = "(atm_comp_nuopc)" #else - character(*) , parameter :: modName = "(cdeps_datm_comp)" + character(len=*) , parameter :: modName = "(cdeps_datm_comp)" #endif - character(*), parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -228,10 +228,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: bcasttmp(10) character(CL) :: nextsw_cday_calc type(ESMF_VM) :: vm - character(len=*),parameter :: subname = modName // ':(InitializeAdvertise) ' - character(*) ,parameter :: F00 = "('(" // modName // ") ',8a)" - character(*) ,parameter :: F01 = "('(" // modName // ") ',a,2x,i8)" - character(*) ,parameter :: F02 = "('(" // modName // ") ',a,l6)" + character(len=*),parameter :: subname=trim(modName) // ':(InitializeAdvertise) ' !------------------------------------------------------------------------------- namelist / datm_nml / & @@ -247,7 +244,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) factorFn_mesh, & flds_presaero, & flds_co2, & - flds_wiso, & bias_correct, & anomaly_forcing, & skip_restart_read, & @@ -290,6 +286,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_log_error(subName//': namelist read error '//trim(nlfilename), rc=rc) return end if + + ! write namelist input to standard out + write(logunit,'(3a)') subname,' case_name = ',trim(case_name) + write(logunit,'(3a)') subname,' datamode = ',trim(datamode) + write(logunit,'(3a)') subname,' model_meshfile = ',trim(model_meshfile) + write(logunit,'(3a)') subname,' model_maskfile = ',trim(model_maskfile) + write(logunit,'(2a,i0)') subname,' nx_global = ',nx_global + write(logunit,'(2a,i0)') subname,' ny_global = ',ny_global + write(logunit,'(3a)') subname,' restfilm = ',trim(restfilm) + write(logunit,'(2a,i0)') subname,' iradsw = ',iradsw + write(logunit,'(3a)') subname,' nextsw_cday_calc = ', trim(nextsw_cday_calc) + write(logunit,'(3a)') subname,' factorFn_data = ',trim(factorFn_data) + write(logunit,'(3a)') subname,' factorFn_mesh = ',trim(factorFn_mesh) + write(logunit,'(2a,l6)') subname,' flds_presaero = ',flds_presaero + write(logunit,'(2a,l6)') subname,' flds_presndep = ',flds_presndep + write(logunit,'(2a,l6)') subname,' flds_preso3 = ',flds_preso3 + write(logunit,'(2a,l6)') subname,' flds_co2 = ',flds_co2 + write(logunit,'(2a,l6)') subname,' skip_restart_read = ',skip_restart_read + write(logunit,'(2a,l6)') subname,' export_all = ',export_all + bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global @@ -298,13 +314,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if(flds_presndep) bcasttmp(5) = 1 if(flds_preso3) bcasttmp(6) = 1 if(flds_co2) bcasttmp(7) = 1 - if(flds_wiso) bcasttmp(8) = 1 - if(skip_restart_read) bcasttmp(9) = 1 - if(export_all) bcasttmp(10) = 1 + if(skip_restart_read) bcasttmp(8) = 1 + if(export_all) bcasttmp(9) = 1 end if + + ! Broadcast namelist input call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, datamode, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, bias_correct, CL, main_task, rc=rc) @@ -325,6 +341,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, bcasttmp, 10, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nx_global = bcasttmp(1) ny_global = bcasttmp(2) iradsw = bcasttmp(3) @@ -332,9 +349,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) flds_presndep = (bcasttmp(5) == 1) flds_preso3 = (bcasttmp(6) == 1) flds_co2 = (bcasttmp(7) == 1) - flds_wiso = (bcasttmp(8) == 1) - skip_restart_read = (bcasttmp(9) == 1) - export_all = (bcasttmp(10) == 1) + skip_restart_read = (bcasttmp(8) == 1) + export_all = (bcasttmp(9) == 1) if (nextsw_cday_calc == 'cam7') then nextsw_cday_calc_cam7 = .true. @@ -345,46 +361,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return end if - ! write namelist input to standard out - if (my_task == main_task) then - write(logunit,F00)' case_name = ',trim(case_name) - write(logunit,F00)' datamode = ',trim(datamode) - write(logunit,F00)' model_meshfile = ',trim(model_meshfile) - write(logunit,F00)' model_maskfile = ',trim(model_maskfile) - write(logunit,F01)' nx_global = ',nx_global - write(logunit,F01)' ny_global = ',ny_global - write(logunit,F00)' restfilm = ',trim(restfilm) - write(logunit,F01)' iradsw = ',iradsw - write(logunit,F00)' nextsw_cday_calc = ', trim(nextsw_cday_calc) - write(logunit,F00)' factorFn_data = ',trim(factorFn_data) - write(logunit,F00)' factorFn_mesh = ',trim(factorFn_mesh) - write(logunit,F02)' flds_presaero = ',flds_presaero - write(logunit,F02)' flds_presndep = ',flds_presndep - write(logunit,F02)' flds_preso3 = ',flds_preso3 - write(logunit,F02)' flds_co2 = ',flds_co2 - write(logunit,F02)' flds_wiso = ',flds_wiso - write(logunit,F02)' skip_restart_read = ',skip_restart_read - write(logunit,F02)' export_all = ',export_all - end if - ! Validate sdat datamode if (mainproc) write(logunit,*) ' datm datamode = ',trim(datamode) - if ( trim(datamode) == 'CORE2_NYF' .or. & - trim(datamode) == 'CORE2_IAF' .or. & - trim(datamode) == 'CORE_IAF_JRA' .or. & - trim(datamode) == 'CORE_RYF6162_JRA' .or. & - trim(datamode) == 'CORE_RYF8485_JRA' .or. & - trim(datamode) == 'CORE_RYF9091_JRA' .or. & - trim(datamode) == 'CORE_RYF0304_JRA' .or. & - trim(datamode) == 'CLMNCEP' .or. & - trim(datamode) == 'CPLHIST' .or. & - trim(datamode) == 'GEFS' .or. & - trim(datamode) == 'ERA5' .or. & - trim(datamode) == 'SIMPLE') then - else + select case (trim(datamode)) + case ('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA', & + 'CORE_RYF6162_JRA','CORE_RYF8485_JRA','CORE_RYF9091_JRA','CORE_RYF0304_JRA', & + 'CLMNCEP','CPLHIST','GEFS','ERA5','SIMPLE') + if (mainproc) write(logunit,'(3a)') subname,'datm datamode = ',trim(datamode) + case default call shr_log_error(' ERROR illegal datm datamode = '//trim(datamode), rc=rc) return - endif + end select ! Advertise fields that ARE NOT datamode specific if (flds_co2) then @@ -608,13 +595,15 @@ end subroutine ModelAdvance !=============================================================================== subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod, target_mon, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, restart_write, rc) + use nuopc_shr_methods, only : shr_get_rpointer_name + ! ---------------------------------- ! run method for datm model ! ---------------------------------- ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_GridComp) , intent(inout) :: gcomp type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState integer , intent(in) :: target_ymd ! model date @@ -628,9 +617,8 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod integer , intent(out) :: rc ! local variables - logical :: first_time = .true. character(len=CL) :: rpfile - character(*), parameter :: subName = '(datm_comp_run) ' + character(len=*), parameter :: subName = '(datm_comp_run) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -641,7 +629,7 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod ! First time initialization !-------------------- - if (first_time) then + if_first_call: if (first_call) then ! Initialize data pointers for co2 (non datamode specific) if (flds_co2) then call datm_pres_co2_init_pointers(exportState, sdat, rc=rc) @@ -666,10 +654,6 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Initialize dfields - call datm_init_dfields(rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Initialize datamode module pointers select case (trim(datamode)) case('CORE2_NYF','CORE2_IAF') @@ -688,7 +672,7 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod call datm_datamode_era5_init_pointers(exportState, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('GEFS') - call datm_datamode_gefs_init_pointers(exportState, sdat, rc) + call datm_datamode_gefs_init_pointers(exportState, sdat, logunit, mainproc, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('SIMPLE') call datm_datamode_simple_init_pointers(exportState, sdat, rc) @@ -712,18 +696,17 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod end select end if - ! reset first_time - first_time = .false. - end if + first_call = .false. + end if if_first_call !-------------------- ! Advance datm streams !-------------------- - ! set data needed for cosz t-interp method + ! Set data needed for cosz t-interp method call shr_strdata_setOrbs(sdat, orbEccen, orbMvelpp, orbLambm0, orbObliqr, idt) - ! time and spatially interpolate to model time and grid + ! Time and spatially interpolate to model time and grid call ESMF_TraceRegionEnter('datm_strdata_advance') call shr_strdata_advance(sdat, target_ymd, target_tod, logunit, 'datm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -747,14 +730,7 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! copy all fields from streams to export state as default - ! This automatically will update the fields in the export state - call ESMF_TraceRegionEnter('datm_dfield_copy') - call dshr_dfield_copy(dfields, sdat, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('datm_dfield_copy') - - ! Determine data model behavior based on the mode + ! Determine data-mode specific behavior call ESMF_TraceRegionEnter('datm_datamode') select case (trim(datamode)) case('CORE2_NYF','CORE2_IAF') @@ -765,22 +741,19 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod call datm_datamode_jra_advance(exportstate, target_ymd, target_tod, sdat%model_calendar, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('CLMNCEP') - call datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) + call datm_datamode_clmncep_advance(mainproc, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('CPLHIST') - call datm_datamode_cplhist_advance(mainproc, logunit, mpicom, rc) + call datm_datamode_cplhist_advance(rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('ERA5') - call datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, target_ymd, & - target_tod, sdat%model_calendar, rc) + call datm_datamode_era5_advance(exportstate, mainproc, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('GEFS') - call datm_datamode_gefs_advance(exportstate, mainproc, logunit, mpicom, target_ymd, & - target_tod, sdat%model_calendar, rc) + call datm_datamode_gefs_advance(exportstate, sdat, mainproc, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('SIMPLE') - call datm_datamode_simple_advance(target_ymd, target_tod, target_mon, & - sdat%model_calendar, rc) + call datm_datamode_simple_advance(target_ymd, target_tod, target_mon, sdat%model_calendar, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end select @@ -814,52 +787,6 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod call ESMF_TraceRegionExit('datm_datamode') call ESMF_TraceRegionExit('DATM_RUN') - !-------- - contains - !-------- - - subroutine datm_init_dfields(rc) - ! ----------------------------- - ! Initialize dfields arrays - ! (for export fields that have a corresponding stream field) - ! ----------------------------- - - ! input/output parameters - integer, intent(out) :: rc - - ! local variables - integer :: n - integer :: rank - integer :: fieldcount - type(ESMF_Field) :: lfield - character(ESMF_MAXSTR) ,pointer :: lfieldnames(:) - character(*), parameter :: subName = "(datm_init_dfields) " - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnames(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=lfieldnames, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, fieldCount - call ESMF_LogWrite(subname//': field name = '//trim(lfieldnames(n)), ESMF_LOGMSG_INFO) - call ESMF_StateGet(exportState, itemName=trim(lfieldnames(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=rank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Currently rank==2 fields are handled in datm_pres_aero_mod.F90, datm_pres_co2_mod.F90 - ! and datm_pres_ndep_mod.F90 - ! The rank one Sa_o3 field is handled in datm_pres_o3_mod.F90 - if (rank == 1 .and. trim(lfieldnames(n)) /= 'Sa_o3') then - call dshr_dfield_add( dfields, sdat, trim(lfieldnames(n)), trim(lfieldnames(n)), & - exportState, logunit, mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - end subroutine datm_init_dfields - end subroutine datm_comp_run !=============================================================================== @@ -886,7 +813,7 @@ real(R8) function getNextRadCDay( julday, tod, stepno, dtime, iradsw ) real(R8) :: nextsw_cday integer :: liradsw integer :: delta_radsw - character(*),parameter :: subName = '(getNextRadCDay) ' + character(len=*),parameter :: subName = '(getNextRadCDay) ' !------------------------------------------------------------------------------- ! Note that stepno is obtained via the advancecount argument to diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index 35bf01b60..cccc8e3a3 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -102,11 +102,7 @@ char - none, - clim_1850_cmip7,clim_2000_cmip7,clim_2010_cmip7,hist_cmip7, - clim_1850_cmip6,clim_2000_cmip6,clim_2010_cmip6,hist_cmip6, - SSP1-2.6,SSP2-4.5,SSP3-7.0,SSP5-3.4,SSP5-8.5,cplhist - + none,clim_1850_cmip7,clim_2000_cmip7,clim_2010_cmip7,hist_cmip7,clim_1850_cmip6,clim_2000_cmip6,clim_2010_cmip6,hist_cmip6,SSP1-2.6,SSP2-4.5,SSP3-7.0,SSP5-3.4,SSP5-8.5,cplhist clim_2000 clim_1850_cmip6 diff --git a/datm/cime_config/namelist_definition_datm.xml b/datm/cime_config/namelist_definition_datm.xml index 146a20d06..92ab3bd14 100644 --- a/datm/cime_config/namelist_definition_datm.xml +++ b/datm/cime_config/namelist_definition_datm.xml @@ -14,9 +14,6 @@ CLM_QIAN.Solar,CLM_QIAN.Precip,CLM_QIAN.TPQW - - CLM_QIAN_WISO.Solar,CLM_QIAN_WISO.Precip,CLM_QIAN_WISO.TPQW - CLMCRUJRA2024.Solar,CLMCRUJRA2024.Precip,CLMCRUJRA2024.TPQW @@ -329,19 +326,6 @@ - - logical - datm - datm_nml - - If true, prescribed water isotopes are sent from datm (must be true for running with CLM). - - - .false. - - - - integer datm diff --git a/datm/datm_datamode_clmncep_mod.F90 b/datm/datm_datamode_clmncep_mod.F90 index 0001a90b8..181eac30a 100644 --- a/datm/datm_datamode_clmncep_mod.F90 +++ b/datm/datm_datamode_clmncep_mod.F90 @@ -12,6 +12,7 @@ module datm_datamode_clmncep_mod use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer use dshr_strdata_mod , only : shr_strdata_type use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + use shr_const_mod , only : SHR_CONST_SPVAL implicit none private @@ -23,60 +24,59 @@ module datm_datamode_clmncep_mod private :: datm_esat ! determine saturation vapor pressure ! export state data - real(r8), pointer :: Sa_z(:) => null() - real(r8), pointer :: Sa_u(:) => null() - real(r8), pointer :: Sa_v(:) => null() - real(r8), pointer :: Sa_tbot(:) => null() - real(r8), pointer :: Sa_ptem(:) => null() - real(r8), pointer :: Sa_shum(:) => null() - real(r8), pointer :: Sa_dens(:) => null() - real(r8), pointer :: Sa_pbot(:) => null() - real(r8), pointer :: Sa_pslv(:) => null() - real(r8), pointer :: Faxa_lwdn(:) => null() - real(r8), pointer :: Faxa_rainc(:) => null() - real(r8), pointer :: Faxa_rainl(:) => null() - real(r8), pointer :: Faxa_snowc(:) => null() - real(r8), pointer :: Faxa_snowl(:) => null() - real(r8), pointer :: Faxa_swndr(:) => null() - real(r8), pointer :: Faxa_swndf(:) => null() - real(r8), pointer :: Faxa_swvdr(:) => null() - real(r8), pointer :: Faxa_swvdf(:) => null() - real(r8), pointer :: Faxa_swnet(:) => null() - - ! stream data - real(r8), pointer :: strm_z(:) => null() - real(r8), pointer :: strm_wind(:) => null() - real(r8), pointer :: strm_tdew(:) => null() - real(r8), pointer :: strm_tbot(:) => null() - real(r8), pointer :: strm_pbot(:) => null() - real(r8), pointer :: strm_shum(:) => null() - real(r8), pointer :: strm_lwdn(:) => null() - real(r8), pointer :: strm_rh(:) => null() - real(r8), pointer :: strm_swdn(:) => null() - real(r8), pointer :: strm_swdndf(:) => null() - real(r8), pointer :: strm_swdndr(:) => null() - real(r8), pointer :: strm_precc(:) => null() - real(r8), pointer :: strm_precl(:) => null() - real(r8), pointer :: strm_precn(:) => null() - - ! stream data bias correction - real(r8), pointer :: strm_precsf(:) => null() - - ! stream data anomaly forcing - real(r8), pointer :: strm_u_af(:) => null() ! anomaly forcing - real(r8), pointer :: strm_v_af(:) => null() ! anomaly forcing - real(r8), pointer :: strm_prec_af(:) => null() ! anomaly forcing - real(r8), pointer :: strm_tbot_af(:) => null() ! anomaly forcing - real(r8), pointer :: strm_pbot_af(:) => null() ! anomaly forcing - real(r8), pointer :: strm_shum_af(:) => null() ! anomaly forcing - real(r8), pointer :: strm_swdn_af(:) => null() ! anomaly forcing - real(r8), pointer :: strm_lwdn_af(:) => null() ! anomaly forcing - - ! import state data - real(r8), pointer :: Sx_avsdr(:) => null() - real(r8), pointer :: Sx_anidr(:) => null() - real(r8), pointer :: Sx_avsdf(:) => null() - real(r8), pointer :: Sx_anidf(:) => null() + real(r8), pointer :: Sa_topo(:) => null() + real(r8), pointer :: Sa_z(:) => null() + real(r8), pointer :: Sa_u(:) => null() + real(r8), pointer :: Sa_v(:) => null() + real(r8), pointer :: Sa_tbot(:) => null() + real(r8), pointer :: Sa_ptem(:) => null() + real(r8), pointer :: Sa_shum(:) => null() + real(r8), pointer :: Sa_dens(:) => null() + real(r8), pointer :: Sa_pbot(:) => null() + real(r8), pointer :: Sa_pslv(:) => null() + real(r8), pointer :: Faxa_rainc(:) => null() + real(r8), pointer :: Faxa_rainl(:) => null() + real(r8), pointer :: Faxa_snowc(:) => null() + real(r8), pointer :: Faxa_snowl(:) => null() + real(r8), pointer :: Faxa_swndr(:) => null() + real(r8), pointer :: Faxa_swndf(:) => null() + real(r8), pointer :: Faxa_swvdr(:) => null() + real(r8), pointer :: Faxa_swvdf(:) => null() + real(r8), pointer :: Faxa_swnet(:) => null() + real(r8), pointer :: Faxa_swdn(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => null() + + ! import state data pointers + real(r8), pointer :: Sx_avsdr(:) => null() + real(r8), pointer :: Sx_anidr(:) => null() + real(r8), pointer :: Sx_avsdf(:) => null() + real(r8), pointer :: Sx_anidf(:) => null() + + ! stream data pointers + real(r8), pointer :: strm_Sa_topo(:) => null() + real(r8), pointer :: strm_Sa_z(:) => null() + real(r8), pointer :: strm_Sa_tbot(:) => null() + real(r8), pointer :: strm_Sa_pbot(:) => null() + real(r8), pointer :: strm_Sa_wind(:) => null() + real(r8), pointer :: strm_Sa_tdew(:) => null() + real(r8), pointer :: strm_Sa_shum(:) => null() + real(r8), pointer :: strm_Sa_rh(:) => null() + real(r8), pointer :: strm_Faxa_lwdn(:) => null() + real(r8), pointer :: strm_Faxa_swdn(:) => null() + real(r8), pointer :: strm_Faxa_swdndf(:) => null() + real(r8), pointer :: strm_Faxa_swdndr(:) => null() + real(r8), pointer :: strm_Faxa_precn(:) => null() + real(r8), pointer :: strm_Faxa_precsf(:) => null() ! bias correction + real(r8), pointer :: strm_Sa_u_af(:) => null() ! anomaly forcing + real(r8), pointer :: strm_Sa_v_af(:) => null() ! anomaly forcing + real(r8), pointer :: strm_Sa_tbot_af(:) => null() ! anomaly forcing + real(r8), pointer :: strm_Sa_pbot_af(:) => null() ! anomaly forcing + real(r8), pointer :: strm_Sa_shum_af(:) => null() ! anomaly forcing + real(r8), pointer :: strm_Faxa_prec_af(:) => null() ! anomaly forcing + real(r8), pointer :: strm_Faxa_swdn_af(:) => null() ! anomaly forcing + real(r8), pointer :: strm_Faxa_lwdn_af(:) => null() ! anomaly forcing + + ! Other module variables logical :: atm_prognostic = .false. real(r8) :: tbotmax ! units detector @@ -160,55 +160,9 @@ subroutine datm_datamode_clmncep_init_pointers(importState, exportState, sdat, r rc = ESMF_SUCCESS - ! initialize pointers for module level stream arrays - call shr_strdata_get_stream_pointer( sdat, 'Sa_pbot' , strm_pbot , rc) + ! initialize export state pointers + call dshr_state_getfldptr(exportState, 'Sa_topo' , fldptr1=Sa_topo , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_tbot' , strm_tbot , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_shum' , strm_shum , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_wind' , strm_wind , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_tdew' , strm_tdew , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_rh' , strm_rh , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_z' , strm_z , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdndf' , strm_swdndf, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdndr' , strm_swdndr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_lwdn' , strm_lwdn , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn' , strm_swdn , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_precn' , strm_precn , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initialize pointers for module level stream arrays for bias correction - call shr_strdata_get_stream_pointer( sdat, 'Faxa_precsf' , strm_precsf , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initialize pointers for module level stream arrays for anomaly forcing - call shr_strdata_get_stream_pointer( sdat, 'Sa_u_af' , strm_u_af , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_v_af' , strm_v_af , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_shum_af' , strm_shum_af, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_tbot_af' , strm_tbot_af, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Sa_pbot_af' , strm_pbot_af, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_prec_af' , strm_prec_af, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn_af' , strm_swdn_af, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_lwdn_af' , strm_lwdn_af, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! get export state pointers call dshr_state_getfldptr(exportState, 'Sa_z' , fldptr1=Sa_z , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_u' , fldptr1=Sa_u , rc=rc) @@ -217,16 +171,16 @@ subroutine datm_datamode_clmncep_init_pointers(importState, exportState, sdat, r if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_tbot' , fldptr1=Sa_tbot , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Sa_pbot' , fldptr1=Sa_pbot , rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Sa_pslv' , fldptr1=Sa_pslv , rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_ptem' , fldptr1=Sa_ptem , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_shum' , fldptr1=Sa_shum , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_dens' , fldptr1=Sa_dens , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_pbot' , fldptr1=Sa_pbot , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_pslv' , fldptr1=Sa_pslv , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rainc' , fldptr1=Faxa_rainc , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rainl' , fldptr1=Faxa_rainl , rc=rc) @@ -245,16 +199,13 @@ subroutine datm_datamode_clmncep_init_pointers(importState, exportState, sdat, r if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_swnet' , fldptr1=Faxa_swnet , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swdn' , fldptr1=Faxa_swdn , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! error check - if (.not. associated(strm_wind) .or. .not. associated(strm_tbot)) then - call shr_log_error(subname//' ERROR: wind and tbot must be in streams for CLMNCEP', rc=rc) - return - endif - ! determine anidrmax (see below for use) + ! import data pointers (to determine anidrmax (see below for use)) call ESMF_StateGet(importstate, 'Sx_anidr', itemFlag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (itemflag /= ESMF_STATEITEM_NOTFOUND) then @@ -269,17 +220,88 @@ subroutine datm_datamode_clmncep_init_pointers(importState, exportState, sdat, r if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! required stream data pointers + call shr_strdata_get_stream_pointer( sdat, 'Sa_wind' , strm_Sa_wind, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_wind must be associated for datm clmncep datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_tbot' , strm_Sa_tbot, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_tbot must be associated for datm clmncep datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_precn' , strm_Faxa_precn, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_precn must be associated for datm clmncep datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! optional stream data pointers + call shr_strdata_get_stream_pointer( sdat, 'Sa_topo' , strm_Sa_topo , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_pbot' , strm_Sa_pbot , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_z' , strm_Sa_z , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_shum' , strm_Sa_shum , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_tdew' , strm_Sa_tdew , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_rh' , strm_Sa_rh , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdndf' , strm_Faxa_swdndf , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdndr' , strm_Faxa_swdndr , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_lwdn' , strm_Faxa_lwdn , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn' , strm_Faxa_swdn , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if ( .not. associated(strm_Sa_shum) .and. & + .not. associated(strm_Sa_rh) .and. & + .not. associated(strm_Sa_tdew)) then + call shr_log_error(subname//'ERROR: one of strm_Sa_shum, strm_Sa_rh or strm_Sa_tdew '// & + 'must for associated to compute specific humidity in clmncep datamode', rc=rc) + return + endif + if ( .not. associated(strm_Faxa_swdndf) .and. & + .not. associated(strm_Faxa_swdndr) .and. & + .not. associated(strm_Faxa_swdn)) then + call shr_log_error(subName//'ERROR: either strm_Faxa_swdndf and strm_faxa_swdndr .or strm_faxa_swdn '//& + 'must be associated for computing short-wave down in clmncep datamode', rc=rc) + return + endif + + ! initialize stream pointers for module for bias correction + call shr_strdata_get_stream_pointer( sdat, 'Faxa_precsf' , strm_Faxa_precsf , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize stream pointers anomaly forcing + call shr_strdata_get_stream_pointer( sdat, 'Sa_u_af' , strm_Sa_u_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_v_af' , strm_Sa_v_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_shum_af' , strm_Sa_shum_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_tbot_af' , strm_Sa_tbot_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_pbot_af' , strm_Sa_pbot_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_prec_af' , strm_Faxa_prec_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn_af' , strm_Faxa_swdn_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_lwdn_af' , strm_Faxa_lwdn_af , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine datm_datamode_clmncep_init_pointers !=============================================================================== - subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) + subroutine datm_datamode_clmncep_advance(mainproc, logunit, rc) + use ESMF, only: ESMF_VMGetCurrent, ESMF_VMAllReduce, ESMF_REDUCE_MAX, ESMF_VM ! input/output variables - logical , intent(in) :: mainproc - integer , intent(in) :: logunit - integer , intent(in) :: mpicom - integer , intent(out) :: rc + logical , intent(in) :: mainproc + integer , intent(in) :: logunit + integer , intent(out) :: rc ! local variables logical :: first_time = .true. @@ -302,6 +324,15 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) lsize = size(Sa_u) + ! Direct copies of stream fields + Sa_tbot(:) = strm_Sa_tbot(:) + Faxa_swdn(:) = strm_Faxa_swdn(:) + if (associated(strm_Sa_topo)) then + Sa_topo(:) = strm_Sa_topo(:) + else + Sa_topo(:) = SHR_CONST_SPVAL + end if + if (first_time) then call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -328,8 +359,8 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) if (mainproc) write(logunit,*) subname,' anidrmax = ',anidrmax ! determine tdewmax (see below for use) - if (associated(strm_tdew)) then - rtmp(1) = maxval(strm_tdew(:)) + if (associated(strm_Sa_tdew)) then + rtmp(1) = maxval(strm_Sa_tdew(:)) call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return tdewmax = rtmp(2) @@ -341,8 +372,13 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) end if do n = 1,lsize + !--- bottom layer height --- - if (.not. associated(strm_z)) Sa_z(n) = 30.0_r8 + if (.not. associated(strm_Sa_z)) then + Sa_z(n) = 30.0_r8 + else + Sa_z(n) = strm_Sa_z(n) + end if !--- temperature --- if (tbotmax < 50.0_r8) Sa_tbot(n) = Sa_tbot(n) + tkFrz @@ -351,78 +387,79 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) Sa_ptem(n) = Sa_tbot(n) !--- pressure --- - if (.not. associated(strm_pbot)) then - Sa_pbot(n) = pstd - else if (Sa_pbot(n) == 0._r8) then - ! This happens if you are using points over ocean where the mask is 0 + if (.not. associated(strm_Sa_pbot)) then Sa_pbot(n) = pstd + else + Sa_pbot(n) = strm_Sa_pbot(n) + if (Sa_pbot(n) == 0._r8) then + ! This happens if you are using points over ocean where the mask is 0 + Sa_pbot(n) = pstd + end if end if - Sa_pslv(n) = Sa_pbot(n) !--- u, v wind velocity --- - Sa_u(n) = strm_wind(n)/sqrt(2.0_r8) + Sa_u(n) = strm_Sa_wind(n)/sqrt(2.0_r8) Sa_v(n) = Sa_u(n) !--- specific humidity --- tbot = Sa_tbot(n) pbot = Sa_pbot(n) - if (associated(strm_shum)) then + if (associated(strm_Sa_shum)) then e = datm_esat(tbot,tbot) qsat = (0.622_r8 * e)/(pbot - 0.378_r8 * e) - if (qsat < Sa_shum(n)) then + if (qsat < strm_Sa_shum(n)) then Sa_shum(n) = qsat + else + Sa_shum(n) = strm_Sa_shum(n) endif - else if (associated(strm_rh)) then - e = strm_rh(n) * 0.01_r8 * datm_esat(tbot,tbot) + else if (associated(strm_Sa_rh)) then + e = strm_Sa_rh(n) * 0.01_r8 * datm_esat(tbot,tbot) qsat = (0.622_r8 * e)/(pbot - 0.378_r8 * e) Sa_shum(n) = qsat - else if (associated(strm_tdew)) then - if (tdewmax < 50.0_r8) strm_tdew(n) = strm_tdew(n) + tkFrz - e = datm_esat(strm_tdew(n),tbot) + else if (associated(strm_Sa_tdew)) then + if (tdewmax < 50.0_r8) strm_Sa_tdew(n) = strm_Sa_tdew(n) + tkFrz + e = datm_esat(strm_Sa_tdew(n),tbot) qsat = (0.622_r8 * e)/(pbot - 0.378_r8 * e) Sa_shum(n) = qsat - else - call shr_log_error(subname//'ERROR: cannot compute shum', rc=rc) - return endif + !--- density --- vp = (Sa_shum(n)*pbot) / (0.622_r8 + 0.378_r8 * Sa_shum(n)) Sa_dens(n) = (pbot - 0.378_r8 * vp) / (tbot*rdair) !--- downward longwave --- - if (.not. associated(strm_lwdn)) then + if (.not. associated(strm_Faxa_lwdn)) then e = Sa_pslv(n) * Sa_shum(n) / (0.622_r8 + 0.378_r8 * Sa_shum(n)) ea = 0.70_r8 + 5.95e-05_r8 * 0.01_r8 * e * exp(1500.0_r8/tbot) Faxa_lwdn(n) = ea * stebol * tbot**4 + else + Faxa_lwdn(n) = strm_Faxa_lwdn(n) endif !--- shortwave radiation --- - if (associated(strm_swdndf) .and. associated(strm_swdndr)) then - Faxa_swndr(n) = strm_swdndr(n) * 0.50_r8 - Faxa_swvdr(n) = strm_swdndr(n) * 0.50_r8 - Faxa_swndf(n) = strm_swdndf(n) * 0.50_r8 - Faxa_swvdf(n) = strm_swdndf(n) * 0.50_r8 - elseif (associated(strm_swdn)) then + if (associated(strm_Faxa_swdndf) .and. associated(strm_Faxa_swdndr)) then + Faxa_swndr(n) = strm_Faxa_swdndr(n) * 0.50_r8 + Faxa_swvdr(n) = strm_Faxa_swdndr(n) * 0.50_r8 + Faxa_swndf(n) = strm_Faxa_swdndf(n) * 0.50_r8 + Faxa_swvdf(n) = strm_Faxa_swdndf(n) * 0.50_r8 + elseif (associated(strm_Faxa_swdn)) then ! relationship between incoming NIR or VIS radiation and ratio of ! direct to diffuse radiation calculated based on one year's worth of ! hourly CAM output from CAM version cam3_5_55 - swndr = strm_swdn(n) * 0.50_r8 + swndr = strm_Faxa_swdn(n) * 0.50_r8 ratio_rvrf = min(0.99_r8,max(0.29548_r8 + 0.00504_r8*swndr & -1.4957e-05_r8*swndr**2 + 1.4881e-08_r8*swndr**3,0.01_r8)) Faxa_swndr(n) = ratio_rvrf*swndr - swndf = strm_swdn(n) * 0.50_r8 + swndf = strm_Faxa_swdn(n) * 0.50_r8 Faxa_swndf(n) = (1._r8 - ratio_rvrf)*swndf - swvdr = strm_swdn(n) * 0.50_r8 + swvdr = strm_Faxa_swdn(n) * 0.50_r8 ratio_rvrf = min(0.99_r8,max(0.17639_r8 + 0.00380_r8*swvdr & -9.0039e-06_r8*swvdr**2 + 8.1351e-09_r8*swvdr**3,0.01_r8)) Faxa_swvdr(n) = ratio_rvrf*swvdr - swvdf = strm_swdn(n) * 0.50_r8 + swvdf = strm_Faxa_swdn(n) * 0.50_r8 Faxa_swvdf(n) = (1._r8 - ratio_rvrf)*swvdf - else - call shr_log_error(subName//'ERROR: cannot compute short-wave down', rc=rc) - return endif !--- swnet: a diagnostic quantity --- @@ -439,16 +476,8 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) endif !--- rain and snow --- - if (associated(strm_precc) .and. associated(strm_precl)) then - Faxa_rainc(n) = strm_precc(n) - Faxa_rainl(n) = strm_precl(n) - else if (associated(strm_precn)) then - Faxa_rainc(n) = strm_precn(n)*0.1_r8 - Faxa_rainl(n) = strm_precn(n)*0.9_r8 - else - call shr_log_error(subName//'ERROR: cannot compute rain and snow', rc=rc) - return - endif + Faxa_rainc(n) = strm_Faxa_precn(n)*0.1_r8 + Faxa_rainl(n) = strm_Faxa_precn(n)*0.9_r8 !--- split precip between rain & snow --- call shr_precip_partition_rain_snow_ramp(tbot, frac) @@ -466,46 +495,46 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) ! bias correct precipitation relative to observed ! (via bias_correct nameslist option) - if (associated(strm_precsf)) then - Faxa_snowc(:) = Faxa_snowc(:) * min(1.e2_r8,strm_precsf(:)) - Faxa_snowl(:) = Faxa_snowl(:) * min(1.e2_r8,strm_precsf(:)) - Faxa_rainc(:) = Faxa_rainc(:) * min(1.e2_r8,strm_precsf(:)) - Faxa_rainl(:) = Faxa_rainl(:) * min(1.e2_r8,strm_precsf(:)) + if (associated(strm_Faxa_precsf)) then + Faxa_snowc(:) = Faxa_snowc(:) * min(1.e2_r8,strm_Faxa_precsf(:)) + Faxa_snowl(:) = Faxa_snowl(:) * min(1.e2_r8,strm_Faxa_precsf(:)) + Faxa_rainc(:) = Faxa_rainc(:) * min(1.e2_r8,strm_Faxa_precsf(:)) + Faxa_rainl(:) = Faxa_rainl(:) * min(1.e2_r8,strm_Faxa_precsf(:)) endif ! adjust atmospheric input fields if anomaly forcing streams exist ! (via anomaly_forcing namelist option) - if (associated(strm_u_af) .and. associated(strm_v_af)) then ! wind - Sa_u(:) = Sa_u(:) + strm_u_af(:) - Sa_v(:) = Sa_v(:) + strm_v_af(:) + if (associated(strm_Sa_u_af) .and. associated(strm_Sa_v_af)) then ! wind + Sa_u(:) = Sa_u(:) + strm_Sa_u_af(:) + Sa_v(:) = Sa_v(:) + strm_Sa_v_af(:) endif - if (associated(strm_shum_af)) then ! specific humidity - Sa_shum(:) = Sa_shum(:) + strm_shum_af(:) + if (associated(strm_Sa_shum_af)) then ! specific humidity + Sa_shum(:) = Sa_shum(:) + strm_Sa_shum_af(:) ! avoid possible negative q values where (Sa_shum < 0._r8) Sa_shum = 1.e-6_r8 end where endif - if (associated(strm_pbot_af)) then ! pressure - Sa_pbot(:) = Sa_pbot(:) + strm_pbot_af(:) + if (associated(strm_Sa_pbot_af)) then ! pressure + Sa_pbot(:) = Sa_pbot(:) + strm_Sa_pbot_af(:) endif - if (associated(strm_tbot_af)) then ! temperature - Sa_tbot(:) = Sa_tbot(:) + strm_tbot_af(:) + if (associated(strm_Sa_tbot_af)) then ! temperature + Sa_tbot(:) = Sa_tbot(:) + strm_Sa_tbot_af(:) endif - if (associated(strm_lwdn_af)) then ! longwave - Faxa_lwdn(:) = Faxa_lwdn(:) * strm_lwdn_af(:) + if (associated(strm_Faxa_lwdn_af)) then ! longwave + Faxa_lwdn(:) = Faxa_lwdn(:) * strm_Faxa_lwdn_af(:) endif - if (associated(strm_prec_af)) then ! precipitation - Faxa_snowc(:) = Faxa_snowc(:) * strm_prec_af(:) - Faxa_snowl(:) = Faxa_snowl(:) * strm_prec_af(:) - Faxa_rainc(:) = Faxa_rainc(:) * strm_prec_af(:) - Faxa_rainl(:) = Faxa_rainl(:) * strm_prec_af(:) + if (associated(strm_Faxa_prec_af)) then ! precipitation + Faxa_snowc(:) = Faxa_snowc(:) * strm_Faxa_prec_af(:) + Faxa_snowl(:) = Faxa_snowl(:) * strm_Faxa_prec_af(:) + Faxa_rainc(:) = Faxa_rainc(:) * strm_Faxa_prec_af(:) + Faxa_rainl(:) = Faxa_rainl(:) * strm_Faxa_prec_af(:) end if - if (associated(strm_swdn_af)) then ! shortwave - Faxa_swndr(:) = Faxa_swndr(:) * strm_swdn_af(:) - Faxa_swvdr(:) = Faxa_swvdr(:) * strm_swdn_af(:) - Faxa_swndf(:) = Faxa_swndf(:) * strm_swdn_af(:) - Faxa_swvdf(:) = Faxa_swvdf(:) * strm_swdn_af(:) + if (associated(strm_Faxa_swdn_af)) then ! shortwave + Faxa_swndr(:) = Faxa_swndr(:) * strm_Faxa_swdn_af(:) + Faxa_swvdr(:) = Faxa_swvdr(:) * strm_Faxa_swdn_af(:) + Faxa_swndf(:) = Faxa_swndf(:) * strm_Faxa_swdn_af(:) + Faxa_swvdf(:) = Faxa_swvdf(:) * strm_Faxa_swdn_af(:) endif ! bias correction / anomaly forcing ( end block ) diff --git a/datm/datm_datamode_core2_mod.F90 b/datm/datm_datamode_core2_mod.F90 index 67e0b3922..8e22fb7db 100644 --- a/datm/datm_datamode_core2_mod.F90 +++ b/datm/datm_datamode_core2_mod.F90 @@ -45,7 +45,7 @@ module datm_datamode_core2_mod real(r8), pointer :: Sa_shum(:) => null() real(r8), pointer :: Sa_pbot(:) => null() real(r8), pointer :: Sa_pslv(:) => null() - real(r8), pointer :: Faxa_lwdn(:) => null() + real(r8), pointer :: Sa_dens(:) => null() real(r8), pointer :: Faxa_rainc(:) => null() real(r8), pointer :: Faxa_rainl(:) => null() real(r8), pointer :: Faxa_snowc(:) => null() @@ -55,13 +55,22 @@ module datm_datamode_core2_mod real(r8), pointer :: Faxa_swvdr(:) => null() real(r8), pointer :: Faxa_swvdf(:) => null() real(r8), pointer :: Faxa_swnet(:) => null() + real(r8), pointer :: Faxa_swdn(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => null() - ! stream data - real(r8), pointer :: strm_prec(:) => null() - real(r8), pointer :: strm_swdn(:) => null() - real(r8), pointer :: strm_tarcf(:) => null() - - ! othe module arrays + ! required stream data points + real(r8), pointer :: strm_Faxa_prec(:) => null() + real(r8), pointer :: strm_Faxa_swdn(:) => null() + real(r8), pointer :: strm_Faxa_lwdn(:) => null() + real(r8), pointer :: strm_Sa_pslv(:) => null() + real(r8), pointer :: strm_Sa_tbot(:) => null() + real(r8), pointer :: strm_Sa_shum(:) => null() + real(r8), pointer :: strm_Sa_dens(:) => null() + real(r8), pointer :: strm_Sa_u(:) => null() + real(r8), pointer :: strm_Sa_v(:) => null() + real(r8), pointer :: strm_tarcf(:) => null() + + ! other module arrays real(R8), pointer :: windFactor(:) real(R8), pointer :: winddFactor(:) real(R8), pointer :: qsatFactor(:) @@ -159,31 +168,6 @@ subroutine datm_datamode_core2_init_pointers(exportState, sdat, datamode, factor rc = ESMF_SUCCESS - lsize = sdat%model_lsize - - ! allocate module arrays - allocate(windFactor(lsize)) - allocate(winddFactor(lsize)) - allocate(qsatFactor(lsize)) - - call ESMF_MeshGet(sdat%model_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - allocate(yc(numOwnedElements)) - call ESMF_MeshGet(sdat%model_mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,numOwnedElements - yc(n) = ownedElemCoords(2*n) - end do - - ! get stream pointers - call shr_strdata_get_stream_pointer( sdat, 'Faxa_prec' , strm_prec , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn' , strm_swdn , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'tarcf' , strm_tarcf , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! get export state pointers call dshr_state_getfldptr(exportState, 'Sa_z' , fldptr1=Sa_z , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -205,6 +189,8 @@ subroutine datm_datamode_core2_init_pointers(exportState, sdat, datamode, factor if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_shum' , fldptr1=Sa_shum , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_dens' , fldptr1=Sa_dens , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rainc' , fldptr1=Faxa_rainc , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rainl' , fldptr1=Faxa_rainl , rc=rc) @@ -223,22 +209,63 @@ subroutine datm_datamode_core2_init_pointers(exportState, sdat, datamode, factor if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_swnet' , fldptr1=Faxa_swnet , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swdn' , fldptr1=Faxa_swdn , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. associated(strm_prec) .or. .not. associated(strm_swdn)) then - call shr_log_error(subname//'ERROR: prec and swdn must be in streams for CORE2', rc=rc) + ! get required stream pointers + call shr_strdata_get_stream_pointer( sdat, 'Faxa_prec' , strm_Faxa_prec , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_prec must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn' , strm_Faxa_swdn , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swdn must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_lwdn' , strm_Faxa_lwdn , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_lwdn must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_pslv' , strm_Sa_pslv , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_pslv must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_tbot' , strm_Sa_tbot , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_tbot must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_u' , strm_Sa_u , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_u must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_v' , strm_Sa_v , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_v must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_shum' , strm_Sa_shum , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_shum must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_dens' , strm_Sa_dens , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_dens must be associated for core2 datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'tarcf', strm_tarcf, rc) ! required for CORE2_IAF + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(datamode) == 'CORE2_IAF' .and. .not. associated(strm_tarcf)) then + call shr_log_error(subname//'tarcf must be associated for CORE2_IAF', rc=rc) return endif - if (trim(datamode) == 'CORE2_IAF' ) then - if (.not. associated(strm_tarcf)) then - call shr_log_error(subname//'tarcf must be in an input stream for CORE2_IAF', rc=rc) - return - endif - endif + ! create yc + call ESMF_MeshGet(sdat%model_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + allocate(yc(numOwnedElements)) + call ESMF_MeshGet(sdat%model_mesh, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,numOwnedElements + yc(n) = ownedElemCoords(2*n) + end do + deallocate(ownedElemCoords) ! create adjustment factor arrays + lsize = sdat%model_lsize + allocate(windFactor(lsize)) + allocate(winddFactor(lsize)) + allocate(qsatFactor(lsize)) call datm_get_adjustment_factors(sdat, factorFn_mesh, factorFn_data, windFactor, winddFactor, qsatFactor, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -278,11 +305,13 @@ subroutine datm_datamode_core2_advance(datamode, target_ymd, target_tod, target_ cosfactor = cos((2.0_R8*SHR_CONST_PI*rday)/365 - phs_c0) do n = 1,lsize + + !--- set Sa_z to a constant --- Sa_z(n) = 10.0_R8 !--- correction to NCEP winds based on QSCAT --- - uprime = Sa_u(n)*windFactor(n) - vprime = Sa_v(n)*windFactor(n) + uprime = strm_Sa_u(n)*windFactor(n) + vprime = strm_Sa_v(n)*windFactor(n) Sa_u(n) = uprime*cos(winddFactor(n)*degtorad) - vprime*sin(winddFactor(n)*degtorad) Sa_v(n) = uprime*sin(winddFactor(n)*degtorad) + vprime*cos(winddFactor(n)*degtorad) @@ -291,9 +320,12 @@ subroutine datm_datamode_core2_advance(datamode, target_ymd, target_tod, target_ Sa_v10m(n) = Sa_v(n) !--- density and pslv taken directly from input stream, set pbot --- + Sa_pslv(n) = strm_Sa_pslv(n) + Sa_dens(n) = strm_Sa_dens(n) Sa_pbot(n) = Sa_pslv(n) !--- correction to NCEP Arctic & Antarctic air T & potential T --- + Sa_tbot(n) = strm_Sa_tbot(n) if ( yc(n) < -60.0_R8 ) then tMin = (avg_c0 + avg_c1*yc(n)) + (amp_c0 + amp_c1*yc(n))*cosFactor + tKFrz Sa_tbot(n) = max(Sa_tbot(n), tMin) @@ -304,7 +336,7 @@ subroutine datm_datamode_core2_advance(datamode, target_ymd, target_tod, target_ Sa_ptem(n) = Sa_tbot(n) !--- correction to NCEP relative humidity for heat budget balance --- - Sa_shum(n) = Sa_shum(n) + qsatFactor(n) + Sa_shum(n) = strm_Sa_shum(n) + qsatFactor(n) !--- Dupont correction to NCEP Arctic air T --- !--- don't correct during summer months (July-September) @@ -315,34 +347,37 @@ subroutine datm_datamode_core2_advance(datamode, target_ymd, target_tod, target_ end if ! PRECIPITATION DATA - strm_prec(n) = strm_prec(n)/86400.0_R8 ! convert mm/day to kg/m^2/s + strm_Faxa_prec(n) = strm_Faxa_prec(n)/86400.0_R8 ! convert mm/day to kg/m^2/s ! only correct satellite products, do not correct Serreze Arctic data if ( yc(n) < 58. ) then - strm_prec(n) = strm_prec(n)*1.14168_R8 + strm_Faxa_prec(n) = strm_Faxa_prec(n)*1.14168_R8 endif if ( yc(n) >= 58. .and. yc(n) < 68. ) then factor = MAX(0.0_R8, 1.0_R8 - 0.1_R8*(yc(n)-58.0_R8) ) - strm_prec(n) = strm_prec(n)*(factor*(1.14168_R8 - 1.0_R8) + 1.0_R8) + strm_Faxa_prec(n) = strm_Faxa_prec(n)*(factor*(1.14168_R8 - 1.0_R8) + 1.0_R8) endif Faxa_rainc(n) = 0.0_R8 ! default zero Faxa_snowc(n) = 0.0_R8 if (Sa_tbot(n) < tKFrz ) then ! assign precip to rain/snow components Faxa_rainl(n) = 0.0_R8 - Faxa_snowl(n) = strm_prec(n) + Faxa_snowl(n) = strm_Faxa_prec(n) else - Faxa_rainl(n) = strm_prec(n) + Faxa_rainl(n) = strm_Faxa_prec(n) Faxa_snowl(n) = 0.0_R8 endif ! RADIATION DATA !--- fabricate required swdn components from net swdn --- - Faxa_swvdr(n) = strm_swdn(n)*(0.28_R8) - Faxa_swndr(n) = strm_swdn(n)*(0.31_R8) - Faxa_swvdf(n) = strm_swdn(n)*(0.24_R8) - Faxa_swndf(n) = strm_swdn(n)*(0.17_R8) + Faxa_swdn(n) = strm_Faxa_swdn(n) + Faxa_swvdr(n) = strm_Faxa_swdn(n)*(0.28_R8) + Faxa_swndr(n) = strm_Faxa_swdn(n)*(0.31_R8) + Faxa_swvdf(n) = strm_Faxa_swdn(n)*(0.24_R8) + Faxa_swndf(n) = strm_Faxa_swdn(n)*(0.17_R8) + !--- compute net short-wave based on LY08 latitudinally-varying albedo --- avg_alb = ( 0.069 - 0.011*cos(2.0_R8*yc(n)*degtorad ) ) - Faxa_swnet(n) = strm_swdn(n)*(1.0_R8 - avg_alb) + Faxa_swnet(n) = strm_Faxa_swdn(n)*(1.0_R8 - avg_alb) + !--- corrections to GISS sswdn for heat budget balancing --- factor = 1.0_R8 if ( -60.0_R8 < yc(n) .and. yc(n) < -50.0_R8 ) then @@ -357,10 +392,12 @@ subroutine datm_datamode_core2_advance(datamode, target_ymd, target_tod, target_ Faxa_swndr(n) = Faxa_swndr(n)*factor Faxa_swvdf(n) = Faxa_swvdf(n)*factor Faxa_swndf(n) = Faxa_swndf(n)*factor + !--- correction to GISS lwdn in Arctic --- + Faxa_lwdn(n) = strm_Faxa_lwdn(n) if ( yc(n) > 60._R8 ) then factor = MIN(1.0_R8, 0.1_R8*(yc(n)-60.0_R8) ) - Faxa_lwdn(n) = Faxa_lwdn(n) + factor * dLWarc + Faxa_lwdn(n) = strm_Faxa_lwdn(n) + factor * dLWarc endif enddo ! lsize diff --git a/datm/datm_datamode_cplhist_mod.F90 b/datm/datm_datamode_cplhist_mod.F90 index de46522d8..a26193c61 100644 --- a/datm/datm_datamode_cplhist_mod.F90 +++ b/datm/datm_datamode_cplhist_mod.F90 @@ -5,6 +5,7 @@ module datm_datamode_cplhist_mod use ESMF , only : ESMF_StateGet use NUOPC , only : NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_log_mod , only : shr_log_error use dshr_methods_mod , only : dshr_state_getfldptr, chkerr use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer use dshr_strdata_mod , only : shr_strdata_type @@ -17,27 +18,51 @@ module datm_datamode_cplhist_mod public :: datm_datamode_cplhist_init_pointers public :: datm_datamode_cplhist_advance - ! export state data - real(r8), pointer :: Sa_z(:) => null() - real(r8), pointer :: Sa_u(:) => null() - real(r8), pointer :: Sa_v(:) => null() - real(r8), pointer :: Sa_tbot(:) => null() - real(r8), pointer :: Sa_ptem(:) => null() - real(r8), pointer :: Sa_shum(:) => null() - real(r8), pointer :: Sa_dens(:) => null() - real(r8), pointer :: Sa_pbot(:) => null() - real(r8), pointer :: Sa_pslv(:) => null() - real(r8), pointer :: Faxa_lwdn(:) => null() - real(r8), pointer :: Faxa_rainc(:) => null() - real(r8), pointer :: Faxa_rainl(:) => null() - real(r8), pointer :: Faxa_snowc(:) => null() - real(r8), pointer :: Faxa_snowl(:) => null() - real(r8), pointer :: Faxa_swndr(:) => null() - real(r8), pointer :: Faxa_swndf(:) => null() - real(r8), pointer :: Faxa_swvdr(:) => null() - real(r8), pointer :: Faxa_swvdf(:) => null() - - character(len=*), parameter :: nullstr = 'null' + + ! export state data pointers + + real(r8), pointer :: Sa_topo(:) => null() + real(r8), pointer :: Sa_z(:) => null() + real(r8), pointer :: Sa_tbot(:) => null() + real(r8), pointer :: Sa_ptem(:) => null() + real(r8), pointer :: Sa_shum(:) => null() + real(r8), pointer :: Sa_dens(:) => null() + real(r8), pointer :: Sa_pbot(:) => null() + real(r8), pointer :: Sa_pslv(:) => null() + real(r8), pointer :: Sa_u(:) => null() + real(r8), pointer :: Sa_v(:) => null() + real(r8), pointer :: Faxa_rainc(:) => null() + real(r8), pointer :: Faxa_rainl(:) => null() + real(r8), pointer :: Faxa_snowc(:) => null() + real(r8), pointer :: Faxa_snowl(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => null() + real(r8), pointer :: Faxa_swndr(:) => null() + real(r8), pointer :: Faxa_swndf(:) => null() + real(r8), pointer :: Faxa_swvdr(:) => null() + real(r8), pointer :: Faxa_swvdf(:) => null() + + ! stream data pointers + + real(r8), pointer :: strm_Sa_topo(:) => null() + real(r8), pointer :: strm_Sa_z (:) => null() + real(r8), pointer :: strm_Sa_tbot(:) => null() + real(r8), pointer :: strm_Sa_ptem(:) => null() + real(r8), pointer :: strm_Sa_shum(:) => null() + real(r8), pointer :: strm_Sa_pbot(:) => null() + real(r8), pointer :: strm_Sa_dens(:) => null() + real(r8), pointer :: strm_Sa_pslv(:) => null() + real(r8), pointer :: strm_Sa_u(:) => null() + real(r8), pointer :: strm_Sa_v(:) => null() + real(r8), pointer :: strm_Faxa_swndr(:) => null() + real(r8), pointer :: strm_Faxa_swvdr(:) => null() + real(r8), pointer :: strm_Faxa_swndf(:) => null() + real(r8), pointer :: strm_Faxa_swvdf(:) => null() + real(r8), pointer :: strm_Faxa_rainc(:) => null() + real(r8), pointer :: strm_Faxa_rainl(:) => null() + real(r8), pointer :: strm_Faxa_snowc(:) => null() + real(r8), pointer :: strm_Faxa_snowl(:) => null() + real(r8), pointer :: strm_Faxa_lwdn (:) => null() + character(len=*), parameter :: u_FILE_u = & __FILE__ @@ -62,24 +87,26 @@ subroutine datm_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_ call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) call dshr_fldList_add(fldsExport, 'Sa_topo' ) call dshr_fldList_add(fldsExport, 'Sa_z' ) - call dshr_fldList_add(fldsExport, 'Sa_u' ) - call dshr_fldList_add(fldsExport, 'Sa_v' ) call dshr_fldList_add(fldsExport, 'Sa_ptem' ) call dshr_fldList_add(fldsExport, 'Sa_dens' ) call dshr_fldList_add(fldsExport, 'Sa_pslv' ) call dshr_fldList_add(fldsExport, 'Sa_tbot' ) call dshr_fldList_add(fldsExport, 'Sa_pbot' ) call dshr_fldList_add(fldsExport, 'Sa_shum' ) - call dshr_fldList_add(fldsExport, 'Faxa_rainc' ) - call dshr_fldList_add(fldsExport, 'Faxa_rainl' ) - call dshr_fldList_add(fldsExport, 'Faxa_snowc' ) - call dshr_fldList_add(fldsExport, 'Faxa_snowl' ) + + call dshr_fldList_add(fldsExport, 'Sa_u' ) + call dshr_fldList_add(fldsExport, 'Sa_v' ) + call dshr_fldList_add(fldsExport, 'Faxa_swndr' ) call dshr_fldList_add(fldsExport, 'Faxa_swvdr' ) call dshr_fldList_add(fldsExport, 'Faxa_swndf' ) call dshr_fldList_add(fldsExport, 'Faxa_swvdf' ) + + call dshr_fldList_add(fldsExport, 'Faxa_rainc' ) + call dshr_fldList_add(fldsExport, 'Faxa_rainl' ) + call dshr_fldList_add(fldsExport, 'Faxa_snowc' ) + call dshr_fldList_add(fldsExport, 'Faxa_snowl' ) call dshr_fldList_add(fldsExport, 'Faxa_lwdn' ) - call dshr_fldList_add(fldsExport, 'Faxa_swdn' ) fldlist => fldsExport ! the head of the linked list do while (associated(fldlist)) @@ -107,11 +134,9 @@ subroutine datm_datamode_cplhist_init_pointers(importState, exportState, sdat, r rc = ESMF_SUCCESS ! get export state pointers - call dshr_state_getfldptr(exportState, 'Sa_z' , fldptr1=Sa_z , rc=rc) + call dshr_state_getfldptr(exportState, 'Sa_topo' , fldptr1=Sa_topo , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Sa_u' , fldptr1=Sa_u , rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Sa_v' , fldptr1=Sa_v , rc=rc) + call dshr_state_getfldptr(exportState, 'Sa_z' , fldptr1=Sa_z , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_tbot' , fldptr1=Sa_tbot , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -125,6 +150,10 @@ subroutine datm_datamode_cplhist_init_pointers(importState, exportState, sdat, r if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_dens' , fldptr1=Sa_dens , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_u' , fldptr1=Sa_u , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_v' , fldptr1=Sa_v , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rainc' , fldptr1=Faxa_rainc , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rainl' , fldptr1=Faxa_rainl , rc=rc) @@ -133,6 +162,8 @@ subroutine datm_datamode_cplhist_init_pointers(importState, exportState, sdat, r if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_snowl' , fldptr1=Faxa_snowl , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_swvdr' , fldptr1=Faxa_swvdr , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_swvdf' , fldptr1=Faxa_swvdf , rc=rc) @@ -141,19 +172,77 @@ subroutine datm_datamode_cplhist_init_pointers(importState, exportState, sdat, r if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_swndf' , fldptr1=Faxa_swndf , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) + + ! Set pointers into stream data + + call shr_strdata_get_stream_pointer(sdat, 'Sa_topo', strm_Sa_topo, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_topo must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_z', strm_Sa_z, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_z must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_tbot', strm_Sa_tbot, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_tbot must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_ptem', strm_Sa_ptem, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_ptem must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_shum', strm_Sa_shum, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_shum must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_pbot', strm_Sa_pbot, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_pbot must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_dens', strm_Sa_dens, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_ndens must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_pslv', strm_Sa_pslv, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_pslv must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_u', strm_Sa_u, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_u must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_v', strm_Sa_v, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_v must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_rainc', strm_Faxa_rainc, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_rainc must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_rainl', strm_Faxa_rainl, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_rainl must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_snowc', strm_Faxa_snowc, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_snowc must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_snowl', strm_Faxa_snowl, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_snowl must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_lwdn', strm_Faxa_lwdn, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_lwdn must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swndr', strm_Faxa_swndr, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swndr must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swvdr', strm_Faxa_swvdr, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swvdr must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swndf', strm_Faxa_swndf, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swndf must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swvdf', strm_Faxa_swvdf, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swvdf must be associated for cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_lwdn', strm_Faxa_lwdn, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_lwdn must be associated for clmncep datamode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine datm_datamode_cplhist_init_pointers !=============================================================================== - subroutine datm_datamode_cplhist_advance(mainproc, logunit, mpicom, rc) + subroutine datm_datamode_cplhist_advance(rc) ! input/output variables - logical , intent(in) :: mainproc - integer , intent(in) :: logunit - integer , intent(in) :: mpicom - integer , intent(out) :: rc + integer, intent(out) :: rc ! local variables character(len=*), parameter :: subname='(datm_datamode_cplhist_advance): ' @@ -161,6 +250,27 @@ subroutine datm_datamode_cplhist_advance(mainproc, logunit, mpicom, rc) rc = ESMF_SUCCESS + Sa_topo(:) = strm_Sa_topo(:) + Sa_z(:) = strm_Sa_z(:) + Sa_tbot(:) = strm_Sa_tbot(:) + Sa_ptem(:) = strm_Sa_ptem(:) + Sa_shum(:) = strm_Sa_shum(:) + Sa_dens(:) = strm_Sa_dens(:) + Sa_pbot(:) = strm_Sa_pbot(:) + Sa_pslv(:) = strm_Sa_pslv(:) + Sa_u(:) = strm_Sa_u(:) + Sa_v(:) = strm_Sa_v(:) + + Faxa_rainc(:) = strm_Faxa_rainc(:) + Faxa_rainl(:) = strm_Faxa_rainl(:) + Faxa_snowc(:) = strm_Faxa_snowc(:) + Faxa_snowl(:) = strm_Faxa_snowl(:) + Faxa_lwdn(:) = strm_Faxa_lwdn (:) + Faxa_swndr(:) = strm_Faxa_swndr(:) + Faxa_swndf(:) = strm_Faxa_swndf(:) + Faxa_swvdr(:) = strm_Faxa_swvdr(:) + Faxa_swvdf(:) = strm_Faxa_swvdf(:) + end subroutine datm_datamode_cplhist_advance end module datm_datamode_cplhist_mod diff --git a/datm/datm_datamode_era5_mod.F90 b/datm/datm_datamode_era5_mod.F90 index d962152da..07046caeb 100644 --- a/datm/datm_datamode_era5_mod.F90 +++ b/datm/datm_datamode_era5_mod.F90 @@ -3,11 +3,10 @@ module datm_datamode_era5_mod use ESMF , only : ESMF_State, ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO use NUOPC , only : NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_precip_mod , only : shr_precip_partition_rain_snow_ramp use shr_const_mod , only : shr_const_tkfrz, shr_const_rhofw, shr_const_rdair + use shr_log_mod , only : shr_log_error use dshr_methods_mod , only : dshr_state_getfldptr, chkerr use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer - use dshr_strdata_mod , only : shr_strdata_type use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none @@ -47,7 +46,28 @@ module datm_datamode_era5_mod real(r8), pointer :: Faxa_tauy(:) => null() ! stream data - real(r8), pointer :: strm_tdew(:) => null() + real(r8), pointer :: strm_Sa_tdew(:) => null() + real(r8), pointer :: strm_Sa_t2m(:) => null() + real(r8), pointer :: strm_Sa_u10m(:) => null() + real(r8), pointer :: strm_Sa_v10m(:) => null() + real(r8), pointer :: strm_Sa_pslv(:) => null() + real(r8), pointer :: strm_Faxa_swdn(:) => null() + real(r8), pointer :: strm_Faxa_swvdr(:) => null() + real(r8), pointer :: strm_Faxa_swndr(:) => null() + real(r8), pointer :: strm_Faxa_swvdf(:) => null() + real(r8), pointer :: strm_Faxa_swndf(:) => null() + real(r8), pointer :: strm_Faxa_swnet(:) => null() + real(r8), pointer :: strm_Faxa_lwdn(:) => null() + real(r8), pointer :: strm_Faxa_lwnet(:) => null() + real(r8), pointer :: strm_Faxa_rain(:) => null() + real(r8), pointer :: strm_Faxa_rainc(:) => null() + real(r8), pointer :: strm_Faxa_rainl(:) => null() + real(r8), pointer :: strm_Faxa_snowc(:) => null() + real(r8), pointer :: strm_Faxa_snowl(:) => null() + real(r8), pointer :: strm_Faxa_sen(:) => null() + real(r8), pointer :: strm_Faxa_lat(:) => null() + real(r8), pointer :: strm_Faxa_taux(:) => null() + real(r8), pointer :: strm_Faxa_tauy(:) => null() real(r8) :: t2max ! units detector real(r8) :: td2max ! units detector @@ -64,8 +84,7 @@ module datm_datamode_era5_mod contains !=============================================================================== - subroutine datm_datamode_era5_advertise(exportState, fldsexport, & - flds_scalar_name, rc) + subroutine datm_datamode_era5_advertise(exportState, fldsexport, flds_scalar_name, rc) ! input/output variables type(esmf_State) , intent(inout) :: exportState @@ -131,7 +150,39 @@ subroutine datm_datamode_era5_init_pointers(exportState, sdat, rc) rc = ESMF_SUCCESS ! initialize pointers for module level stream arrays - call shr_strdata_get_stream_pointer( sdat, 'Sa_tdew' , strm_tdew , rc) + call shr_strdata_get_stream_pointer( sdat,'Sa_tdew', strm_Sa_tdew , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_t2m' , strm_Sa_t2m , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_u10m', strm_Sa_u10m, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_v10m', strm_Sa_v10m, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_pslv', strm_Sa_pslv, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swdn', strm_Faxa_swdn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swvdr', strm_Faxa_swvdr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swndr', strm_Faxa_swndr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swvdf', strm_Faxa_swvdf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swndf', strm_Faxa_swndf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_swnet', strm_Faxa_swnet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_lwdn', strm_Faxa_lwdn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_lwnet', strm_Faxa_lwnet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_sen', strm_Faxa_sen, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_lat', strm_Faxa_lat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_taux', strm_Faxa_taux, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_tauy', strm_Faxa_tauy, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get export state pointers @@ -186,20 +237,116 @@ subroutine datm_datamode_era5_init_pointers(exportState, sdat, rc) call dshr_state_getfldptr(exportState, 'Faxa_tauy' , fldptr1=Faxa_tauy , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Error checks + if (.not. associated(strm_Sa_tdew)) then + call shr_log_error(subname//'ERROR: strm_Sa_tdew must be associated for era5 datamode') + return + end if + + if (associated(Sa_wspd10m) .and. .not. associated(strm_Sa_u10m)) then + call shr_log_error(subname//'ERROR: strm_Sa_u10m must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Sa_wspd10m) .and. .not. associated(strm_Sa_v10m)) then + call shr_log_error(subname//'ERROR: strm_Sa_v10m must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Sa_t2m) .and. .not. associated(strm_Sa_t2m)) then + call shr_log_error(subname//'ERROR: strm_Sa_t2m must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Sa_t2m) .and. associated(Sa_pslv) .and. associated(Sa_q2m) .and. .not. associated(strm_Sa_pslv)) then + call shr_log_error(subname//'ERROR: strm_Sa_pslv must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_swdn)) then + if (.not. associated(strm_Faxa_swdn)) then + call shr_log_error(subname//'ERROR: strm_Faxa_swdn must be associated for era5 datamode', rc=rc) + return + end if + end if + if ( associated(Faxa_swvdr) .or. associated(Faxa_swndr) .or. associated(Faxa_swvdf) .or. associated(Faxa_swndf)) then + if (.not. associated(strm_Faxa_swdn)) then + call shr_log_error(subname//'ERROR: strm_Faxa_swdn must be associated for era5 datamode', rc=rc) + return + end if + end if + if (associated(Faxa_swvdr) .and. .not. associated(strm_Faxa_swvdr)) then + call shr_log_error(subname//'ERROR: strm_Faxa_swvdr must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_swndr) .and. .not. associated(strm_Faxa_swndr)) then + call shr_log_error(subname//'ERROR: strm_Faxa_swndr must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_swvdf) .and. .not. associated(strm_Faxa_swvdf)) then + call shr_log_error(subname//'ERROR: strm_Faxa_swvdf must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_swndf) .and. .not. associated(strm_Faxa_swndf)) then + call shr_log_error(subname//'ERROR: strm_Faxa_swndf must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_lwdn) .and. .not. associated(strm_Faxa_lwdn)) then + call shr_log_error(subname//'ERROR: strm_Faxa_lwdn must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_lwnet) .and. .not. associated(strm_Faxa_lwnet)) then + call shr_log_error(subname//'ERROR: strm_Faxa_lwnet must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_swnet) .and. .not. associated(strm_Faxa_swnet)) then + call shr_log_error(subname//'ERROR: strm_Faxa_swnet must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_sen) .and. .not. associated(strm_Faxa_sen)) then + call shr_log_error(subname//'ERROR: strm_Faxa_sen must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_lat) .and. .not. associated(strm_Faxa_lat)) then + call shr_log_error(subname//'ERROR: strm_Faxa_lat must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_rain) .and. .not. associated(strm_Faxa_rain)) then + call shr_log_error(subname//'ERROR: strm_Faxa_rain must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_rainc) .and. .not. associated(strm_Faxa_rainc)) then + call shr_log_error(subname//'ERROR: strm_Faxa_rainc must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_rainl) .and. .not. associated(strm_Faxa_rainl)) then + call shr_log_error(subname//'ERROR: strm_Faxa_rainl must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_snowc) .and. .not. associated(strm_Faxa_snowc)) then + call shr_log_error(subname//'ERROR: strm_Faxa_snowc must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_snowl) .and. .not. associated(strm_Faxa_snowl)) then + call shr_log_error(subname//'ERROR: strm_Faxa_snowl must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_taux) .and. .not. associated(strm_Faxa_taux)) then + call shr_log_error(subname//'ERROR: strm_Faxa_taux must be associated for era5 datamode', rc=rc) + return + end if + if (associated(Faxa_tauy) .and. .not. associated(strm_Faxa_tauy)) then + call shr_log_error(subname//'ERROR: strm_Faxa_tauy must be associated for era5 datamode', rc=rc) + return + end if + end subroutine datm_datamode_era5_init_pointers !=============================================================================== - subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, target_ymd, target_tod, model_calendar, rc) + subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, rc) + use ESMF, only: ESMF_VMGetCurrent, ESMF_VMAllReduce, ESMF_REDUCE_MAX, ESMF_VM ! input/output variables type(ESMF_State) , intent(inout) :: exportState logical , intent(in) :: mainproc integer , intent(in) :: logunit - integer , intent(in) :: mpicom - integer , intent(in) :: target_ymd - integer , intent(in) :: target_tod - character(len=*) , intent(in) :: model_calendar integer , intent(out) :: rc ! local variables @@ -215,11 +362,12 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta rc = ESMF_SUCCESS - lsize = size(strm_tdew) + lsize = size(strm_Sa_tdew) if (first_time) then call ESMF_VMGetCurrent(vm, rc=rc) ! determine t2max (see below for use) if (associated(Sa_t2m)) then + Sa_t2m(:) = strm_Sa_t2m(:) rtmp(1) = maxval(Sa_t2m(:)) call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) @@ -228,7 +376,7 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta end if ! determine tdewmax (see below for use) - rtmp(1) = maxval(strm_tdew(:)) + rtmp(1) = maxval(strm_Sa_tdew(:)) call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) td2max = rtmp(2) @@ -246,15 +394,15 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta !--- calculate wind speed --- if (associated(Sa_wspd10m)) then - Sa_wspd10m(n) = sqrt(Sa_u10m(n)*Sa_u10m(n)+Sa_v10m(n)*Sa_v10m(n)) + Sa_wspd10m(n) = sqrt(strm_Sa_u10m(n)*strm_Sa_u10m(n) + strm_Sa_v10m(n)*strm_Sa_v10m(n)) end if !--- specific humidity at 2m --- if (associated(Sa_t2m) .and. associated(Sa_pslv) .and. associated(Sa_q2m)) then t2 = Sa_t2m(n) - pslv = Sa_pslv(n) - if (td2max < 50.0_r8) strm_tdew(n) = strm_tdew(n) + tkFrz - e = datm_eSat(strm_tdew(n), t2) + pslv = strm_Sa_pslv(n) + if (td2max < 50.0_r8) strm_Sa_tdew(n) = strm_Sa_tdew(n) + tkFrz + e = datm_eSat(strm_Sa_tdew(n), t2) qsat = (0.622_r8 * e)/(pslv - 0.378_r8 * e) Sa_q2m(n) = qsat end if @@ -266,10 +414,10 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta !--- shortwave radiation (Faxa_* basically holds albedo) --- !--- see comments for Faxa_swnet - if (associated(Faxa_swvdr)) Faxa_swvdr(:) = Faxa_swdn(:)*Faxa_swvdr(:) - if (associated(Faxa_swndr)) Faxa_swndr(:) = Faxa_swdn(:)*Faxa_swndr(:) - if (associated(Faxa_swvdf)) Faxa_swvdf(:) = Faxa_swdn(:)*Faxa_swvdf(:) - if (associated(Faxa_swndf)) Faxa_swndf(:) = Faxa_swdn(:)*Faxa_swndf(:) + if (associated(Faxa_swvdr)) Faxa_swvdr(:) = strm_Faxa_swdn(:)*strm_Faxa_swvdr(:) + if (associated(Faxa_swndr)) Faxa_swndr(:) = strm_Faxa_swdn(:)*strm_Faxa_swndr(:) + if (associated(Faxa_swvdf)) Faxa_swvdf(:) = strm_Faxa_swdn(:)*strm_Faxa_swvdf(:) + if (associated(Faxa_swndf)) Faxa_swndf(:) = strm_Faxa_swdn(:)*strm_Faxa_swndf(:) !--- TODO: need to understand relationship between shortwave bands and !--- net shortwave rad. currently it is provided directly from ERA5 @@ -287,27 +435,27 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta !---------------------------------------------------------- ! convert J/m^2 to W/m^2 - if (associated(Faxa_lwdn)) Faxa_lwdn(:) = Faxa_lwdn(:)/3600.0_r8 - if (associated(Faxa_lwnet)) Faxa_lwnet(:) = Faxa_lwnet(:)/3600.0_r8 - if (associated(Faxa_swvdr)) Faxa_swvdr(:) = Faxa_swvdr(:)/3600.0_r8 - if (associated(Faxa_swndr)) Faxa_swndr(:) = Faxa_swndr(:)/3600.0_r8 - if (associated(Faxa_swvdf)) Faxa_swvdf(:) = Faxa_swvdf(:)/3600.0_r8 - if (associated(Faxa_swndf)) Faxa_swndf(:) = Faxa_swndf(:)/3600.0_r8 - if (associated(Faxa_swdn)) Faxa_swdn(:) = Faxa_swdn(:)/3600.0_r8 - if (associated(Faxa_swnet)) Faxa_swnet(:) = Faxa_swnet(:)/3600.0_r8 - if (associated(Faxa_sen)) Faxa_sen(:) = Faxa_sen(:)/3600.0_r8 - if (associated(Faxa_lat)) Faxa_lat(:) = Faxa_lat(:)/3600.0_r8 + if (associated(Faxa_lwdn)) Faxa_lwdn(:) = strm_Faxa_lwdn(:)/3600.0_r8 + if (associated(Faxa_lwnet)) Faxa_lwnet(:) = strm_Faxa_lwnet(:)/3600.0_r8 + if (associated(Faxa_swvdr)) Faxa_swvdr(:) = strm_Faxa_swvdr(:)/3600.0_r8 + if (associated(Faxa_swndr)) Faxa_swndr(:) = strm_Faxa_swndr(:)/3600.0_r8 + if (associated(Faxa_swvdf)) Faxa_swvdf(:) = strm_Faxa_swvdf(:)/3600.0_r8 + if (associated(Faxa_swndf)) Faxa_swndf(:) = strm_Faxa_swndf(:)/3600.0_r8 + if (associated(Faxa_swdn)) Faxa_swdn(:) = strm_Faxa_swdn(:)/3600.0_r8 + if (associated(Faxa_swnet)) Faxa_swnet(:) = strm_Faxa_swnet(:)/3600.0_r8 + if (associated(Faxa_sen)) Faxa_sen(:) = strm_Faxa_sen(:)/3600.0_r8 + if (associated(Faxa_lat)) Faxa_lat(:) = strm_Faxa_lat(:)/3600.0_r8 ! convert m to kg/m^2/s - if (associated(Faxa_rain)) Faxa_rain(:) = Faxa_rain(:)/3600.0_r8*rhofw - if (associated(Faxa_rainc)) Faxa_rainc(:) = Faxa_rainc(:)/3600.0_r8*rhofw - if (associated(Faxa_rainl)) Faxa_rainl(:) = Faxa_rainl(:)/3600.0_r8*rhofw - if (associated(Faxa_snowc)) Faxa_snowc(:) = Faxa_snowc(:)/3600.0_r8*rhofw - if (associated(Faxa_snowl)) Faxa_snowl(:) = Faxa_snowl(:)/3600.0_r8*rhofw + if (associated(Faxa_rain)) Faxa_rain(:) = strm_Faxa_rain(:)/3600.0_r8*rhofw + if (associated(Faxa_rainc)) Faxa_rainc(:) = strm_Faxa_rainc(:)/3600.0_r8*rhofw + if (associated(Faxa_rainl)) Faxa_rainl(:) = strm_Faxa_rainl(:)/3600.0_r8*rhofw + if (associated(Faxa_snowc)) Faxa_snowc(:) = strm_Faxa_snowc(:)/3600.0_r8*rhofw + if (associated(Faxa_snowl)) Faxa_snowl(:) = strm_Faxa_snowl(:)/3600.0_r8*rhofw ! convert N/m^2 s to N/m^2 - if (associated(Faxa_taux)) Faxa_taux(:) = Faxa_taux(:)/3600.0_r8 - if (associated(Faxa_tauy)) Faxa_tauy(:) = Faxa_tauy(:)/3600.0_r8 + if (associated(Faxa_taux)) Faxa_taux(:) = strm_Faxa_taux(:)/3600.0_r8 + if (associated(Faxa_tauy)) Faxa_tauy(:) = strm_Faxa_tauy(:)/3600.0_r8 end subroutine datm_datamode_era5_advance diff --git a/datm/datm_datamode_gefs_mod.F90 b/datm/datm_datamode_gefs_mod.F90 index 54a32309d..157cb5c94 100644 --- a/datm/datm_datamode_gefs_mod.F90 +++ b/datm/datm_datamode_gefs_mod.F90 @@ -1,13 +1,14 @@ module datm_datamode_gefs_mod - use ESMF , only : ESMF_State, ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_MAXSTR + use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Field + use ESMF , only : ESMF_TraceRegionEnter, ESMF_TraceRegionExit, ESMF_GridCompGet use NUOPC , only : NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_precip_mod , only : shr_precip_partition_rain_snow_ramp use shr_const_mod , only : shr_const_tkfrz, shr_const_rhofw, shr_const_rdair use dshr_methods_mod , only : dshr_state_getfldptr, chkerr use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer - use dshr_strdata_mod , only : shr_strdata_type use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none @@ -18,27 +19,45 @@ module datm_datamode_gefs_mod public :: datm_datamode_gefs_advance ! export state data - real(r8), pointer :: Sa_z(:) => null() - real(r8), pointer :: Sa_u(:) => null() - real(r8), pointer :: Sa_v(:) => null() - real(r8), pointer :: Sa_tbot(:) => null() - real(r8), pointer :: Sa_shum(:) => null() - real(r8), pointer :: Sa_pbot(:) => null() - real(r8), pointer :: Sa_u10m(:) => null() - real(r8), pointer :: Sa_v10m(:) => null() - real(r8), pointer :: Sa_t2m(:) => null() - real(r8), pointer :: Sa_q2m(:) => null() - real(r8), pointer :: Sa_pslv(:) => null() - real(r8), pointer :: Faxa_lwdn(:) => null() - real(r8), pointer :: Faxa_rain(:) => null() - real(r8), pointer :: Faxa_snow(:) => null() - real(r8), pointer :: Faxa_swndr(:) => null() - real(r8), pointer :: Faxa_swndf(:) => null() - real(r8), pointer :: Faxa_swvdr(:) => null() - real(r8), pointer :: Faxa_swvdf(:) => null() + real(r8), pointer :: Sa_z(:) => null() + real(r8), pointer :: Sa_u(:) => null() + real(r8), pointer :: Sa_v(:) => null() + real(r8), pointer :: Sa_tbot(:) => null() + real(r8), pointer :: Sa_shum(:) => null() + real(r8), pointer :: Sa_pbot(:) => null() + real(r8), pointer :: Sa_u10m(:) => null() + real(r8), pointer :: Sa_v10m(:) => null() + real(r8), pointer :: Sa_t2m(:) => null() + real(r8), pointer :: Sa_q2m(:) => null() + real(r8), pointer :: Sa_pslv(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => null() + real(r8), pointer :: Faxa_rain(:) => null() + real(r8), pointer :: Faxa_snow(:) => null() + real(r8), pointer :: Faxa_swndr(:) => null() + real(r8), pointer :: Faxa_swndf(:) => null() + real(r8), pointer :: Faxa_swvdr(:) => null() + real(r8), pointer :: Faxa_swvdf(:) => null() ! stream data - real(r8), pointer :: strm_mask(:) => null() + real(r8), pointer :: strm_Sa_mask(:) => null() + real(r8), pointer :: strm_Sa_z(:) => null() + real(r8), pointer :: strm_Sa_u(:) => null() + real(r8), pointer :: strm_Sa_v(:) => null() + real(r8), pointer :: strm_Sa_tbot(:) => null() + real(r8), pointer :: strm_Sa_shum(:) => null() + real(r8), pointer :: strm_Sa_pbot(:) => null() + real(r8), pointer :: strm_Sa_u10m(:) => null() + real(r8), pointer :: strm_Sa_v10m(:) => null() + real(r8), pointer :: strm_Sa_t2m(:) => null() + real(r8), pointer :: strm_Sa_q2m(:) => null() + real(r8), pointer :: strm_Sa_pslv(:) => null() + real(r8), pointer :: strm_Faxa_lwdn(:) => null() + real(r8), pointer :: strm_Faxa_rain(:) => null() + real(r8), pointer :: strm_Faxa_snow(:) => null() + real(r8), pointer :: strm_Faxa_swndr(:) => null() + real(r8), pointer :: strm_Faxa_swndf(:) => null() + real(r8), pointer :: strm_Faxa_swvdr(:) => null() + real(r8), pointer :: strm_Faxa_swvdf(:) => null() real(r8) :: tbotmax ! units detector real(r8) :: maskmax ! units detector @@ -55,8 +74,7 @@ module datm_datamode_gefs_mod contains !=============================================================================== - subroutine datm_datamode_gefs_advertise(exportState, fldsexport, & - flds_scalar_name, rc) + subroutine datm_datamode_gefs_advertise(exportState, fldsexport, flds_scalar_name, rc) ! input/output variables type(esmf_State) , intent(inout) :: exportState @@ -101,11 +119,13 @@ subroutine datm_datamode_gefs_advertise(exportState, fldsexport, & end subroutine datm_datamode_gefs_advertise !=============================================================================== - subroutine datm_datamode_gefs_init_pointers(exportState, sdat, rc) + subroutine datm_datamode_gefs_init_pointers(exportState, sdat, logunit, mainproc, rc) ! input/output variables type(ESMF_State) , intent(inout) :: exportState type(shr_strdata_type) , intent(in) :: sdat + integer , intent(in) :: logunit + logical , intent(in) :: mainproc integer , intent(out) :: rc ! local variables @@ -115,7 +135,62 @@ subroutine datm_datamode_gefs_init_pointers(exportState, sdat, rc) rc = ESMF_SUCCESS ! initialize pointers for module level stream arrays - call shr_strdata_get_stream_pointer( sdat, 'Sa_mask' , strm_mask , rc) + call shr_strdata_get_stream_pointer( sdat, 'Sa_mask', strm_Sa_mask , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_mask must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_z', strm_Sa_z , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_z must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_u', strm_Sa_u , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_u must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_v', strm_Sa_v , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_v must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_tbot', strm_Sa_tbot , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_tbot must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_pbot', strm_Sa_pbot , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_pbot must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_shum', strm_Sa_shum , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_shum must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_u10m', strm_Sa_u10m , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_u10m must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_v10m', strm_Sa_v10m , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_v10m must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_t2m', strm_Sa_t2m , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_t2m must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_q2m', strm_Sa_q2m , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_q2m must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_pslv', strm_Sa_pslv , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_pslv must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_rain', strm_Faxa_rain , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_rain must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_snow', strm_Faxa_snow , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_snow must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swvdr', strm_Faxa_swvdr , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swvdr must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swvdf', strm_Faxa_swvdf , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swvdf must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swndr', strm_Faxa_swndr , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swndr must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swndf', strm_Faxa_swndf , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swndf must be associated for gefs datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_lwdn', strm_Faxa_lwdn , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_lwdn must be associated for gefs datamode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get export state pointers @@ -135,15 +210,15 @@ subroutine datm_datamode_gefs_init_pointers(exportState, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_v10m' , fldptr1=Sa_v10m , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Sa_t2m' , fldptr1=Sa_t2m , rc=rc) + call dshr_state_getfldptr(exportState, 'Sa_t2m' , fldptr1=Sa_t2m , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Sa_q2m' , fldptr1=Sa_q2m , rc=rc) + call dshr_state_getfldptr(exportState, 'Sa_q2m' , fldptr1=Sa_q2m , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_pslv' , fldptr1=Sa_pslv , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rain' , fldptr1=Faxa_rain , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Faxa_snow' , fldptr1=Faxa_snow, rc=rc) + call dshr_state_getfldptr(exportState, 'Faxa_snow' , fldptr1=Faxa_snow , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_swvdr' , fldptr1=Faxa_swvdr , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -159,16 +234,15 @@ subroutine datm_datamode_gefs_init_pointers(exportState, sdat, rc) end subroutine datm_datamode_gefs_init_pointers !=============================================================================== - subroutine datm_datamode_gefs_advance(exportstate, mainproc, logunit, mpicom, target_ymd, target_tod, model_calendar, rc) + subroutine datm_datamode_gefs_advance(exportstate, sdat, mainproc, logunit, rc) + use ESMF, only: ESMF_VMGetCurrent, ESMF_VMAllReduce, ESMF_REDUCE_MAX, ESMF_VM + ! input/output variables type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat logical , intent(in) :: mainproc integer , intent(in) :: logunit - integer , intent(in) :: mpicom - integer , intent(in) :: target_ymd - integer , intent(in) :: target_tod - character(len=*) , intent(in) :: model_calendar integer , intent(out) :: rc ! local variables @@ -182,13 +256,14 @@ subroutine datm_datamode_gefs_advance(exportstate, mainproc, logunit, mpicom, ta rc = ESMF_SUCCESS - lsize = size(strm_mask) + lsize = size(strm_Sa_mask) if (first_time) then call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! determine tbotmax (see below for use) - rtmp(1) = maxval(Sa_tbot(:)) + rtmp(1) = maxval(strm_Sa_tbot(:)) call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return tbotmax = rtmp(2) @@ -196,7 +271,7 @@ subroutine datm_datamode_gefs_advance(exportstate, mainproc, logunit, mpicom, ta if (mainproc) write(logunit,*) subname,' tbotmax = ',tbotmax ! determine maskmax (see below for use) - rtmp(1) = maxval(strm_mask(:)) + rtmp(1) = maxval(strm_Sa_mask(:)) call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return maskmax = rtmp(2) @@ -206,8 +281,27 @@ subroutine datm_datamode_gefs_advance(exportstate, mainproc, logunit, mpicom, ta first_time = .false. end if + Sa_z(:) = strm_Sa_z(:) + Sa_u(:) = strm_Sa_u(:) + Sa_v(:) = strm_Sa_v(:) + Sa_shum(:) = strm_Sa_shum(:) + Sa_pbot(:) = strm_Sa_pbot(:) + Sa_u10m(:) = strm_Sa_u10m(:) + Sa_v10m(:) = strm_Sa_v10m(:) + Sa_t2m(:) = strm_Sa_t2m(:) + Sa_q2m(:) = strm_Sa_q2m(:) + Sa_pslv(:) = strm_Sa_pslv(:) + Faxa_lwdn(:) = strm_Faxa_lwdn(:) + Faxa_rain(:) = strm_Faxa_rain(:) + Faxa_snow(:) = strm_Faxa_snow(:) + Faxa_swndr(:) = strm_Faxa_swndr(:) + Faxa_swndf(:) = strm_Faxa_swndf(:) + Faxa_swvdr(:) = strm_Faxa_swvdr(:) + Faxa_swvdf(:) = strm_Faxa_swvdf(:) + + !--- temperature --- do n = 1, lsize - !--- temperature --- + Sa_tbot(n) = strm_Sa_tbot(n) if (tbotmax < 50.0_r8) Sa_tbot(n) = Sa_tbot(n) + tkFrz ! Limit very cold forcing to 180K Sa_tbot(n) = max(180._r8, Sa_tbot(n)) diff --git a/datm/datm_datamode_jra_mod.F90 b/datm/datm_datamode_jra_mod.F90 index d0bcf2e8e..a32973791 100644 --- a/datm/datm_datamode_jra_mod.F90 +++ b/datm/datm_datamode_jra_mod.F90 @@ -1,16 +1,13 @@ module datm_datamode_jra_mod - use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_MeshGet - use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND, operator(/=) + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_MeshGet use NUOPC , only : NUOPC_Advertise - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_log_mod , only : shr_log_error + use shr_kind_mod , only : r8=>shr_kind_r8 use shr_cal_mod , only : shr_cal_date2julian use shr_const_mod , only : shr_const_tkfrz, shr_const_pi, shr_const_rdair use dshr_strdata_mod , only : shr_strdata_get_stream_pointer, shr_strdata_type - use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, dshr_fldbun_regrid, chkerr - use dshr_strdata_mod , only : shr_strdata_type + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none @@ -41,13 +38,21 @@ module datm_datamode_jra_mod real(r8), pointer :: Faxa_swvdr(:) => null() real(r8), pointer :: Faxa_swvdf(:) => null() real(r8), pointer :: Faxa_swnet(:) => null() - - ! stream data - real(r8), pointer :: strm_prec(:) => null() - real(r8), pointer :: strm_swdn(:) => null() - - ! othe module arrays - real(R8), pointer :: yc(:) ! array of model latitudes + real(r8), pointer :: Faxa_swdn(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => null() + + ! stream data pointers + real(r8), pointer :: strm_Sa_tbot(:) => null() + real(r8), pointer :: strm_Sa_pslv(:) => null() + real(r8), pointer :: strm_Sa_u(:) => null() + real(r8), pointer :: strm_Sa_v(:) => null() + real(r8), pointer :: strm_Sa_shum(:) => null() + real(r8), pointer :: strm_Faxa_prec(:) => null() + real(r8), pointer :: strm_Faxa_lwdn(:) => null() + real(r8), pointer :: strm_Faxa_swdn(:) => null() + + ! other module arrays + real(R8), pointer :: yc(:) ! array of model latitudes ! constants real(R8) , parameter :: tKFrz = SHR_CONST_TKFRZ @@ -122,7 +127,6 @@ subroutine datm_datamode_jra_init_pointers(exportState, sdat, rc) ! local variables integer :: n - integer :: lsize integer :: spatialDim ! number of dimension in mesh integer :: numOwnedElements ! size of mesh real(r8), pointer :: ownedElemCoords(:) ! mesh lat and lons @@ -131,8 +135,7 @@ subroutine datm_datamode_jra_init_pointers(exportState, sdat, rc) rc = ESMF_SUCCESS - lsize = sdat%model_lsize - + ! determine yc call ESMF_MeshGet(sdat%model_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) @@ -143,11 +146,7 @@ subroutine datm_datamode_jra_init_pointers(exportState, sdat, rc) yc(n) = ownedElemCoords(2*n) end do - call shr_strdata_get_stream_pointer( sdat, 'Faxa_prec' , strm_prec , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn' , strm_swdn , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + ! initialize export state pointers call dshr_state_getfldptr(exportState, 'Sa_u' , fldptr1=Sa_u , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_v' , fldptr1=Sa_v , rc=rc) @@ -188,12 +187,36 @@ subroutine datm_datamode_jra_init_pointers(exportState, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_swnet' , fldptr1=Faxa_swnet , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swdn' , fldptr1=Faxa_swdn , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! erro check - if (.not. associated(strm_prec) .or. .not. associated(strm_swdn)) then - call shr_log_error(subname//'ERROR: prec and swdn must be in streams for CORE_IAF_JRA', rc=rc) - return - endif + ! initialize stream pointers + call shr_strdata_get_stream_pointer( sdat, 'Faxa_prec' , strm_Faxa_prec , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_prec must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_swdn' , strm_Faxa_swdn , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_swdn must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_lwdn' , strm_Faxa_lwdn , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Faxa_lwdn must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_pslv' , strm_Sa_pslv , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_pslv must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_tbot' , strm_Sa_tbot , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_tbot must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_u' , strm_Sa_u , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_u must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_v' , strm_Sa_v , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_v must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sa_shum' , strm_Sa_shum , requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_shum must be associated for jra datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine datm_datamode_jra_init_pointers @@ -225,9 +248,20 @@ subroutine datm_datamode_jra_advance(exportstate, target_ymd, target_tod, model_ cosfactor = cos((2.0_R8*SHR_CONST_PI*rday)/365 - phs_c0) do n = 1,lsize + + ! Set export fields as copies directly from streams + Sa_pslv(n) = strm_Sa_pslv(n) + Sa_pbot(n) = strm_Sa_pslv(n) + Sa_tbot(n) = strm_Sa_tbot(n) + Sa_ptem(n) = strm_Sa_tbot(n) + Sa_u(n) = strm_Sa_u(n) + Sa_v(n) = strm_Sa_v(n) + Sa_shum(n) = strm_Sa_shum(n) + Faxa_swdn(n) = strm_Faxa_swdn(n) + Faxa_lwdn(n) = strm_Faxa_lwdn(n) + + ! Set Sa_z to a constant Sa_z(n) = 10.0_R8 - Sa_pbot(n) = Sa_pslv(n) - Sa_ptem(n) = Sa_tbot(n) ! Set Sa_u10m and Sa_v10m to Sa_u and Sa_v Sa_u10m(n) = Sa_u(n) @@ -241,21 +275,21 @@ subroutine datm_datamode_jra_advance(exportstate, target_ymd, target_tod, model_ Faxa_snowc(n) = 0.0_R8 if (Sa_tbot(n) < tKFrz ) then ! assign precip to rain/snow components Faxa_rainl(n) = 0.0_R8 - Faxa_snowl(n) = strm_prec(n) + Faxa_snowl(n) = strm_Faxa_prec(n) else - Faxa_rainl(n) = strm_prec(n) + Faxa_rainl(n) = strm_Faxa_prec(n) Faxa_snowl(n) = 0.0_R8 endif ! radiation data - fabricate required swdn components from net swdn - Faxa_swvdr(n) = strm_swdn(n)*(0.28_R8) - Faxa_swndr(n) = strm_swdn(n)*(0.31_R8) - Faxa_swvdf(n) = strm_swdn(n)*(0.24_R8) - Faxa_swndf(n) = strm_swdn(n)*(0.17_R8) + Faxa_swvdr(n) = strm_Faxa_swdn(n)*(0.28_R8) + Faxa_swndr(n) = strm_Faxa_swdn(n)*(0.31_R8) + Faxa_swvdf(n) = strm_Faxa_swdn(n)*(0.24_R8) + Faxa_swndf(n) = strm_Faxa_swdn(n)*(0.17_R8) ! radiation data - compute net short-wave based on LY08 latitudinally-varying albedo avg_alb = ( 0.069 - 0.011*cos(2.0_R8*yc(n)*degtorad ) ) - Faxa_swnet(n) = strm_swdn(n)*(1.0_R8 - avg_alb) + Faxa_swnet(n) = strm_Faxa_swdn(n)*(1.0_R8 - avg_alb) enddo ! lsize end subroutine datm_datamode_jra_advance diff --git a/datm/datm_datamode_simple_mod.F90 b/datm/datm_datamode_simple_mod.F90 index b754b6208..4937f7505 100644 --- a/datm/datm_datamode_simple_mod.F90 +++ b/datm/datm_datamode_simple_mod.F90 @@ -84,6 +84,7 @@ module datm_datamode_simple_mod subroutine datm_datamode_simple_advertise(exportState, fldsexport, flds_scalar_name, & nlfilename, my_task, vm, rc) + use shr_nl_mod, only: shr_nl_find_group_name ! input/output variables diff --git a/dglc/cime_config/testdefs/testlist_dglc.xml b/dglc/cime_config/testdefs/testlist_dglc.xml index 9eb1b6dba..b62d29140 100644 --- a/dglc/cime_config/testdefs/testlist_dglc.xml +++ b/dglc/cime_config/testdefs/testlist_dglc.xml @@ -27,6 +27,15 @@ + + + + + + + + + diff --git a/dglc/dglc_datamode_noevolve_mod.F90 b/dglc/dglc_datamode_noevolve_mod.F90 index 48cf4a17e..c33daa49f 100644 --- a/dglc/dglc_datamode_noevolve_mod.F90 +++ b/dglc/dglc_datamode_noevolve_mod.F90 @@ -25,7 +25,7 @@ module dglc_datamode_noevolve_mod use pio , only : pio_seterrorhandling implicit none - private ! except + private public :: dglc_datamode_noevolve_advertise public :: dglc_datamode_noevolve_init_pointers @@ -72,8 +72,8 @@ module dglc_datamode_noevolve_mod character(len=*), parameter :: field_in_so_t_depth = 'So_t_depth' character(len=*), parameter :: field_in_so_s_depth = 'So_s_depth' - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -204,7 +204,7 @@ subroutine dglc_datamode_noevolve_init_pointers(NStateExp, NstateImp, rc) if (.not. NUOPC_IsConnected(NStateImp(ns), fieldName=field_in_tsrf)) then ! NOTE: the field is connected ONLY if the MED->GLC entry is in the nuopc.runconfig file ! This restriction occurs even if the field was advertised - call shr_log_error(trim(subname)//": MED->GLC must appear in run sequence", rc=rc) + call shr_log_error(subname//": MED->GLC must appear in run sequence", rc=rc) return end if call dshr_state_getfldptr(NStateImp(ns), field_in_tsrf, fldptr1=Sl_tsrf(ns)%ptr, rc=rc) @@ -262,7 +262,6 @@ subroutine dglc_datamode_noevolve_advance(gcomp, pio_subsystem, io_type, io_form real(r8) :: loc_pos_smb(1), Tot_pos_smb(1) ! Sum of positive smb values on each ice sheet for hole-filling real(r8) :: loc_neg_smb(1), Tot_neg_smb(1) ! Sum of negative smb values on each ice sheet for hole-filling real(r8) :: rat ! Ratio of hole-filling flux to apply - character(len=*), parameter :: subname='(dglc_datamode_noevolve_advance): ' !------------------------------------------------------------------------------- @@ -436,7 +435,7 @@ subroutine dglc_datamode_noevolve_advance(gcomp, pio_subsystem, io_type, io_form ! where there is no negative smb. In that case the ice ! runoff is exactly equal to the input smb. if(abs(Tot_pos_smb(1)) >= abs(Tot_neg_smb(1))) then - do ng = 1,lsize + do ng = 1,lsize if (Sg_icemask_coupled_fluxes(ns)%ptr(ng) > 0.d0) then if(Flgl_qice(ns)%ptr(ng) > 0.d0) then rat = Flgl_qice(ns)%ptr(ng)/Tot_pos_smb(1) @@ -465,7 +464,7 @@ subroutine dglc_datamode_noevolve_advance(gcomp, pio_subsystem, io_type, io_form Fgrg_rofi(ns)%ptr(ng) = 0.d0 end if end do - + end if ! More neg or pos smb end do ! Each ice sheet @@ -473,7 +472,7 @@ subroutine dglc_datamode_noevolve_advance(gcomp, pio_subsystem, io_type, io_form ! Set initialized flag initialized_noevolve = .true. - + end subroutine dglc_datamode_noevolve_advance !=============================================================================== @@ -583,7 +582,7 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & if (ChkErr(rc,__LINE__,u_FILE_u)) return call pio_initdecomp(pio_subsystem, pio_double, (/nx_global(ns),ny_global(ns)/), gindex, pio_iodesc(ns)) call pio_write_darray(pioid, varid(ns), pio_iodesc(ns), Fgrg_rofi(ns)%ptr, rcode, fillval=shr_const_spval) - + ! Deallocate gindex deallocate (gindex) end do @@ -627,7 +626,7 @@ subroutine dglc_datamode_noevolve_restart_read(model_meshes, restfilem, rpfile, type(io_desc_t) :: pio_iodesc integer :: rcode integer :: tmp(1) - character(*), parameter :: subName = "(dglc_datamode_noevolve_restart_read) " + character(len=*), parameter :: subName = "(dglc_datamode_noevolve_restart_read) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -639,7 +638,7 @@ subroutine dglc_datamode_noevolve_restart_read(model_meshes, restfilem, rpfile, call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == main_task) then - write(logunit,'(a)') trim(subname)//' restart filename from rpointer '//trim(rpfile) + write(logunit,'(a)') subname//' restart filename from rpointer '//trim(rpfile) open(newunit=nu, file=trim(rpfile), form='formatted') read(nu,'(a)') restfilem close(nu) @@ -650,7 +649,7 @@ subroutine dglc_datamode_noevolve_restart_read(model_meshes, restfilem, rpfile, else ! use namelist already read if (my_task == main_task) then - write(logunit, '(a)') trim(subname)//' restart filenames from namelist ' + write(logunit, '(a)') subname//' restart filenames from namelist ' inquire(file=trim(restfilem), exist=exists) endif endif @@ -658,15 +657,15 @@ subroutine dglc_datamode_noevolve_restart_read(model_meshes, restfilem, rpfile, if(exists) tmp=1 exists = (tmp(1) == 1) if (.not. exists .and. my_task == main_task) then - write(logunit, '(a)') trim(subname)//' file not found, skipping '//trim(restfilem) + write(logunit, '(a)') subname//' file not found, skipping '//trim(restfilem) return end if - + ! Read restart file if (my_task == main_task) then - write(logunit, '(a)') trim(subname)//' reading data model restart '//trim(restfilem) + write(logunit, '(a)') subname//' reading data model restart '//trim(restfilem) end if - + rcode = pio_openfile(pio_subsystem, pioid, io_type, trim(restfilem), pio_nowrite) do ns = 1,num_icesheets diff --git a/dglc/glc_comp_nuopc.F90 b/dglc/glc_comp_nuopc.F90 index 4d87b606e..de2f1f001 100644 --- a/dglc/glc_comp_nuopc.F90 +++ b/dglc/glc_comp_nuopc.F90 @@ -39,9 +39,9 @@ module cdeps_dglc_comp use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance, shr_strdata_init_from_config use dshr_mod , only : dshr_model_initphase, dshr_init, dshr_mesh_init use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_check_restart_alarm - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_realize use nuopc_shr_methods, only : shr_get_rpointer_name, alarmInit + ! Datamode specialized modules use dglc_datamode_noevolve_mod, only : dglc_datamode_noevolve_advertise use dglc_datamode_noevolve_mod, only : dglc_datamode_noevolve_init_pointers @@ -50,7 +50,7 @@ module cdeps_dglc_comp use dglc_datamode_noevolve_mod, only : dglc_datamode_noevolve_restart_write implicit none - private ! except + private public :: SetServices public :: SetVM @@ -65,7 +65,7 @@ module cdeps_dglc_comp ! Private module data !-------------------------------------------------------------------------- - character(*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: nullstr = 'null' integer , parameter :: max_icesheets = 10 ! maximum number of ice sheets for namelist input integer :: num_icesheets ! actual number of ice sheets @@ -102,26 +102,23 @@ module cdeps_dglc_comp character(CX) :: restfilm = nullstr ! model restart file namelist logical :: skip_restart_read = .false. ! true => skip restart read in continuation run logical :: export_all = .false. ! true => export all fields, do not check connected or not + logical :: first_call = .true. ! linked lists type(fldList_type) , pointer :: fldsImport => null() type(fldList_type) , pointer :: fldsExport => null() - type dfields_icesheets_type - type(dfield_type), pointer :: dfields => null() - end type dfields_icesheets_type - type(dfields_icesheets_type), allocatable :: dfields_icesheets(:) ! constants logical :: diagnose_data = .true. integer , parameter :: main_task = 0 ! task number of main task #ifdef CESMCOUPLED - character(*) , parameter :: module_name = "(glc_comp_nuopc)" + character(len=*) , parameter :: module_name = "(glc_comp_nuopc)" #else - character(*) , parameter :: module_name = "(cdeps_dglc_comp)" + character(len=*) , parameter :: module_name = "(cdeps_dglc_comp)" #endif - character(*) , parameter :: modelname = 'dglc' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: modelname = 'dglc' + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -340,7 +337,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS ! Initialize model mesh, restart flag, logunit, model_mask and model_frac - call ESMF_VMLogMemInfo("Entering "//trim(subname)) + call ESMF_VMLogMemInfo("Entering "//subname) call ESMF_TraceRegionEnter('dglc_strdata_init') ! Determine stream filename @@ -392,7 +389,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (my_task == main_task) then inquire(file=trim(model_meshfiles(ns)), exist=exists) if (.not.exists) then - call shr_log_error(trim(subname)//' ERROR: model_meshfile '//trim(model_meshfiles(ns))//' does not exist', rc=rc) + call shr_log_error(subname//' ERROR: model_meshfile '//trim(model_meshfiles(ns))//' does not exist', rc=rc) return end if endif @@ -436,7 +433,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TraceRegionExit('dglc_strdata_init') - call ESMF_VMLogMemInfo("Leaving "//trim(subname)) + call ESMF_VMLogMemInfo("Leaving "//subname) end subroutine InitializeRealize @@ -531,9 +528,8 @@ subroutine dglc_comp_run(gcomp, clock, target_ymd, target_tod, restart_write, va ! local variables character(len=CS) :: cnum integer :: ns ! ice sheet index - logical :: first_time = .true. character(len=CS) :: rpfile - character(*), parameter :: subName = "(dglc_comp_run) " + character(len=*), parameter :: subName = "(dglc_comp_run) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -544,13 +540,7 @@ subroutine dglc_comp_run(gcomp, clock, target_ymd, target_tod, restart_write, va ! First time initialization !-------------------- - if (first_time) then - ! Initialize dfields for all ice sheets - if (trim(datamode) /= 'noevolve') then - call dglc_init_dfields(rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - + if (first_call) then ! Initialize datamode module ponters select case (trim(datamode)) case('noevolve') @@ -568,8 +558,7 @@ subroutine dglc_comp_run(gcomp, clock, target_ymd, target_tod, restart_write, va if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Reset first_time - first_time = .false. + first_call = .false. end if !-------------------- @@ -577,10 +566,6 @@ subroutine dglc_comp_run(gcomp, clock, target_ymd, target_tod, restart_write, va !-------------------- if (trim(datamode) /= 'noevolve') then - if (.not. allocated(dfields_icesheets)) then - allocate(dfields_icesheets(num_icesheets)) - end if - ! Loop over ice sheets do ns = 1,num_icesheets ! Advance data model streams - time and spatially interpolate to model time and grid @@ -589,13 +574,6 @@ subroutine dglc_comp_run(gcomp, clock, target_ymd, target_tod, restart_write, va call shr_strdata_advance(sdat(ns), target_ymd, target_tod, logunit, 'dglc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TraceRegionExit('dglc_strdata_advance') - - ! Copy all fields from streams to export state as default - ! This automatically will update the fields in the export state - call ESMF_TraceRegionEnter('dglc_dfield_copy') - call dshr_dfield_copy(dfields_icesheets(ns)%dfields, sdat(ns), rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('dglc_dfield_copy') end do end if @@ -610,7 +588,6 @@ subroutine dglc_comp_run(gcomp, clock, target_ymd, target_tod, restart_write, va end select ! Write restarts if needed - if (restart_write) then if (trim(datamode) == 'noevolve') then if (my_task == main_task) then @@ -629,55 +606,13 @@ subroutine dglc_comp_run(gcomp, clock, target_ymd, target_tod, restart_write, va if (diagnose_data) then do ns = 1,num_icesheets write(cnum,'(i0)') ns - call dshr_state_diagnose(NStateExp(ns), flds_scalar_name, trim(subname)//':ES_'//trim(cnum), rc=rc) + call dshr_state_diagnose(NStateExp(ns), flds_scalar_name, subname//':ES_'//trim(cnum), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if call ESMF_TraceRegionExit('DGLC_RUN') - contains - - subroutine dglc_init_dfields(rc) - ! ----------------------------- - ! Initialize dfields arrays - ! ----------------------------- - - ! input/output variables - integer, intent(out) :: rc - - ! local variables - integer :: nf, ns - integer :: fieldcount - type(ESMF_Field) :: lfield - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(*), parameter :: subName = "(dglc_init_dfields) " - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Loop over ice sheets - ! Initialize dfields data type (to map streams to export state fields) - ! Create dfields linked list - used for copying stream fields to export state fields - do ns = 1,num_icesheets - call ESMF_StateGet(NStateExp(ns), itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - call ESMF_StateGet(NStateExp(ns), itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do nf = 1, fieldCount - call ESMF_StateGet(NStateExp(ns), itemName=trim(lfieldNameList(nf)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(lfieldnamelist(nf)) /= flds_scalar_name) then - call dshr_dfield_add( dfields_icesheets(ns)%dfields, sdat(ns), & - trim(lfieldnamelist(nf)), trim(lfieldnamelist(nf)), NStateExp(ns), logunit, mainproc, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - end do - deallocate(lfieldnamelist) - end do - end subroutine dglc_init_dfields - end subroutine dglc_comp_run !=============================================================================== @@ -752,7 +687,7 @@ subroutine ModelSetRunClock(gcomp, rc) call alarmInit(mclock, valid_alarm, 'nseconds', opt_n=dtime, alarmname='alarm_valid_inputs', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)// ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & + call ESMF_LogWrite(subname// ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE RETURN diff --git a/dice/dice_datamode_cplhist_mod.F90 b/dice/dice_datamode_cplhist_mod.F90 index 4bc15d225..98c7d84e5 100644 --- a/dice/dice_datamode_cplhist_mod.F90 +++ b/dice/dice_datamode_cplhist_mod.F90 @@ -1,17 +1,21 @@ module dice_datamode_cplhist_mod - use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS + ! The dice cplhist datamode is only used by UFS currently and does not have + ! a corresponding entry in the cime_config/stream_defintition.xml file + + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS + use ESMF , only : ESMF_TraceRegionEnter, ESMF_TraceRegionExit + use ESMF , only : ESMF_State, ESMF_Field use NUOPC , only : NUOPC_Advertise - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_const_mod , only : shr_const_TkFrzsw - use shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl + use shr_const_mod , only : shr_const_TkFrzsw, shr_const_spval use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, chkerr use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add use dshr_mod , only : dshr_restart_read, dshr_restart_write - use dshr_strdata_mod , only : shr_strdata_type + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer implicit none - private ! except + private public :: dice_datamode_cplhist_advertise public :: dice_datamode_cplhist_init_pointers @@ -19,25 +23,43 @@ module dice_datamode_cplhist_mod public :: dice_datamode_cplhist_restart_read public :: dice_datamode_cplhist_restart_write - ! export fields ! ice to atm in CMEPS/mediator/esmFldsExchange_ufs_mod.F90 + + ! export field pointers real(r8), pointer :: Si_ifrac(:) => null() real(r8), pointer :: Si_imask(:) => null() - real(r8), pointer :: Faii_taux(:) => null() - real(r8), pointer :: Faii_tauy(:) => null() - real(r8), pointer :: Faii_lat(:) => null() - real(r8), pointer :: Faii_sen(:) => null() - real(r8), pointer :: Faii_lwup(:) => null() - real(r8), pointer :: Faii_evap(:) => null() - real(r8), pointer :: Si_vice(:) => null() - real(r8), pointer :: Si_vsno(:) => null() + real(r8), pointer :: Faii_taux(:) => null() + real(r8), pointer :: Faii_tauy(:) => null() + real(r8), pointer :: Faii_lat(:) => null() + real(r8), pointer :: Faii_sen(:) => null() + real(r8), pointer :: Faii_lwup(:) => null() + real(r8), pointer :: Faii_evap(:) => null() + real(r8), pointer :: Si_vice(:) => null() + real(r8), pointer :: Si_vsno(:) => null() real(r8), pointer :: Si_t(:) => null() - real(r8), pointer :: Si_avsdr(:) => null() - real(r8), pointer :: Si_avsdf(:) => null() - real(r8), pointer :: Si_anidr(:) => null() - real(r8), pointer :: Si_anidf(:) => null() - - character(*) , parameter :: u_FILE_u = & + real(r8), pointer :: Si_avsdr(:) => null() + real(r8), pointer :: Si_avsdf(:) => null() + real(r8), pointer :: Si_anidr(:) => null() + real(r8), pointer :: Si_anidf(:) => null() + + ! stream field pointers + real(r8), pointer :: strm_Si_ifrac(:) => null() + real(r8), pointer :: strm_Si_imask(:) => null() + real(r8), pointer :: strm_Faii_taux(:) => null() + real(r8), pointer :: strm_Faii_tauy(:) => null() + real(r8), pointer :: strm_Faii_lat(:) => null() + real(r8), pointer :: strm_Faii_sen(:) => null() + real(r8), pointer :: strm_Faii_lwup(:) => null() + real(r8), pointer :: strm_Faii_evap(:) => null() + real(r8), pointer :: strm_Si_vice(:) => null() + real(r8), pointer :: strm_Si_vsno(:) => null() + real(r8), pointer :: strm_Si_t(:) => null() + real(r8), pointer :: strm_Si_avsdr(:) => null() + real(r8), pointer :: strm_Si_avsdf(:) => null() + real(r8), pointer :: strm_Si_anidr(:) => null() + real(r8), pointer :: strm_Si_anidf(:) => null() + + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -87,10 +109,9 @@ subroutine dice_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_ end subroutine dice_datamode_cplhist_advertise !=============================================================================== - subroutine dice_datamode_cplhist_init_pointers(importState, exportState,sdat,rc) + subroutine dice_datamode_cplhist_init_pointers(exportState, sdat, rc) ! input/output variables - type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState type(shr_strdata_type) , intent(in) :: sdat integer , intent(out) :: rc @@ -102,15 +123,15 @@ subroutine dice_datamode_cplhist_init_pointers(importState, exportState,sdat,rc) rc = ESMF_SUCCESS ! initialize pointers to export fields - call dshr_state_getfldptr(exportState, 'Si_ifrac' , fldptr1=Si_ifrac , rc=rc) + call dshr_state_getfldptr(exportState,'Si_ifrac',fldptr1=Si_ifrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Si_imask' , fldptr1=Si_imask , rc=rc) + call dshr_state_getfldptr(exportState,'Si_imask', fldptr1=Si_imask, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Faii_taux' , fldptr1=Faii_taux , allowNullReturn=.true., rc=rc) + call dshr_state_getfldptr(exportState,'Faii_taux', fldptr1=Faii_taux, allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Faii_tauy' , fldptr1=Faii_tauy , allowNullReturn=.true., rc=rc) + call dshr_state_getfldptr(exportState, 'Faii_tauy', fldptr1=Faii_tauy, allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Faii_lat' , fldptr1=Faii_lat , allowNullReturn=.true., rc=rc) + call dshr_state_getfldptr(exportState, 'Faii_lat', fldptr1=Faii_lat, allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faii_sen', fldptr1=Faii_sen, allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -133,15 +154,50 @@ subroutine dice_datamode_cplhist_init_pointers(importState, exportState,sdat,rc) call dshr_state_getfldptr(exportState, 'Si_anidf', fldptr1=Si_anidf, allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !Initialize (e.g., =0)? + ! Set required stream pointer fields + call shr_strdata_get_stream_pointer(sdat,'Si_ifrac', strm_Si_ifrac, & + errmsg=subname//'ERROR: strm_Si_ifrac must be associated for dice cplhist datamode', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat,'Si_imask', strm_Si_imask, & + errmsg=subname//'ERROR: strm_Si_imask must be associated for dice cplhist datamode', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set optional stream pointer fields + call shr_strdata_get_stream_pointer(sdat,'Faii_taux', strm_Faii_taux, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faii_tauy', strm_Faii_tauy, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faii_lat', strm_Faii_lat, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faii_sen', strm_Faii_sen, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faii_lwup', strm_Faii_lwup, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faii_evap', strm_Faii_evap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Si_vice', strm_Si_vice, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Si_vsno', strm_Si_vsno, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Si_avsdr', strm_Si_avsdr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Si_avsdf', strm_Si_avsdf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Si_anidr', strm_Si_anidr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Si_anidf', strm_Si_anidf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Si_t', strm_Si_t, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine dice_datamode_cplhist_init_pointers !=============================================================================== - subroutine dice_datamode_cplhist_advance(rc) + subroutine dice_datamode_cplhist_advance(sdat, rc) ! input/output variables - integer, intent(out) :: rc + type(shr_strdata_type) , intent(in) :: sdat + integer, intent(out) :: rc ! local variables character(len=*), parameter :: subname='(dice_datamode_cplhist_advance): ' @@ -149,9 +205,98 @@ subroutine dice_datamode_cplhist_advance(rc) rc = ESMF_SUCCESS - !Unit conversions, calculations,.... - !Where aice=0, Si_t=0K (as missing value). Interpolation in time between ice that comes or goes then has issues - where(Si_t .LT. 10) Si_t = shr_const_TkFrzsw + Si_imask(:) = strm_Si_imask(:) + Si_ifrac(:) = strm_Si_ifrac(:) + + if (associated(Faii_taux)) then + if (associated(strm_Faii_taux)) then + Faii_taux(:) = strm_Faii_taux(:) + else + Faii_taux(:) = shr_const_spval + end if + end if + if (associated(Faii_tauy)) then + if (associated(strm_Faii_tauy)) then + Faii_tauy(:) = strm_Faii_tauy(:) + else + Faii_tauy(:) = shr_const_spval + end if + end if + if (associated(Faii_lat)) then + if (associated(strm_Faii_lat)) then + Faii_lat(:) = strm_Faii_lat(:) + else + Faii_lat(:) = shr_const_spval + end if + end if + if (associated(Faii_sen)) then + if (associated(strm_Faii_sen)) then + Faii_sen(:) = strm_Faii_sen(:) + else + Faii_sen(:) = shr_const_spval + end if + end if + if (associated(Faii_lwup)) then + if (associated(strm_Faii_lwup)) then + Faii_lwup(:) = strm_Faii_lwup(:) + else + Faii_lwup(:) = shr_const_spval + end if + end if + if (associated(Si_vice)) then + if (associated(strm_Si_vice)) then + Si_vice(:) = strm_Si_vice(:) + else + Si_vice(:) = shr_const_spval + end if + end if + if (associated(Si_vsno)) then + if (associated(strm_Si_vsno)) then + Si_vsno(:) = strm_Si_vsno(:) + else + Si_vsno(:) = shr_const_spval + end if + end if + if (associated(Si_avsdr)) then + if (associated(strm_Si_avsdr)) then + Si_avsdr(:) = strm_Si_avsdr(:) + else + Si_avsdr(:) = shr_const_spval + end if + end if + if (associated(Si_avsdf)) then + if (associated(strm_Si_avsdf)) then + Si_avsdf(:) = strm_Si_avsdf(:) + else + Si_avsdf(:) = shr_const_spval + end if + end if + if (associated(Si_anidr)) then + if (associated(strm_Si_anidr)) then + Si_anidr(:) = strm_Si_anidr(:) + else + Si_anidr(:) = shr_const_spval + end if + end if + if (associated(Si_anidf)) then + if (associated(strm_Si_anidf)) then + Si_anidf(:) = strm_Si_anidf(:) + else + Si_anidf(:) = shr_const_spval + end if + end if + if (associated(Si_t)) then + if (associated(strm_Si_t)) then + Si_t(:) = strm_Si_t(:) + else + Si_t(:) = shr_const_spval + end if + end if + + ! Unit conversions, calculations,.... Where aice=0, Si_t=0K (as + ! missing value). Interpolation in time between ice that comes or + ! goes then has issues + where (Si_t < 10) Si_t = shr_const_TkFrzsw end subroutine dice_datamode_cplhist_advance diff --git a/dice/dice_datamode_ssmi_mod.F90 b/dice/dice_datamode_ssmi_mod.F90 index b484b40ae..970db3863 100644 --- a/dice/dice_datamode_ssmi_mod.F90 +++ b/dice/dice_datamode_ssmi_mod.F90 @@ -14,7 +14,7 @@ module dice_datamode_ssmi_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: dice_datamode_ssmi_advertise public :: dice_datamode_ssmi_init_pointers @@ -25,10 +25,12 @@ module dice_datamode_ssmi_mod ! restart fields real(r8), pointer, public :: water(:) => null() + ! stream pointer + real(r8), pointer :: strm_Si_ifrac(:) => null() + ! internal fields real(r8), pointer :: yc(:) => null() ! mesh lats (degrees) integer , pointer :: imask(:) => null() - !real(r8), pointer:: ifrac0(:) => null() ! export fields real(r8), pointer :: Si_imask(:) => null() @@ -100,8 +102,8 @@ module dice_datamode_ssmi_mod real(r8) , parameter :: latice = shr_const_latice ! latent heat of fusion real(r8) , parameter :: waterMax = 1000.0_r8 ! wrt iFrac comp & frazil ice (kg/m^2) - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -223,8 +225,13 @@ subroutine dice_datamode_ssmi_init_pointers(importState, exportState, sdat, flds lsize = sdat%model_lsize + ! Set pointer to stream data (required) + call shr_strdata_get_stream_pointer( sdat, 'Si_ifrac', strm_Si_ifrac, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Si_ifrac must be associated for ssmi datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set Si_imask (this corresponds to the ocean mask) - call dshr_state_getfldptr(exportState, fldname='Si_imask' , fldptr1=Si_imask , rc=rc) + call dshr_state_getfldptr(exportState, fldname='Si_imask', fldptr1=Si_imask, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(imask(sdat%model_lsize)) call ESMF_MeshGet(sdat%model_mesh, numOwnedElements=numOwnedElements, elementdistGrid=distGrid, rc=rc) @@ -395,6 +402,8 @@ subroutine dice_datamode_ssmi_advance(exportState, importState, cosarg, flds_i2o rc = ESMF_SUCCESS + Si_ifrac(:) = strm_Si_ifrac(:) + lsize = size(Si_ifrac) if (first_time) then @@ -411,7 +420,6 @@ subroutine dice_datamode_ssmi_advance(exportState, importState, cosarg, flds_i2o water(n) = 0.0_r8 end if end do - ! iFrac0 = iFrac ! previous step's ice fraction endif ! reset first time @@ -537,8 +545,6 @@ subroutine dice_datamode_ssmi_advance(exportState, importState, cosarg, flds_i2o !--- salt flux --- Fioi_salt(n) = 0.0_r8 end if - ! !--- save ifrac for next timestep - ! iFrac0(n) = Si_ifrac(n) end do ! Compute outgoing aerosol fluxes @@ -566,7 +572,7 @@ end subroutine dice_datamode_ssmi_advance !=============================================================================== subroutine dice_datamode_ssmi_restart_write(rpfile, case_name, inst_suffix, ymd, tod, & - logunit, my_task, sdat) + logunit, my_task, sdat, rc) ! input/output variables character(len=*) , intent(in) :: rpfile @@ -577,8 +583,11 @@ subroutine dice_datamode_ssmi_restart_write(rpfile, case_name, inst_suffix, ymd, integer , intent(in) :: logunit integer , intent(in) :: my_task type(shr_strdata_type) , intent(inout) :: sdat + integer , intent(out) :: rc !------------------------------------------------------------------------------- - integer :: rc + + rc = ESMF_SUCCESS + call dshr_restart_write(rpfile, case_name, 'dice', inst_suffix, ymd, tod, & logunit, my_task, sdat, rc, fld=water, fldname='water') if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -586,7 +595,7 @@ subroutine dice_datamode_ssmi_restart_write(rpfile, case_name, inst_suffix, ymd, end subroutine dice_datamode_ssmi_restart_write !=============================================================================== - subroutine dice_datamode_ssmi_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat) + subroutine dice_datamode_ssmi_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat, rc) ! input/output arguments character(len=*) , intent(inout) :: rest_filem @@ -595,13 +604,16 @@ subroutine dice_datamode_ssmi_restart_read(rest_filem, rpfile, logunit, my_task, integer , intent(in) :: my_task integer , intent(in) :: mpicom type(shr_strdata_type) , intent(inout) :: sdat + integer , intent(out) :: rc !------------------------------------------------------------------------------- - integer :: rc + + rc = ESMF_SUCCESS + ! allocate module memory for restart fields that are read in allocate(water(sdat%model_lsize)) ! read restart - call dshr_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat, rc,& + call dshr_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat, rc, & fld=water, fldname='water') if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/dice/dice_flux_atmice_mod.F90 b/dice/dice_flux_atmice_mod.F90 index 4d660765b..7ecdb5a1c 100644 --- a/dice/dice_flux_atmice_mod.F90 +++ b/dice/dice_flux_atmice_mod.F90 @@ -113,8 +113,8 @@ subroutine dice_flux_atmice( & psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) !--- formats ---------------------------------------- - character(*),parameter :: F01 = "('(dice_flux_atmIce) ',a, i7,2x,d21.14)" - character(*),parameter :: subName = "(dice_flux_atmIce) " + character(len=*),parameter :: F01 = "('(dice_flux_atmIce) ',a, i7,2x,d21.14)" + character(len=*),parameter :: subName = "(dice_flux_atmIce) " !------------------------------------------------------------------------------- lsize = size(tbot) diff --git a/dice/ice_comp_nuopc.F90 b/dice/ice_comp_nuopc.F90 index 22f3658ce..b3dd1dbe7 100644 --- a/dice/ice_comp_nuopc.F90 +++ b/dice/ice_comp_nuopc.F90 @@ -33,7 +33,6 @@ module cdeps_dice_comp use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_log_clock_advance use dshr_methods_mod , only : dshr_state_diagnose, chkerr, memcheck use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_init_from_config, shr_strdata_advance - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add, dshr_fldlist_realize use dice_datamode_ssmi_mod , only : dice_datamode_ssmi_advertise @@ -49,7 +48,7 @@ module cdeps_dice_comp use dice_datamode_cplhist_mod , only : dice_datamode_cplhist_restart_write implicit none - private ! except + private public :: SetServices public :: SetVM @@ -76,7 +75,7 @@ module cdeps_dice_comp integer :: logunit ! logging unit number logical :: restart_read ! start from restart character(CL) :: case_name ! case name - character(*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: nullstr = 'null' ! dice_in namelist input character(CX) :: streamfilename = nullstr ! filename to obtain stream info from @@ -92,29 +91,30 @@ module cdeps_dice_comp integer :: nx_global integer :: ny_global logical :: export_all = .false. ! true => export all fields, do not check connected or not + logical :: first_call = .true. ! linked lists type(fldList_type) , pointer :: fldsImport => null() type(fldList_type) , pointer :: fldsExport => null() - type(dfield_type) , pointer :: dfields => null() ! model mask and model fraction real(r8), pointer :: model_frac(:) => null() integer , pointer :: model_mask(:) => null() logical :: valid_ice = .true. ! used for single column logic (ocn mask > 0) + ! constants logical :: flds_i2o_per_cat ! .true. if select per ice thickness real(R8) :: dt ! real model timestep logical :: diagnose_data = .true. - integer , parameter :: main_task=0 ! task number of main task + integer , parameter :: main_task=0 ! task number of main task #ifdef CESMCOUPLED - character(*) , parameter :: modName = "(ice_comp_nuopc)" + character(len=*) , parameter :: modName = "(ice_comp_nuopc)" #else - character(*) , parameter :: modName = "(cdeps_dice_comp)" + character(len=*) , parameter :: modName = "(cdeps_dice_comp)" #endif - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -183,10 +183,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) real(r8) :: rbcasttmp(3) type(ESMF_VM) :: vm character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - character(*) ,parameter :: F00 = "('(" // trim(modName) // ") ',8a)" - character(*) ,parameter :: F01 = "('(" // trim(modName) // ") ',a,2x,i8)" - character(*) ,parameter :: F02 = "('(" // trim(modName) // ") ',a,l6)" - character(*) ,parameter :: F03 = "('(" // trim(modName) // ") ',a,d13.5)" !------------------------------------------------------------------------------- namelist / dice_nml / datamode, & @@ -210,7 +206,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) mainproc = (my_task == main_task) ! Read dice_nml from nlfilename - if (my_task == main_task) then + if (mainproc) then nlfilename = "dice_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") call shr_nl_find_group_name(nu, 'dice_nml', status=ierr) @@ -224,17 +220,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if ! write namelist input to standard out - write(logunit,F00)' datamode = ',trim(datamode) - write(logunit,F00)' model_meshfile = ',trim(model_meshfile) - write(logunit,F00)' model_maskfile = ',trim(model_maskfile) - write(logunit,F01)' nx_global = ',nx_global - write(logunit,F01)' ny_global = ',ny_global - write(logunit,F03)' flux_swpf = ',flux_swpf - write(logunit,F03)' flux_Qmin = ',flux_Qmin - write(logunit,F02)' flux_Qacc = ',flux_Qacc - write(logunit,F03)' flux_Qacc0 = ',flux_Qacc0 - write(logunit,F00)' restfilm = ',trim(restfilm) - write(logunit,F02)' export_all = ',export_all + write(logunit,'(3a)') subname,' datamode = ',trim(datamode) + write(logunit,'(3a)') subname,' model_meshfile = ',trim(model_meshfile) + write(logunit,'(3a)') subname,' model_maskfile = ',trim(model_maskfile) + write(logunit,'(2a,i0)') subname,' nx_global = ',nx_global + write(logunit,'(2a,i0)') subname,' ny_global = ',ny_global + write(logunit,'(2a,d13.5)') subname,' flux_swpf = ',flux_swpf + write(logunit,'(2a,d13.5)') subname,' flux_Qmin = ',flux_Qmin + write(logunit,'(2a,l6)') subname,' flux_Qacc = ',flux_Qacc + write(logunit,'(2a,d13.5)') subname,' flux_Qacc0 = ',flux_Qacc0 + write(logunit,'(3a)') subname,' restfilm = ',trim(restfilm) + write(logunit,'(2a,l6)') subname,' export_all = ',export_all + bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global @@ -272,23 +269,20 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) flux_Qacc0 = rbcasttmp(3) ! Validate datamode - if ( trim(datamode) == 'ssmi' .or. trim(datamode) == 'ssmi_iaf' .or. trim(datamode) == 'cplhist') then - if (my_task == main_task) write(logunit,*) ' dice datamode = ',trim(datamode) - else + select case (trim(datamode)) + case('ssmi','ssmi_iaf','cplhist') + if (mainproc) write(logunit,'(3a)') subname,' dice datamode = ',trim(datamode) + case default call shr_log_error(' ERROR illegal dice datamode = '//trim(datamode), rc=rc) return - endif + end select ! Advertise import and export fields - if ( trim(datamode) == 'ssmi' .or. trim(datamode) == 'ssmi_iaf') then - call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_i2o_per_cat ! module variable - endif - - !datamode already validated select case (trim(datamode)) case('ssmi','ssmi_iaf') + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_i2o_per_cat ! module variable call dice_datamode_ssmi_advertise(importState, exportState, fldsimport, fldsexport, & flds_scalar_name, flds_i2o_per_cat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -409,6 +403,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -489,9 +484,8 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod integer , intent(out) :: rc ! local variables - logical :: first_time = .true. character(len=CL) :: rpfile - character(*), parameter :: subName = "(dice_comp_run) " + character(len=*), parameter :: subName = "(dice_comp_run) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -502,18 +496,7 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod ! first time initialization !-------------------- - if (first_time) then - - ! Initialize dfields with export state data that has corresponding stream fieldi - select case (trim(datamode)) - case('ssmi','ssmi_iaf') - call dshr_dfield_add(dfields, sdat, state_fld='Si_ifrac', strm_fld='Si_ifrac', & - state=exportState, logunit=logunit, mainproc=mainproc, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - case('cplhist') - call dice_init_dfields(importState, exportState, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end select + if (first_call) then ! Initialize datamode module ponters select case (trim(datamode)) @@ -521,7 +504,7 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod call dice_datamode_ssmi_init_pointers(importState, exportState, sdat, flds_i2o_per_cat, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return case('cplhist') - call dice_datamode_cplhist_init_pointers(importState,exportState,sdat,rc) + call dice_datamode_cplhist_init_pointers(exportState, sdat, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end select @@ -531,14 +514,14 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod if (ChkErr(rc,__LINE__,u_FILE_u)) return select case (trim(datamode)) case('ssmi', 'ssmi_iaf') - call dice_datamode_ssmi_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat) + call dice_datamode_ssmi_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return case('cplhist') - call dice_datamode_cplhist_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat) + call dice_datamode_cplhist_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat) end select end if - ! reset first_time - first_time = .false. + first_call = .false. end if !-------------------- @@ -551,17 +534,6 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod call shr_strdata_advance(sdat, target_ymd, target_tod, logunit, 'dice', rc=rc) call ESMF_TraceRegionExit('dice_strdata_advance') - !-------------------- - ! copy all fields from streams to export state as default - !-------------------- - - ! This automatically will update the fields in the export state - - call ESMF_TraceRegionEnter('dice_dfield_copy') - call dshr_dfield_copy(dfields, sdat, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('dice_dfield_copy') - !------------------------------------------------- ! Determine data model behavior based on the mode !------------------------------------------------- @@ -575,8 +547,8 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod flux_swpf, flux_Qmin, flux_Qacc, flux_Qacc0, dt, logunit, restart_read, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case ('cplhist') - call dice_datamode_cplhist_advance(rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dice_datamode_cplhist_advance(sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end select ! Write restarts if needed @@ -586,7 +558,8 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod select case (trim(datamode)) case('ssmi', 'ssmi_iaf') call dice_datamode_ssmi_restart_write(rpfile, case_name, inst_suffix, target_ymd, target_tod, & - logunit, my_task, sdat) + logunit, my_task, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return case ('cplhist') call dice_datamode_cplhist_restart_write(rpfile, case_name, inst_suffix, target_ymd, target_tod, & logunit, my_task, sdat) @@ -602,46 +575,6 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod call ESMF_TraceRegionExit('dice_datamode') call ESMF_TraceRegionExit('DICE_RUN') - contains - subroutine dice_init_dfields(importState, exportState, rc) - ! ----------------------------- - ! Initialize dfields arrays - ! ----------------------------- - - ! input/output variables - type(ESMF_State) , intent(inout) :: importState - type(ESMF_State) , intent(inout) :: exportState - integer , intent(out) :: rc - - ! local variables - integer :: n - integer :: fieldcount - type(ESMF_Field) :: lfield - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(*), parameter :: subName = "(dice_init_dfields) " - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Initialize dfields data type (to map streams to export state fields) - ! Create dfields linked list - used for copying stream fields to export - ! state fields - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, fieldCount - call ESMF_StateGet(exportState, itemName=trim(lfieldNameList(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(lfieldnamelist(n)) /= flds_scalar_name) then - call dshr_dfield_add( dfields, sdat, trim(lfieldnamelist(n)), trim(lfieldnamelist(n)), exportState, & - logunit, mainproc, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - end do - end subroutine dice_init_dfields - end subroutine dice_comp_run !=============================================================================== @@ -651,7 +584,7 @@ subroutine ModelFinalize(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (my_task == main_task) then + if (mainproc) then write(logunit,*) write(logunit,*) 'dice : end of main integration loop' write(logunit,*) diff --git a/dlnd/dlnd_datamode_glc_forcing_mod.F90 b/dlnd/dlnd_datamode_glc_forcing_mod.F90 index 06693cf45..b1396d4c4 100644 --- a/dlnd/dlnd_datamode_glc_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_glc_forcing_mod.F90 @@ -12,7 +12,7 @@ module dlnd_datamode_glc_forcing_mod use glc_elevclass_mod, only : glc_elevclass_as_string, glc_elevclass_init implicit none - private ! except + private public :: dlnd_datamode_glc_forcing_advertise public :: dlnd_datamode_glc_forcing_init_pointers @@ -26,7 +26,7 @@ module dlnd_datamode_glc_forcing_mod ! stream pointers (1d) type, public :: stream_pointer_type - real(r8), pointer :: strm_ptr(:) => null() + real(r8), pointer :: ptr(:) => null() end type stream_pointer_type type(stream_pointer_type), allocatable :: strm_Sl_tsrf_elev(:) type(stream_pointer_type), allocatable :: strm_Sl_topo_elev(:) @@ -34,8 +34,8 @@ module dlnd_datamode_glc_forcing_mod integer :: glc_nec - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'null' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -147,18 +147,18 @@ subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac write(nec_str,'(i0)') ng end if strm_fld = 'Sl_tsrf_elev'//trim(nec_str) - call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_tsrf_elev(ng)%strm_ptr, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_tsrf_elev(ng)%ptr, requirePointer=.true., & + errmsg=subname//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return strm_fld = 'Sl_topo_elev'//trim(nec_str) - call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_topo_elev(ng)%strm_ptr, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_topo_elev(ng)%ptr, requirePointer=.true., & + errmsg=subname//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return strm_fld = 'Flgl_qice_elev'//trim(nec_str) - call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Flgl_qice_elev(ng)%strm_ptr, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Flgl_qice_elev(ng)%ptr, requirePointer=.true., & + errmsg=subname//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -180,7 +180,7 @@ subroutine dlnd_datamode_glc_forcing_advance() if (lfrac(ni) == 0._r8) then Sl_tsrf_elev(ng,ni) = SHR_CONST_SPVAL else - Sl_tsrf_elev(ng,ni) = strm_Sl_tsrf_elev(ng)%strm_ptr(ni) + Sl_tsrf_elev(ng,ni) = strm_Sl_tsrf_elev(ng)%ptr(ni) end if end do @@ -188,7 +188,7 @@ subroutine dlnd_datamode_glc_forcing_advance() if (lfrac(ni) == 0._r8) then Sl_topo_elev(ng,ni) = SHR_CONST_SPVAL else - Sl_topo_elev(ng,ni) = strm_Sl_topo_elev(ng)%strm_ptr(ni) + Sl_topo_elev(ng,ni) = strm_Sl_topo_elev(ng)%ptr(ni) end if end do @@ -196,7 +196,7 @@ subroutine dlnd_datamode_glc_forcing_advance() if (lfrac(ni) == 0._r8) then Flgl_qice_elev(ng,ni) = SHR_CONST_SPVAL else - Flgl_qice_elev(ng,ni) = strm_Flgl_qice_elev(ng)%strm_ptr(ni) + Flgl_qice_elev(ng,ni) = strm_Flgl_qice_elev(ng)%ptr(ni) end if end do end do elev_class_loop diff --git a/dlnd/dlnd_datamode_rof_forcing_mod.F90 b/dlnd/dlnd_datamode_rof_forcing_mod.F90 index e6c4873fe..8fd5d54af 100644 --- a/dlnd/dlnd_datamode_rof_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_rof_forcing_mod.F90 @@ -1,9 +1,8 @@ module dlnd_datamode_rof_forcing_mod use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_State - use ESMF , only : ESMF_StateItem_Flag use NUOPC , only : NUOPC_Advertise - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_kind_mod , only : r8=>shr_kind_r8, cs=>shr_kind_cs use shr_string_mod , only : shr_string_listGetNum, shr_string_listGetName use shr_log_mod , only : shr_log_error use shr_const_mod , only : SHR_CONST_SPVAL @@ -14,7 +13,7 @@ module dlnd_datamode_rof_forcing_mod use shr_strconvert_mod , only : toString implicit none - private ! except + private public :: dlnd_datamode_rof_forcing_advertise public :: dlnd_datamode_rof_forcing_init_pointers @@ -32,7 +31,7 @@ module dlnd_datamode_rof_forcing_mod ! stream field pointers type, public :: stream_pointer_type - real(r8), pointer :: strm_ptr(:) => null() + real(r8), pointer :: ptr(:) => null() end type stream_pointer_type type(stream_pointer_type), allocatable :: strm_Flrl_rofsur_nonh2o_2d(:) ! 2dple nonh2o tracers @@ -49,8 +48,8 @@ module dlnd_datamode_rof_forcing_mod ! for generating the strm_fld field names integer, parameter :: ntracers_nonh2o_max = 99 - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'null' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -184,31 +183,31 @@ subroutine dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, model_frac do nf = 1,ntracers_nonh2o write(nchar,'(i2.2)') nf strm_fld = trim('Flrl_rofsur_nonh2o') // trim(nchar) - call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Flrl_rofsur_nonh2o_2d(nf)%strm_ptr, & + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Flrl_rofsur_nonh2o_2d(nf)%ptr, & requirePointer=.true., & - errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//& + errmsg=subname//'ERROR: '//trim(strm_fld)//& ' must be associated for dlnd rof_forcing datamode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do else if (ntracers_nonh2o == 1) then call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofsur_nonh2o' , strm_Flrl_rofsur_nonh2o_1d, & requirePointer=.true., & - errmsg=trim(subname)//'ERROR: strm_Flrl_rofsur_1d '// & + errmsg=subname//'ERROR: strm_Flrl_rofsur_1d '// & ' must be associated for dlnd rof_forcing mode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofsur' , strm_Flrl_rofsur, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: strm_Flrl_rofsur be associated for dlnd rof_forcing mode', rc=rc) + errmsg=subname//'ERROR: strm_Flrl_rofsur be associated for dlnd rof_forcing mode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofsub' , strm_Flrl_rofsub, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: strm_Flrl_rofsub be associated for dlnd rof_forcing mode', rc=rc) + errmsg=subname//'ERROR: strm_Flrl_rofsub be associated for dlnd rof_forcing mode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofgwl' , strm_Flrl_rofgwl, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: strm_Flrl_rofgwl be associated for dlnd rof_forcing mode', rc=rc) + errmsg=subname//'ERROR: strm_Flrl_rofgwl be associated for dlnd rof_forcing mode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofi' , strm_Flrl_rofi, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: strm_Flrl_rofi be associated for dlnd rof_forcing mode', rc=rc) + errmsg=subname//'ERROR: strm_Flrl_rofi be associated for dlnd rof_forcing mode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! optional stream field pointer @@ -232,7 +231,7 @@ subroutine dlnd_datamode_rof_forcing_advance() if (lfrac(ni) == 0._r8) then Flrl_rofsur_nonh2o_2d(nf,ni) = SHR_CONST_SPVAL else - Flrl_rofsur_nonh2o_2d(nf,ni) = strm_Flrl_rofsur_nonh2o_2d(nf)%strm_ptr(ni) + Flrl_rofsur_nonh2o_2d(nf,ni) = strm_Flrl_rofsur_nonh2o_2d(nf)%ptr(ni) end if end do end do diff --git a/dlnd/lnd_comp_nuopc.F90 b/dlnd/lnd_comp_nuopc.F90 index 5f9abfc3e..7a7d4d049 100644 --- a/dlnd/lnd_comp_nuopc.F90 +++ b/dlnd/lnd_comp_nuopc.F90 @@ -7,6 +7,7 @@ module cdeps_dlnd_comp !---------------------------------------------------------------------------- ! This is the NUOPC cap for DLND !---------------------------------------------------------------------------- + use ESMF , only : ESMF_VM, ESMF_VMBroadcast, ESMF_GridCompGet use ESMF , only : ESMF_Mesh, ESMF_GridComp, ESMF_SUCCESS, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogWrite, ESMF_TraceRegionExit, ESMF_TraceRegionEnter @@ -45,7 +46,7 @@ module cdeps_dlnd_comp use nuopc_shr_methods , only : shr_get_rpointer_name implicit none - private ! except + private public :: SetServices public :: SetVM @@ -73,7 +74,7 @@ module cdeps_dlnd_comp integer :: logunit ! logging unit number logical :: restart_read ! start from restart character(CL) :: case_name ! case name - character(*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: nullstr = 'null' ! dlnd_in namelist input character(CL) :: dataMode = nullstr ! flags physics options wrt input data @@ -86,6 +87,7 @@ module cdeps_dlnd_comp integer :: ny_global ! global ny dimension of model mesh logical :: skip_restart_read = .false. ! true => skip restart read in continuation logical :: export_all = .false. ! true => export all fields, do not check connected or not + logical :: first_call = .true. ! linked lists type(fldList_type) , pointer :: fldsExport => null() @@ -98,11 +100,12 @@ module cdeps_dlnd_comp logical :: diagnose_data = .true. integer , parameter :: main_task=0 ! task number of main task #ifdef CESMCOUPLED - character(*) , parameter :: modName = "(lnd_comp_nuopc)" + character(len=*) , parameter :: modName = "(lnd_comp_nuopc)" #else - character(*) , parameter :: modName = "(cdeps_dlnd_comp)" + character(len=*) , parameter :: modName = "(cdeps_dlnd_comp)" #endif - character(*) , parameter :: u_FILE_u = & + + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -194,7 +197,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) nlfilename = "dlnd_in"//trim(inst_suffix) open (newunit=nu, file=trim(nlfilename), status="old", action="read") call shr_nl_find_group_name(nu, 'dlnd_nml', status=ierr) - read (nu,nml=dlnd_nml,iostat=ierr) close(nu) if (ierr > 0) then @@ -202,6 +204,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_log_error(subName//': namelist read error '//trim(nlfilename), rc=rc) return end if + bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global @@ -222,6 +225,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nx_global = bcasttmp(1) ny_global = bcasttmp(2) skip_restart_read = (bcasttmp(3) == 1) @@ -229,34 +233,34 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! write namelist input to standard out if (my_task == main_task) then - write(logunit,'(3a)') trim(subname),' model_meshfile = ',trim(model_meshfile) - write(logunit,'(3a)') trim(subname),' model_maskfile = ',trim(model_maskfile) - write(logunit,'(3a)') trim(subname),' datamode = ',datamode - write(logunit,'(2a,i0)') trim(subname),' nx_global = ',nx_global - write(logunit,'(2a,i0)') trim(subname),' ny_global = ',ny_global - write(logunit,'(3a)') trim(subname),' restfilm = ',trim(restfilm) - write(logunit,'(2a,l6)') trim(subname),' skip_restart_read = ',skip_restart_read - write(logunit,'(2a,l6)') trim(subname),' export_all = ',export_all + write(logunit,'(3a)') subname,' model_meshfile = ',trim(model_meshfile) + write(logunit,'(3a)') subname,' model_maskfile = ',trim(model_maskfile) + write(logunit,'(3a)') subname,' datamode = ',datamode + write(logunit,'(2a,i0)') subname,' nx_global = ',nx_global + write(logunit,'(2a,i0)') subname,' ny_global = ',ny_global + write(logunit,'(3a)') subname,' restfilm = ',trim(restfilm) + write(logunit,'(2a,l6)') subname,' skip_restart_read = ',skip_restart_read + write(logunit,'(2a,l6)') subname,' export_all = ',export_all endif ! Validate sdat datamode - if ( trim(datamode) == 'glc_forcing_mct' .or. & - trim(datamode) == 'glc_forcing' .or. & - trim(datamode) == 'rof_forcing') then - if (my_task == main_task) write(logunit,*) 'dlnd datamode = ',trim(datamode) - else + select case (trim(datamode)) + case('glc_forcing_mct','glc_forcing','rof_forcing') + if (my_task == main_task) write(logunit,'(3a)') subname,' dlnd datamode = ',trim(datamode) + case default call shr_log_error(' ERROR illegal dlnd datamode = '//trim(datamode), rc=rc) return - end if + end select ! Advertise the export fields - if (trim(datamode) == 'glc_forcing' .or. trim(datamode) == 'glc_forcing_mct') then + select case (trim(datamode)) + case('glc_forcing_mct','glc_forcing') call dlnd_datamode_glc_forcing_advertise(gcomp, exportState, fldsExport, flds_scalar_name, logunit, mainproc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'rof_forcing') then + case('rof_forcing') call dlnd_datamode_rof_forcing_advertise(exportState, fldsExport, flds_scalar_name, logunit, mainproc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + end select end subroutine InitializeAdvertise @@ -409,8 +413,8 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - character(*), parameter :: F00 = "('(dlnd_comp_final) ',8a)" - character(*), parameter :: F91 = "('(dlnd_comp_final) ',73('-'))" + character(len=*), parameter :: F00 = "('(dlnd_comp_final) ',8a)" + character(len=*), parameter :: F91 = "('(dlnd_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !------------------------------------------------------------------------------- @@ -438,9 +442,6 @@ subroutine dlnd_comp_run(importState, exportState, target_ymd, target_tod, rc) integer , intent(in) :: target_ymd ! model date integer , intent(in) :: target_tod ! model sec into model date integer , intent(out) :: rc - - ! local variables - logical :: first_time = .true. !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -451,7 +452,7 @@ subroutine dlnd_comp_run(importState, exportState, target_ymd, target_tod, rc) ! First time initialization !-------------------- - if (first_time) then + if (first_call) then ! Initialize datamode export state and stream pointers select case (trim(datamode)) case('glc_forcing_mct','glc_forcing') @@ -465,7 +466,7 @@ subroutine dlnd_comp_run(importState, exportState, target_ymd, target_tod, rc) return end select - first_time = .false. + first_call = .false. end if !-------------------- diff --git a/dlnd/stream_definition_dlnd.xml b/dlnd/stream_definition_dlnd.xml deleted file mode 100644 index 0de561caf..000000000 --- a/dlnd/stream_definition_dlnd.xml +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - $LND_DOMAIN_MESH - - - - $DLND_DIR/$DLND_CASE.cpl.hl2x1yr_glc.%y-01-01.nc - - - lndImp_Sl_tsrf_elev%glc Sl_tsrf_elev%glc - lndImp_Sl_topo_elev%glc Sl_topo_elev%glc - lndImp_Flgl_qice_elev%glc Flgl_qice_elev%glc - - null - - bilinear - - null - $DLND_YR_ALIGN - $DLND_YR_START - $DLND_YR_END - 0 - - lower - - - cycle - - - 1.5 - - single - - - - - $LND_DOMAIN_MESH - - - TBD - - - lndImp_Flrl_rofsur_nonh2o%rof Flrl_rofsur_nonh2o%rof - lndImp_Flrl_rofsur Flrl_rofsur - lndImp_Flrl_rofsub Flrl_rofsub - lndImp_Flrl_rofgwl Flrl_rofgwl - lndImp_Flrl_rofi Flrl_rofi - - null - - bilinear - - null - $DLND_YR_ALIGN - $DLND_YR_START - $DLND_YR_END - 0 - - lower - - - cycle - - - 1.5 - - single - - - diff --git a/doc/source/docn.rst b/doc/source/docn.rst index d10852a6d..e16fffc38 100644 --- a/doc/source/docn.rst +++ b/doc/source/docn.rst @@ -21,10 +21,11 @@ operations need to be done by DOCN on *ALL* of the streams in the with a DOCN source file that carries out these operations and these are listed in parentheses next to the mode name. -sstdata and sst_aquap_file (``docn_datamode_copyall_mod.F90``) +sstdata and sst_aquap_file (``docn_datamode_sstdata_mod.F90``) - `sstdata` and `sst_aquap_file` modes assume that the only field in the input stream is SST. It also assumes the SST is in Celsius and must be converted to Kelvin. All other fields are set to zero. + `ssdata` mode includes both climatological and interannyal varying data. .. note:: Normally the ice fraction data is found in the same data files that @@ -32,30 +33,50 @@ sstdata and sst_aquap_file (``docn_datamode_copyall_mod.F90``) the same file because the SST and ice fraction data are derived from the same observational data sets and are consistent with each other. -iaf (``docn_datamode_iaf_mod.F90``) - - iaf is the interannually varying version of `sstdata`. - The ocean salinity is set to a constant reference salinity value. - All other fields other than SST and ocean salinity are set to zero. - sst_aquap_analytic, sst_aquap_constant and sst_aquap[1-10] (``docn_datamode_aquaplanet_mod.F90``) - This mode creates analytic sea surface temperature. In case of using `sst_aquap[1-10]` data mode, an additional information (`sst_option`) is extracted from the data mode to change the behaviour of the data mode such as the method of calculation of sea surface temperature. +multilev (``docn_multilev_mod.F90``) + - This mode reads in multi-level ocean forcing data for temperature + and salinity. The input data can be on any set of vertical levels, + but the output data is then remapped to a fixed set of 30 vertical + levels. This mode is used to force the prognostic land-ice + component (in this case CISM) with ocean forcing. + +multilev_cplhist (``docn_multilev_cplhist_mod.F90``) + - This mode reads in multi-level ocean forcing data for temperature + and salinity. The input data is assumed to be on 30 vertical + levels and it is the responsibility of the prognostic ocean + component to map the data to these levels before sending the data + to the mediator. This mode is used to force the prognostic + land-ice component (in this case CISM) with ocean forcing. + +multilev (``docn_multilev_sstdata_mod.F90``) + - This mode reads in multi-level ocean forcing data for temperature + and salinity (to be sent to a land-ice component, e.g. CISM) as + well as sst data (to be sent to a atmosphere component, + e.g. CAM). The ocean input data can be on any set of vertical + levels, but the output data is then remapped to a fixed set of 30 + vertical levels. The sst data is handled the same way as in + sstdata mode. + som and som_aquap (``docn_datamode_som_mod.F90``) - som ("slab ocean model") mode is a prognostic mode. This mode computes a prognostic sea surface temperature and a freeze/melt potential (surface Q-flux) used by the sea ice model. This - calculation requires an external SOM forcing data file that includes - ocean mixed layer depths and bottom-of-the-slab Q-fluxes. - Scientifically appropriate bottom-of-the-slab Q-fluxes are normally - ocean resolution dependent and are derived from the ocean model output - of a fully coupled CESM run. Note that while this mode runs out of - the box, the default SOM forcing file is not scientifically - appropriate and is provided for testing and development purposes only. - Users must create scientifically appropriate data for their particular - application. A tool is available to derive valid SOM forcing. + calculation requires an external SOM forcing data file that + includes ocean mixed layer depths and bottom-of-the-slab Q-fluxes. + Scientifically appropriate bottom-of-the-slab Q-fluxes are + normally ocean resolution dependent and are derived from the ocean + model output of a fully coupled (e.g. CESM or NorESM) run. Note + that while this mode runs out of the box, the default SOM forcing + file is not scientifically appropriate and is provided for testing + and development purposes only. Users must create scientifically + appropriate data for their particular application. A tool is + available to derive valid SOM forcing. The only difference between `som` and `som_aquap` is that `som_aquap` limits sea surface temperature based on calculated value of freezing diff --git a/docn/CMakeLists.txt b/docn/CMakeLists.txt index ab12861cd..86172c525 100644 --- a/docn/CMakeLists.txt +++ b/docn/CMakeLists.txt @@ -1,12 +1,11 @@ project(docn Fortran) set(SRCFILES ocn_comp_nuopc.F90 - docn_datamode_copyall_mod.F90 + docn_datamode_sstdata_mod.F90 docn_datamode_som_mod.F90 docn_datamode_aquaplanet_mod.F90 - docn_datamode_iaf_mod.F90 docn_datamode_cplhist_mod.F90 docn_datamode_multilev_mod.F90 - docn_datamode_multilev_dom_mod.F90 + docn_datamode_multilev_sstdata_mod.F90 docn_datamode_multilev_cplhist_mod.F90 docn_import_data_mod.F90) diff --git a/docn/cime_config/config_component.xml b/docn/cime_config/config_component.xml index 114eb7f8d..35bedecc8 100644 --- a/docn/cime_config/config_component.xml +++ b/docn/cime_config/config_component.xml @@ -52,9 +52,9 @@ prescribed prescribed + interannual som som_aquap - interannual sst_aquap1 sst_aquap2 sst_aquap3 diff --git a/docn/cime_config/namelist_definition_docn.xml b/docn/cime_config/namelist_definition_docn.xml index 5141b0dba..1cc404bc6 100644 --- a/docn/cime_config/namelist_definition_docn.xml +++ b/docn/cime_config/namelist_definition_docn.xml @@ -40,7 +40,7 @@ char docn docn_nml - sstdata,sst_aquap1,sst_aquap2,sst_aquap3,sst_aquap4,sst_aquap5,sst_aquap6,sst_aquap7,sst_aquap8,sst_aquap9,sst_aquap10,sst_aquapfile,sst_aquap_constant,som,som_aquap,iaf,cplhist,multilev,multilev_dom,multilev_cplhist + sstdata,sst_aquap1,sst_aquap2,sst_aquap3,sst_aquap4,sst_aquap5,sst_aquap6,sst_aquap7,sst_aquap8,sst_aquap9,sst_aquap10,sst_aquapfile,sst_aquap_constant,som,som_aquap,iaf,cplhist,multilev,multilev_sstdata,multilev_cplhist General method that operates on the data for a given docn_mode. ==> dataMode = "sstdata" @@ -51,11 +51,6 @@ provide SST data to the data ocean model. They are normally found in the same file because the SST and ice fraction data are derived from the same observational data sets and are consistent with each other. - to the data ocean model. They are normally found in the same file - because the SST and ice fraction data are derived from the same - observational data sets and are consistent with each other. - ==> dataMode = "iaf" - iaf is the interannually varying version of sstdata The ocean salinity is set to a constant reference salinity value. All other fields other than SST and ocean salinity are set to zero. ==> dataMode = "som" @@ -66,35 +61,34 @@ ocean mixed layer depths and bottom-of-the-slab Q-fluxes. Scientifically appropriate bottom-of-the-slab Q-fluxes are normally ocean resolution dependent and are derived from the ocean model output - of a fully coupled CCSM run. Note that while this mode runs out of + of a fully coupled run. Note that while this mode runs out of the box, the default SOM forcing file is not scientifically appropriate and is provided for testing and development purposes only. Users must create scientifically appropriate data for their particular application. A tool is available to derive valid SOM forcing. (1) map the xml variable DOCN_MODE => config variable docn_mode => namelist variable datamode - compset="_DOCN%DOM_" => docn_mode=prescribed => datamode=prescribed - compset="_DOCN%IAF_" => docn_mode=interannual => datamode=interannual - compset="_DOCN%SOM_" => docn_mode=som => datamode=som - compset="_DOCN%SOMAQP_" => docn_mode=som_aquap => datamode=som_aquap - compset="_DOCN%AQP1_" => docn_mode=sst_aquap1 => datamode=sst_aquap1 - compset="_DOCN%AQP2_" => docn_mode=sst_aquap2 => datamode=sst_aquap2 - compset="_DOCN%AQP3_" => docn_mode=sst_aquap3 => datamode=sst_aquap3 - compset="_DOCN%AQP4_" => docn_mode=sst_aquap4 => datamode=sst_aquap4 - compset="_DOCN%AQP5_" => docn_mode=sst_aquap5 => datamode=sst_aquap5 - compset="_DOCN%AQP6_" => docn_mode=sst_aquap6 => datamode=sst_aquap6 - compset="_DOCN%AQP7_" => docn_mode=sst_aquap7 => datamode=sst_aquap7 - compset="_DOCN%AQP8_" => docn_mode=sst_aquap8 => datamode=sst_aquap8 - compset="_DOCN%AQP9_" => docn_mode=sst_aquap9 => datamode=sst_aquap9 - compset="_DOCN%AQP10_" => docn_mode=sst_aquap10 => datamode=sst_aquap10 - compset="_DOCN%AQPFILE_" => docn_mode=sst_aquapfile => datamode=sst_aquap_file - compset="_DOCN%AQPCONST_" => docn_mode=sst_aquap_constant => datamode=sst_aquap_constant + compset="_DOCN%DOM_" : docn_mode=prescribed , datamode=sstdata + compset="_DOCN%IAF_" : docn_mode=interannual , datamode=sstdata + compset="_DOCN%SOM_" : docn_mode=som , datamode=som + compset="_DOCN%SOMAQP_" : docn_mode=som_aquap , datamode=som_aquap + compset="_DOCN%AQP1_" : docn_mode=sst_aquap1 , datamode=sst_aquap1 + compset="_DOCN%AQP2_" : docn_mode=sst_aquap2 , datamode=sst_aquap2 + compset="_DOCN%AQP3_" : docn_mode=sst_aquap3 , datamode=sst_aquap3 + compset="_DOCN%AQP4_" : docn_mode=sst_aquap4 , datamode=sst_aquap4 + compset="_DOCN%AQP5_" : docn_mode=sst_aquap5 , datamode=sst_aquap5 + compset="_DOCN%AQP6_" : docn_mode=sst_aquap6 , datamode=sst_aquap6 + compset="_DOCN%AQP7_" : docn_mode=sst_aquap7 , datamode=sst_aquap7 + compset="_DOCN%AQP8_" : docn_mode=sst_aquap8 , datamode=sst_aquap8 + compset="_DOCN%AQP9_" : docn_mode=sst_aquap9 , datamode=sst_aquap9 + compset="_DOCN%AQP10_" : docn_mode=sst_aquap10 , datamode=sst_aquap10 + compset="_DOCN%AQPFILE_" : docn_mode=sst_aquapfile , datamode=sst_aquap_file + compset="_DOCN%AQPCONST_" : docn_mode=sst_aquap_constant , datamode=sst_aquap_constant sstdata som som_aquap - iaf sst_aquap1 sst_aquap2 sst_aquap3 @@ -108,7 +102,7 @@ sst_aquap_file sst_aquap_constant multilev_cplhist - multilev_dom + multilev_sstdata multilev cplhist diff --git a/docn/cime_config/stream_definition_docn.xml b/docn/cime_config/stream_definition_docn.xml index fc20d8b32..0fbfc3fa5 100644 --- a/docn/cime_config/stream_definition_docn.xml +++ b/docn/cime_config/stream_definition_docn.xml @@ -289,7 +289,7 @@ nearest - extend + cycle 1.e30 diff --git a/docn/docn_datamode_aquaplanet_mod.F90 b/docn/docn_datamode_aquaplanet_mod.F90 index e988b6dc2..62d5cc937 100644 --- a/docn/docn_datamode_aquaplanet_mod.F90 +++ b/docn/docn_datamode_aquaplanet_mod.F90 @@ -9,7 +9,7 @@ module docn_datamode_aquaplanet_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: docn_datamode_aquaplanet_advertise public :: docn_datamode_aquaplanet_init_pointers @@ -46,7 +46,7 @@ module docn_datamode_aquaplanet_mod real(r8) , parameter :: latrad8 = 30._r8*pio180 real(r8) , parameter :: lonrad = 30._r8*pio180 - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== diff --git a/docn/docn_datamode_cplhist_mod.F90 b/docn/docn_datamode_cplhist_mod.F90 index 7228e094d..8710c3c66 100644 --- a/docn/docn_datamode_cplhist_mod.F90 +++ b/docn/docn_datamode_cplhist_mod.F90 @@ -2,31 +2,38 @@ module docn_datamode_cplhist_mod use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS use NUOPC , only : NUOPC_Advertise - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_const_mod , only : shr_const_TkFrz, shr_const_pi, shr_const_ocn_ref_sal - use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, chkerr + use shr_kind_mod , only : r8=>shr_kind_r8 + use shr_log_mod , only : shr_log_error + use shr_const_mod , only : shr_const_TkFrz, shr_const_pi, shr_const_ocn_ref_sal, shr_const_spval + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add - use dshr_strdata_mod , only : shr_strdata_type + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer implicit none - private ! except + private public :: docn_datamode_cplhist_advertise public :: docn_datamode_cplhist_init_pointers public :: docn_datamode_cplhist_advance - ! export fields + ! export field pointers real(r8), pointer :: So_omask(:) => null() ! real ocean fraction sent to mediator real(r8), pointer :: So_t(:) => null() real(r8), pointer :: So_u(:) => null() real(r8), pointer :: So_v(:) => null() real(r8), pointer :: So_bldepth(:) => null() + ! stream field pointers + real(r8), pointer :: strm_So_bldepth(:) => null() + real(r8), pointer :: strm_So_t(:) => null() + real(r8), pointer :: strm_So_u(:) => null() + real(r8), pointer :: strm_So_v(:) => null() + real(r8) , parameter :: tkfrz = shr_const_tkfrz ! freezing point, fresh water (kelvin) real(r8) , parameter :: ocnsalt = shr_const_ocn_ref_sal ! ocean reference salinity - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -66,12 +73,13 @@ subroutine docn_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_ end subroutine docn_datamode_cplhist_advertise !=============================================================================== - subroutine docn_datamode_cplhist_init_pointers(exportState, ocn_fraction, rc) + subroutine docn_datamode_cplhist_init_pointers(exportState, sdat, ocn_fraction, rc) ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - real(r8) , intent(in) :: ocn_fraction(:) - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat + real(r8) , intent(in) :: ocn_fraction(:) + integer , intent(out) :: rc ! local variables character(len=*), parameter :: subname='(docn_init_pointers): ' @@ -79,11 +87,13 @@ subroutine docn_datamode_cplhist_init_pointers(exportState, ocn_fraction, rc) rc = ESMF_SUCCESS - ! initialize pointers to export fields + ! initialize pointers to required export fields call dshr_state_getfldptr(exportState, 'So_omask' , fldptr1=So_omask , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'So_t' , fldptr1=So_t , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! initialize pointers to optional export fields call dshr_state_getfldptr(exportState, 'So_u' , fldptr1=So_u , allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'So_v' , fldptr1=So_v , allowNullReturn=.true., rc=rc) @@ -91,10 +101,23 @@ subroutine docn_datamode_cplhist_init_pointers(exportState, ocn_fraction, rc) call dshr_state_getfldptr(exportState, 'So_bldepth', fldptr1=So_bldepth, allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !Allocation depends on exchanged fields, so check before filling arrays with values here + ! initialize pointers to required stream fields + call shr_strdata_get_stream_pointer( sdat, 'So_t', strm_So_t, requirePointer=.true., & + errmsg=subname//'ERROR: strm_So_t must be associated for docn cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initialize pointers to optional stream fields + call shr_strdata_get_stream_pointer( sdat, 'So_u', strm_So_u, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_v', strm_So_v, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_bldepth', strm_So_bldepth, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Allocation depends on exchanged fields, so check before filling arrays with values here + So_t(:) = TkFrz if (associated(So_u)) So_u(:) = 0.0_r8 if (associated(So_v)) So_v(:) = 0.0_r8 - if (associated(So_t)) So_t(:) = TkFrz if (associated(So_bldepth)) So_bldepth(:) = 0.0_r8 ! Set export state ocean fraction (So_omask) @@ -116,16 +139,39 @@ subroutine docn_datamode_cplhist_advance(sst_constant_value, rc) rc = ESMF_SUCCESS - !If need unit conversion for So_t (C-->K), - !use existing nml variable sst_constant_value to signal units of input - !i.e., 0-->Celsius, 273.15-->K - + if (associated(So_u)) then + if (associated(strm_So_u)) then + So_u(:) = strm_So_u(:) + else + So_u(:) = shr_const_spval + end if + end if + if (associated(So_v)) then + if (associated(strm_So_v)) then + So_v(:) = strm_So_v(:) + else + So_v(:) = shr_const_spval + end if + end if + if (associated(So_bldepth)) then + if (associated(strm_So_bldepth)) then + So_bldepth(:) = strm_So_bldepth(:) + else + So_bldepth(:) = shr_const_spval + end if + end if + + ! If need unit conversion for So_t (C-->K), + ! use existing nml variable sst_constant_value to signal units of input + ! i.e., 0-->Celsius, 273.15-->K + if (present(sst_constant_value)) then - if(sst_constant_value .GT. 230.0_r8) then !interpret input SST in K + if (sst_constant_value > 230.0_r8) then !interpret input SST in K units_CToK = .false. !in K already, don't convert endif endif + So_t(:) = strm_So_t(:) if (units_CToK) then So_t(:) = So_t(:) + TkFrz endif diff --git a/docn/docn_datamode_iaf_mod.F90 b/docn/docn_datamode_iaf_mod.F90 deleted file mode 100644 index a4d0dc5ae..000000000 --- a/docn/docn_datamode_iaf_mod.F90 +++ /dev/null @@ -1,172 +0,0 @@ -module docn_datamode_iaf_mod - - use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_State - use NUOPC , only : NUOPC_Advertise - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_const_mod , only : shr_const_TkFrz, shr_const_pi, shr_const_ocn_ref_sal - use dshr_strdata_mod , only : shr_strdata_get_stream_pointer, shr_strdata_type - use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, chkerr - use dshr_strdata_mod , only : shr_strdata_type - use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add - - implicit none - private ! except - - public :: docn_datamode_iaf_advertise - public :: docn_datamode_iaf_init_pointers - public :: docn_datamode_iaf_advance - - ! export fields - real(r8), pointer :: So_omask(:) => null() ! real ocean fraction sent to mediator - real(r8), pointer :: So_t(:) => null() - real(r8), pointer :: So_s(:) => null() - real(r8), pointer :: So_u(:) => null() - real(r8), pointer :: So_v(:) => null() - - ! import fields - real(r8), pointer :: Foxx_swnet(:) => null() - real(r8), pointer :: Foxx_lwup(:) => null() - real(r8), pointer :: Foxx_sen(:) => null() - real(r8), pointer :: Foxx_lat(:) => null() - real(r8), pointer :: Faxa_lwdn(:) => null() - real(r8), pointer :: Faxa_snow(:) => null() - real(r8), pointer :: Fioi_melth(:) => null() - real(r8), pointer :: Foxx_rofi(:) => null() - - real(r8) , parameter :: tkfrz = shr_const_tkfrz ! freezing point, fresh water (kelvin) - real(r8) , parameter :: ocnsalt = shr_const_ocn_ref_sal ! ocean reference salinity - - character(*) , parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine docn_datamode_iaf_advertise(importState, exportState, fldsimport, fldsexport, flds_scalar_name, rc) - - ! input/output variables - type(esmf_State) , intent(inout) :: importState - type(esmf_State) , intent(inout) :: exportState - type(fldlist_type) , pointer :: fldsimport - type(fldlist_type) , pointer :: fldsexport - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(out) :: rc - - ! local variables - type(fldlist_type), pointer :: fldList - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Advertise export fields - call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) - call dshr_fldList_add(fldsExport, 'So_omask' ) - call dshr_fldList_add(fldsExport, 'So_t' ) - call dshr_fldList_add(fldsExport, 'So_s' ) - call dshr_fldList_add(fldsExport, 'So_u' ) - call dshr_fldList_add(fldsExport, 'So_v' ) - - ! Advertise import fields - call dshr_fldList_add(fldsImport, trim(flds_scalar_name)) - call dshr_fldList_add(fldsImport, 'Foxx_swnet' ) - call dshr_fldList_add(fldsImport, 'Foxx_lwup' ) - call dshr_fldList_add(fldsImport, 'Foxx_sen' ) - call dshr_fldList_add(fldsImport, 'Foxx_lat' ) - call dshr_fldList_add(fldsImport, 'Faxa_lwdn' ) - call dshr_fldList_add(fldsImport, 'Faxa_snow' ) - call dshr_fldList_add(fldsImport, 'Fioi_melth' ) - call dshr_fldList_add(fldsImport, 'Foxx_rofi' ) - - fldlist => fldsExport ! the head of the linked list - do while (associated(fldlist)) - call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('(docn_comp_advertise): Fr_ocn'//trim(fldList%stdname), ESMF_LOGMSG_INFO) - fldList => fldList%next - enddo - - fldlist => fldsImport ! the head of the linked list - do while (associated(fldlist)) - call NUOPC_Advertise(importState, standardName=fldlist%stdname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('(docn_comp_advertise): Fr_ocn'//trim(fldList%stdname), ESMF_LOGMSG_INFO) - fldList => fldList%next - enddo - - end subroutine docn_datamode_iaf_advertise - - !=============================================================================== - subroutine docn_datamode_iaf_init_pointers(importState, exportState, ocn_fraction, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - type(ESMF_State) , intent(inout) :: importState - real(r8) , intent(in) :: ocn_fraction(:) - integer , intent(out) :: rc - - ! local variables - character(len=*), parameter :: subname='(docn_init_pointers): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! initialize pointers to export fields - call dshr_state_getfldptr(exportState, 'So_omask' , fldptr1=So_omask , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'So_t' , fldptr1=So_t , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'So_s' , fldptr1=So_s , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'So_u' , fldptr1=So_u , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'So_v' , fldptr1=So_v , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initialize pointers to import fields - call dshr_state_getfldptr(importState, 'Foxx_swnet' , fldptr1=Foxx_swnet , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Foxx_lwup' , fldptr1=Foxx_lwup , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Foxx_lwup' , fldptr1=Foxx_lwup , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Foxx_sen' , fldptr1=Foxx_sen , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Foxx_lat' , fldptr1=Foxx_lat , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Faxa_snow' , fldptr1=Faxa_snow , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Fioi_melth' , fldptr1=Fioi_melth , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(importState, 'Foxx_rofi' , fldptr1=Foxx_rofi , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Set export state ocean fraction (So_omask) - So_omask(:) = ocn_fraction(:) - - ! Initialize export state pointers to non-zero - So_t(:) = TkFrz - So_s(:) = ocnsalt - - end subroutine docn_datamode_iaf_init_pointers - - !=============================================================================== - subroutine docn_datamode_iaf_advance(rc) - - ! input/output variables - integer, intent(out) :: rc - - ! local variables - character(len=*), parameter :: subname='(docn_datamode_iaf): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - So_t(:) = So_t(:) + TkFrz - So_s(:) = ocnsalt - - end subroutine docn_datamode_iaf_advance - -end module docn_datamode_iaf_mod diff --git a/docn/docn_datamode_multilev_cplhist_mod.F90 b/docn/docn_datamode_multilev_cplhist_mod.F90 index 2f79cd117..b1be864f8 100644 --- a/docn/docn_datamode_multilev_cplhist_mod.F90 +++ b/docn/docn_datamode_multilev_cplhist_mod.F90 @@ -3,29 +3,36 @@ module docn_datamode_multilev_cplhist_mod use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS use NUOPC , only : NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_log_mod , only : shr_log_error use shr_const_mod , only : shr_const_TkFrz, shr_const_pi, shr_const_ocn_ref_sal, shr_const_spval use shr_sys_mod , only : shr_sys_abort use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, chkerr use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add use dshr_strdata_mod , only : shr_strdata_get_stream_pointer, shr_strdata_type - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add implicit none - private ! except + private public :: docn_datamode_multilev_cplhist_advertise public :: docn_datamode_multilev_cplhist_init_pointers public :: docn_datamode_multilev_cplhist_advance - ! pointers to export fields + ! export state pointers real(r8), pointer :: So_omask(:) => null() ! real ocean fraction sent to mediator + real(r8), pointer :: So_t_depth(:,:) => null() + real(r8), pointer :: So_s_depth(:,:) => null() + ! stream field pointers + type, public :: stream_pointer_type + real(r8), pointer :: ptr(:) + end type stream_pointer_type + type(stream_pointer_type), allocatable :: strm_So_t_depth(:) + type(stream_pointer_type), allocatable :: strm_So_s_depth(:) + ! number of multi-level ocean fields integer, parameter :: nlev_export = 30 - ! constants - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -63,54 +70,55 @@ subroutine docn_datamode_multilev_cplhist_advertise(exportState, fldsexport, fld end subroutine docn_datamode_multilev_cplhist_advertise !=============================================================================== - subroutine docn_datamode_multilev_cplhist_init_pointers(dfields, & - exportState, sdat, ocn_fraction, logunit, mainproc, rc) + subroutine docn_datamode_multilev_cplhist_init_pointers(exportState, sdat, ocn_fraction, rc) ! input/output variables - type(dfield_type) , pointer :: dfields type(ESMF_State) , intent(inout) :: exportState type(shr_strdata_type) , intent(in) :: sdat real(r8) , intent(in) :: ocn_fraction(:) - integer , intent(in) :: logunit - logical , intent(in) :: mainproc integer , intent(out) :: rc ! local variables - integer :: n - character(len=2) :: num_str - character(CS), allocatable :: strm_flds_t_depth(:) - character(CS), allocatable :: strm_flds_s_depth(:) + integer :: ilev + character(len=2) :: num_str + character(CS) :: strm_fld character(len=*), parameter :: subname='(docn_init_pointers): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! Note - docn_datamode_multilev_mod the assumption is that the stream files contain single - ! stream fields which contain the full set of levels in the stream data (i.e. 2d) - ! Whereas here we are assuming a different stream field for each vertical level - ! However, in both cases the export field contains an ungridded dimension for each vertical level - - ! Create stream-> export state mapping - ! Note that strm_flds is the model name for the stream field - ! Note that state_fld is the model name for the export field - - allocate(strm_flds_t_depth(1:nlev_export)) - allocate(strm_flds_s_depth(1:nlev_export)) - do n = 1,nlev_export - write(num_str, '(i0)') n - strm_flds_t_depth(n) = 'So_t_depth' // trim(num_str) - strm_flds_s_depth(n) = 'So_s_depth' // trim(num_str) - end do + ! We are assuming a different stream field for each vertical level, + ! whereas export field contains an ungridded dimension for each vertical level + + ! Set export state pointers + call dshr_state_getfldptr(exportState, fldname='So_omask', fldptr1=So_omask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, fldname='So_t_depth', fldptr2=So_t_depth, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, fldname='So_s_depth', fldptr2=So_s_depth, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! The following maps stream input multiple fields to export field that has an ungridded dimension - call dshr_dfield_add(dfields, sdat, state_fld='So_t_depth', strm_flds=strm_flds_t_depth, state=exportState, & - logunit=logunit, mainproc=mainproc, rc=rc) - call dshr_dfield_add(dfields, sdat, state_fld='So_s_depth', strm_flds=strm_flds_s_depth, state=exportState, & - logunit=logunit, mainproc=mainproc, rc=rc) + ! Set stream field pointers + allocate(strm_So_t_depth(1:nlev_export)) + allocate(strm_So_s_depth(1:nlev_export)) + do ilev = 1,nlev_export + write(num_str, '(i0)') ilev + strm_fld = 'So_t_depth' // trim(num_str) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_So_t_depth(ilev)%ptr, & + requirePointer=.true., & + errmsg=subname//'ERROR: '//trim(strm_fld)//& + ' must be associated for docn multiplev_cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + strm_fld = 'So_s_depth' // trim(num_str) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_So_s_depth(ilev)%ptr, & + requirePointer=.true., & + errmsg=subname//'ERROR: '//trim(strm_fld)//& + ' must be associated for docn multiplev_cplhist datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! Set export state ocean fraction (So_omask) - call dshr_state_getfldptr(exportState, 'So_omask', fldptr1=So_omask , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return So_omask(:) = ocn_fraction(:) end subroutine docn_datamode_multilev_cplhist_init_pointers @@ -118,36 +126,33 @@ end subroutine docn_datamode_multilev_cplhist_init_pointers !=============================================================================== subroutine docn_datamode_multilev_cplhist_advance(exportState, rc) - use dshr_methods_mod , only : dshr_state_getfldptr - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: exportState + integer , intent(out) :: rc ! local variables - integer :: idim1,idim2 - real(r8), pointer :: fldptr2(:,:) + integer :: ilev,ig character(len=*), parameter :: subname='(docn_datamode_multilev): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call dshr_state_getfldptr(exportState, 'So_t_depth', fldptr2=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do idim2 = 1,size(fldptr2,dim=2) - do idim1 = 1,size(fldptr2,dim=1) - if (fldptr2(idim1,idim2) == 0._r8) then - fldptr2(idim1,idim2) = 1.e30_r8 + do ilev = 1,size(So_t_depth,dim=1) + do ig = 1,size(So_t_depth,dim=2) + if (strm_So_t_depth(ilev)%ptr(ig) == 0._r8) then + So_t_depth(ilev,ig) = 1.e30_r8 + else + So_t_depth(ilev,ig) = strm_So_t_depth(ilev)%ptr(ig) end if end do end do - call dshr_state_getfldptr(exportState, 'So_s_depth', fldptr2=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do idim2 = 1,size(fldptr2,dim=2) - do idim1 = 1,size(fldptr2,dim=1) - if (fldptr2(idim1,idim2) == 0._r8) then - fldptr2(idim1,idim2) = 1.e30_r8 + do ilev = 1,size(So_s_depth,dim=1) + do ig = 1,size(So_s_depth,dim=2) + if (strm_So_s_depth(ilev)%ptr(ig) == 0._r8) then + So_s_depth(ilev,ig) = 1.e30_r8 + else + So_s_depth(ilev,ig) = strm_So_s_depth(ilev)%ptr(ig) end if end do end do diff --git a/docn/docn_datamode_multilev_mod.F90 b/docn/docn_datamode_multilev_mod.F90 index c3949a702..5a6299fcd 100644 --- a/docn/docn_datamode_multilev_mod.F90 +++ b/docn/docn_datamode_multilev_mod.F90 @@ -9,7 +9,7 @@ module docn_datamode_multilev_mod use dshr_strdata_mod , only : shr_strdata_get_stream_pointer, shr_strdata_type implicit none - private ! except + private public :: docn_datamode_multilev_advertise public :: docn_datamode_multilev_init_pointers @@ -21,8 +21,8 @@ module docn_datamode_multilev_mod real(r8), pointer :: So_s_depth(:,:) => null() ! pointers to stream fields - real(r8), pointer :: stream_So_t_depth(:,:) => null() - real(r8), pointer :: stream_So_s_depth(:,:) => null() + real(r8), pointer :: strm_So_t_depth(:,:) => null() + real(r8), pointer :: strm_So_s_depth(:,:) => null() integer, parameter :: nlev_export = 30 real(r8) :: vertical_levels(nlev_export) = (/ & @@ -31,8 +31,8 @@ module docn_datamode_multilev_mod 1230., 1290., 1350., 1410., 1470., 1530., 1590., 1650., 1710., 1770. /) ! constants - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -84,15 +84,7 @@ subroutine docn_datamode_multilev_init_pointers(exportState, sdat, ocn_fraction, rc = ESMF_SUCCESS - ! initialize pointers to stream fields - ! this has the full set of leveles in the stream data - call shr_strdata_get_stream_pointer( sdat, 'So_t_depth', stream_So_t_depth, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'So_s_depth', stream_So_s_depth, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initialize pointers to export fields - ! the export state has only nlev_export levels + ! Set export state pointers (has only nlev_export levels) call dshr_state_getfldptr(exportState, 'So_omask' , fldptr1=So_omask , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'So_t_depth' , fldptr2=So_t_depth , rc=rc) @@ -100,11 +92,17 @@ subroutine docn_datamode_multilev_init_pointers(exportState, sdat, ocn_fraction, call dshr_state_getfldptr(exportState, 'So_s_depth' , fldptr2=So_s_depth , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set stream pointers (this has the full set of leveles in the stream data) + call shr_strdata_get_stream_pointer( sdat, 'So_t_depth', strm_So_t_depth, & + errmsg=subname//'ERROR: strm_So_t_depth must be associated for docn multilev datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_s_depth', strm_So_s_depth, & + errmsg=subname//'ERROR: strm_So_s_depth must be associated for docn multilev datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Initialize export state pointers to non-zero So_t_depth(:,:) = shr_const_TkFrz So_s_depth(:,:) = shr_const_ocn_ref_sal - - ! Set export state ocean fraction (So_omask) So_omask(:) = ocn_fraction(:) end subroutine docn_datamode_multilev_init_pointers @@ -113,9 +111,9 @@ end subroutine docn_datamode_multilev_init_pointers subroutine docn_datamode_multilev_advance(sdat, logunit, mainproc, rc) ! input/output variables - type(shr_strdata_type) , intent(in) :: sdat - integer , intent(in) :: logunit - logical , intent(in) :: mainproc + type(shr_strdata_type) , intent(in) :: sdat + integer , intent(in) :: logunit + logical , intent(in) :: mainproc integer , intent(out) :: rc ! local variables @@ -124,8 +122,8 @@ subroutine docn_datamode_multilev_advance(sdat, logunit, mainproc, rc) integer :: stream_index logical :: level_found real(r8) :: factor + logical :: first_time = .true. real(r8), allocatable :: stream_vlevs(:) - logical :: first_time = .true. character(len=*), parameter :: subname='(docn_datamode_multilev): ' !------------------------------------------------------------------------------- @@ -154,21 +152,21 @@ subroutine docn_datamode_multilev_advance(sdat, logunit, mainproc, rc) So_s_depth(ko,i) = shr_const_spval else ! Assume input T forcing is in degrees C - if (stream_So_t_depth(ki+1,i) > 1.e10) then - if (stream_So_t_depth(ki,i) > 1.e10) then + if (strm_So_t_depth(ki+1,i) > 1.e10) then + if (strm_So_t_depth(ki,i) > 1.e10) then So_t_depth(ko,i) = shr_const_spval So_s_depth(ko,i) = shr_const_spval else - So_t_depth(ko,i) = stream_So_t_depth(ki,i) + shr_const_tkfrz - So_s_depth(ko,i) = stream_So_s_depth(ki,i) + So_t_depth(ko,i) = strm_So_t_depth(ki,i) + shr_const_tkfrz + So_s_depth(ko,i) = strm_So_s_depth(ki,i) end if else - factor = (stream_So_t_depth(ki+1,i)-stream_So_t_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) - So_t_depth(ko,i) = stream_So_t_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor + factor = (strm_So_t_depth(ki+1,i)-strm_So_t_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) + So_t_depth(ko,i) = strm_So_t_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor So_t_depth(ko,i) = So_t_depth(ko,i) + shr_const_tkfrz - factor = (stream_So_s_depth(ki+1,i)-stream_So_s_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) - So_s_depth(ko,i) = stream_So_s_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor + factor = (strm_So_s_depth(ki+1,i)-strm_So_s_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) + So_s_depth(ko,i) = strm_So_s_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor end if end if end do @@ -179,7 +177,6 @@ subroutine docn_datamode_multilev_advance(sdat, logunit, mainproc, rc) return end if end do - first_time = .false. end subroutine docn_datamode_multilev_advance diff --git a/docn/docn_datamode_multilev_dom_mod.F90 b/docn/docn_datamode_multilev_sstdata_mod.F90 similarity index 70% rename from docn/docn_datamode_multilev_dom_mod.F90 rename to docn/docn_datamode_multilev_sstdata_mod.F90 index e292b8ade..cdb886503 100644 --- a/docn/docn_datamode_multilev_dom_mod.F90 +++ b/docn/docn_datamode_multilev_sstdata_mod.F90 @@ -1,4 +1,4 @@ -module docn_datamode_multilev_dom_mod +module docn_datamode_multilev_sstdata_mod use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS use NUOPC , only : NUOPC_Advertise @@ -10,11 +10,11 @@ module docn_datamode_multilev_dom_mod use dshr_strdata_mod , only : shr_strdata_get_stream_pointer, shr_strdata_type, shr_strdata_get_stream_count implicit none - private ! except + private - public :: docn_datamode_multilev_dom_advertise - public :: docn_datamode_multilev_dom_init_pointers - public :: docn_datamode_multilev_dom_advance + public :: docn_datamode_multilev_sstdata_advertise + public :: docn_datamode_multilev_sstdata_init_pointers + public :: docn_datamode_multilev_sstdata_advance ! pointers to export fields real(r8), pointer :: So_omask(:) => null() ! real ocean fraction sent to mediator @@ -26,8 +26,9 @@ module docn_datamode_multilev_dom_mod real(r8), pointer :: So_s(:) => null() ! pointers to stream fields - real(r8), pointer :: stream_So_t_depth(:,:) => null() - real(r8), pointer :: stream_So_s_depth(:,:) => null() + real(r8), pointer :: strm_So_t(:) + real(r8), pointer :: strm_So_t_depth(:,:) => null() + real(r8), pointer :: strm_So_s_depth(:,:) => null() integer, parameter :: nlev_export = 30 real(r8) :: vertical_levels(nlev_export) = (/ & @@ -38,16 +39,14 @@ module docn_datamode_multilev_dom_mod real(r8) , parameter :: tkfrz = shr_const_tkfrz ! freezing point, fresh water (kelvin) real(r8) , parameter :: ocnsalt = shr_const_ocn_ref_sal ! ocean reference salinity - ! constants - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains !=============================================================================== - subroutine docn_datamode_multilev_dom_advertise(exportState, fldsexport, flds_scalar_name, rc) + subroutine docn_datamode_multilev_sstdata_advertise(exportState, fldsexport, flds_scalar_name, rc) ! input/output variables type(esmf_State) , intent(inout) :: exportState @@ -66,10 +65,10 @@ subroutine docn_datamode_multilev_dom_advertise(exportState, fldsexport, flds_sc call dshr_fldList_add(fldsExport, 'So_omask') call dshr_fldList_add(fldsExport, 'So_t_depth', ungridded_lbound=1, ungridded_ubound=nlev_export) call dshr_fldList_add(fldsExport, 'So_s_depth', ungridded_lbound=1, ungridded_ubound=nlev_export) - call dshr_fldList_add(fldsExport, 'So_t' ) - call dshr_fldList_add(fldsExport, 'So_s' ) - call dshr_fldList_add(fldsExport, 'So_u' ) - call dshr_fldList_add(fldsExport, 'So_v' ) + call dshr_fldList_add(fldsExport, 'So_t') + call dshr_fldList_add(fldsExport, 'So_s') + call dshr_fldList_add(fldsExport, 'So_u') + call dshr_fldList_add(fldsExport, 'So_v') fldlist => fldsExport ! the head of the linked list do while (associated(fldlist)) @@ -79,10 +78,10 @@ subroutine docn_datamode_multilev_dom_advertise(exportState, fldsexport, flds_sc fldList => fldList%next enddo - end subroutine docn_datamode_multilev_dom_advertise + end subroutine docn_datamode_multilev_sstdata_advertise !=============================================================================== - subroutine docn_datamode_multilev_dom_init_pointers(exportState, sdat, ocn_fraction, rc) + subroutine docn_datamode_multilev_sstdata_init_pointers(exportState, sdat, ocn_fraction, rc) ! input/output variables type(ESMF_State) , intent(inout) :: exportState @@ -96,13 +95,9 @@ subroutine docn_datamode_multilev_dom_init_pointers(exportState, sdat, ocn_fract rc = ESMF_SUCCESS - ! initialize pointers to stream fields - ! this has the full set of leveles in the stream data - call shr_strdata_get_stream_pointer( sdat, 'So_t_depth', stream_So_t_depth, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'So_s_depth', stream_So_s_depth, rc=rc) + ! initialize pointers to export fields + call dshr_state_getfldptr(exportState, 'So_omask', fldptr1=So_omask , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'So_t', fldptr1=So_t, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'So_s', fldptr1=So_s, rc=rc) @@ -111,16 +106,23 @@ subroutine docn_datamode_multilev_dom_init_pointers(exportState, sdat, ocn_fract if (chkerr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'So_v', fldptr1=So_v, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initialize pointers to export fields - ! the export state has only nlev_export levels - call dshr_state_getfldptr(exportState, 'So_omask' , fldptr1=So_omask , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'So_t_depth' , fldptr2=So_t_depth , rc=rc) + call dshr_state_getfldptr(exportState, 'So_t_depth', fldptr2=So_t_depth , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'So_s_depth' , fldptr2=So_s_depth , rc=rc) + call dshr_state_getfldptr(exportState, 'So_s_depth', fldptr2=So_s_depth , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! initialize pointers to stream fields + ! this has the full set of leveles in the stream data + call shr_strdata_get_stream_pointer( sdat, 'So_t', strm_So_t, & + errmsg=subname//'ERROR: strm_So_t must be associated for docn multilev_sstdata datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_t_depth', strm_So_t_depth, & + errmsg=subname//'ERROR: strm_So_t_depth must be associated for docn multilev_sstdata datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_s_depth', strm_So_s_depth, & + errmsg=subname//'ERROR: strm_So_t_depth must be associated for docn multilev_sstdata datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Initialize export state pointers to non-zero So_t_depth(:,:) = shr_const_TkFrz So_s_depth(:,:) = shr_const_ocn_ref_sal @@ -133,10 +135,10 @@ subroutine docn_datamode_multilev_dom_init_pointers(exportState, sdat, ocn_fract ! Set export state ocean fraction (So_omask) So_omask(:) = ocn_fraction(:) - end subroutine docn_datamode_multilev_dom_init_pointers + end subroutine docn_datamode_multilev_sstdata_init_pointers !=============================================================================== - subroutine docn_datamode_multilev_dom_advance(sdat, logunit, mainproc, rc) + subroutine docn_datamode_multilev_sstdata_advance(sdat, logunit, mainproc, rc) ! input/output variables type(shr_strdata_type) , intent(in) :: sdat @@ -153,12 +155,13 @@ subroutine docn_datamode_multilev_dom_advance(sdat, logunit, mainproc, rc) real(r8) :: factor real(r8), allocatable :: stream_vlevs(:) logical :: first_time = .true. - character(len=*), parameter :: subname='(docn_datamode_multilev_dom): ' + character(len=*), parameter :: subname='(docn_datamode_multilev_sstdata): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - So_t(:) = So_t(:) + TkFrz + ! Set ocean sst + So_t(:) = strm_So_t(:) + TkFrz ! Determine number of vertical levels for multi level stream nstreams = shr_strdata_get_stream_count(sdat) @@ -168,7 +171,7 @@ subroutine docn_datamode_multilev_dom_advance(sdat, logunit, mainproc, rc) if (nlev_stream > 1) exit end do if (nlev_stream == 0) then - call shr_log_error(trim(subname)//" could not find vertical levels greater than 0", rc=rc) + call shr_log_error(subname//" could not find vertical levels greater than 0", rc=rc) return end if allocate(stream_vlevs(nlev_stream)) @@ -190,34 +193,34 @@ subroutine docn_datamode_multilev_dom_advance(sdat, logunit, mainproc, rc) So_s_depth(ko,i) = shr_const_spval else ! Assume input T forcing is in degrees C - if (stream_So_t_depth(ki+1,i) > 1.e10) then - if (stream_So_t_depth(ki,i) > 1.e10) then + if (strm_So_t_depth(ki+1,i) > 1.e10) then + if (strm_So_t_depth(ki,i) > 1.e10) then So_t_depth(ko,i) = shr_const_spval So_s_depth(ko,i) = shr_const_spval else - So_t_depth(ko,i) = stream_So_t_depth(ki,i) + shr_const_tkfrz - So_s_depth(ko,i) = stream_So_s_depth(ki,i) + So_t_depth(ko,i) = strm_So_t_depth(ki,i) + shr_const_tkfrz + So_s_depth(ko,i) = strm_So_s_depth(ki,i) end if else - factor = (stream_So_t_depth(ki+1,i)-stream_So_t_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) - So_t_depth(ko,i) = stream_So_t_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor + factor = (strm_So_t_depth(ki+1,i)-strm_So_t_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) + So_t_depth(ko,i) = strm_So_t_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor So_t_depth(ko,i) = So_t_depth(ko,i) + shr_const_tkfrz - factor = (stream_So_s_depth(ki+1,i)-stream_So_s_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) - So_s_depth(ko,i) = stream_So_s_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor + factor = (strm_So_s_depth(ki+1,i)-strm_So_s_depth(ki,i))/(stream_vlevs(ki+1)-stream_vlevs(ki)) + So_s_depth(ko,i) = strm_So_s_depth(ki,i) + (vertical_levels(ko)-stream_vlevs(ki))*factor end if end if end do end if end do if (.not. level_found) then - call shr_log_error(trim(subname)//" could not find level bounds for vertical interpolation", rc=rc) + call shr_log_error(subname//" could not find level bounds for vertical interpolation", rc=rc) return end if end do first_time = .false. - end subroutine docn_datamode_multilev_dom_advance + end subroutine docn_datamode_multilev_sstdata_advance -end module docn_datamode_multilev_dom_mod +end module docn_datamode_multilev_sstdata_mod diff --git a/docn/docn_datamode_som_mod.F90 b/docn/docn_datamode_som_mod.F90 index b3947d697..ff6026bf0 100644 --- a/docn/docn_datamode_som_mod.F90 +++ b/docn/docn_datamode_som_mod.F90 @@ -6,6 +6,7 @@ module docn_datamode_som_mod use ESMF , only : ESMF_LogWrite use NUOPC , only : NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_log_mod , only : shr_log_error use shr_const_mod , only : shr_const_cpsw, shr_const_rhosw, shr_const_TkFrz use shr_const_mod , only : shr_const_TkFrzSw, shr_const_latice, shr_const_ocn_ref_sal use shr_const_mod , only : shr_const_zsrflyr, shr_const_pi @@ -17,7 +18,7 @@ module docn_datamode_som_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: docn_datamode_som_advertise public :: docn_datamode_som_init_pointers @@ -25,7 +26,7 @@ module docn_datamode_som_mod public :: docn_datamode_som_restart_read public :: docn_datamode_som_restart_write - ! export fields + ! pointers to export fields real(r8), pointer :: So_omask(:) => null() ! real ocean fraction sent to mediator real(r8), pointer :: So_t(:) => null() real(r8), pointer :: So_s(:) => null() @@ -37,7 +38,7 @@ module docn_datamode_som_mod real(r8), pointer :: Fioo_q(:) => null() real(r8), pointer :: So_fswpen(:) => null() - ! import fields + ! pointers to import fields real(r8), pointer :: Foxx_swnet(:) => null() real(r8), pointer :: Foxx_lwup(:) => null() real(r8), pointer :: Foxx_sen(:) => null() @@ -47,14 +48,20 @@ module docn_datamode_som_mod real(r8), pointer :: Fioi_melth(:) => null() real(r8), pointer :: Foxx_rofi(:) => null() - ! internal stream type - real(r8), pointer :: strm_h(:) => null() - real(r8), pointer :: strm_qbot(:) => null() + ! pointers to stream fields + real(r8), pointer :: strm_So_t(:) => null() + real(r8), pointer :: strm_So_s(:) => null() + real(r8), pointer :: strm_So_u(:) => null() + real(r8), pointer :: strm_So_v(:) => null() + real(r8), pointer :: strm_So_dhdx(:) => null() + real(r8), pointer :: strm_So_dhdy(:) => null() + real(r8), pointer :: strm_So_h(:) => null() + real(r8), pointer :: strm_So_qbot(:) => null() ! restart fields real(R8), public, pointer :: somtp(:) ! SOM ocean temperature needed for restart - real(R8) :: dt ! real model timestep + real(R8) :: dt ! real model timestep ! constants real(r8) , parameter :: cpsw = shr_const_cpsw ! specific heat of sea h2o ~ j/kg/k @@ -64,8 +71,7 @@ module docn_datamode_som_mod real(r8) , parameter :: latice = shr_const_latice ! latent heat of fusion real(r8) , parameter :: ocnsalt = shr_const_ocn_ref_sal ! ocean reference salinity - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -150,12 +156,6 @@ subroutine docn_datamode_som_init_pointers(importState, exportState, sdat, ocn_f rc = ESMF_SUCCESS - ! initialize pointers to stream fields - call shr_strdata_get_stream_pointer( sdat, 'So_qbot', strm_qbot, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'So_h' , strm_h , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! initialize pointers to import fields call dshr_state_getfldptr(importState, 'Foxx_swnet' , fldptr1=Foxx_swnet , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -204,15 +204,42 @@ subroutine docn_datamode_som_init_pointers(importState, exportState, sdat, ocn_f So_fswpen(:) = swp end if + ! Initialize pointers to stream fields + call shr_strdata_get_stream_pointer( sdat, 'So_t' , strm_So_t, & + errmsg=subname//'ERROR: strm_So_t must be associated for docn som datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_s' , strm_So_s, & + errmsg=subname//'ERROR: strm_So_s must be associated for docn som datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_u' , strm_So_u, & + errmsg=subname//'ERROR: strm_So_u must be associated for docn som datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_v' , strm_So_v, & + errmsg=subname//'ERROR: strm_So_v must be associated for docn som datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_dhdx' , strm_So_dhdx, & + errmsg=subname//'ERROR: strm_So_dhdx must be associated for docn som datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_dhdy' , strm_So_dhdy, & + errmsg=subname//'ERROR: strm_So_dhdy must be associated for docn som datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_h' , strm_So_h, & + errmsg=subname//'ERROR: strm_So_h must be associated for docn som datamode', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'So_qbot' , strm_So_qbot, & + errmsg=subname//'ERROR: strm_So_qbot must be associated for docn som datamode', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set export state ocean fraction (So_omask) So_omask(:) = ocn_fraction(:) ! Allocate memory for somtp allocate(somtp(sdat%model_lsize)) - ! Initialize export state pointers to non-zero + ! Initialize export state pointers So_t(:) = TkFrz So_s(:) = ocnsalt + So_bldepth(:) = 0._r8 end subroutine docn_datamode_som_init_pointers @@ -230,8 +257,8 @@ subroutine docn_datamode_som_advance(importState, exportState, clock, restart_re ! local variables logical :: first_time = .true. type(ESMF_TimeInterval) :: timeStep - integer :: idt ! integer model timestep - real(r8), allocatable :: tfreeze(:) ! SOM ocean freezing temperature + integer :: idt ! integer model timestep + real(r8), allocatable :: tfreeze(:) ! SOM ocean freezing temperature integer :: lsize integer :: n logical :: reset_temp @@ -240,6 +267,13 @@ subroutine docn_datamode_som_advance(importState, exportState, clock, restart_re rc = ESMF_SUCCESS + So_u(:) = strm_So_u(:) + So_v(:) = strm_So_v(:) + So_s(:) = strm_So_s(:) + So_dhdx(:) = strm_So_dhdx(:) + So_dhdy(:) = strm_So_dhdy(:) + So_t(:) = strm_So_t(:) ! assume input is in degrees C + lsize = size(So_t) if (first_time) then @@ -273,16 +307,16 @@ subroutine docn_datamode_som_advance(importState, exportState, clock, restart_re end if allocate(tfreeze(lsize)) - tfreeze(:) = shr_frz_freezetemp(So_s(:)) + TkFrz + tfreeze(:) = shr_frz_freezetemp(strm_So_s(:)) + TkFrz do n = 1,lsize if (So_omask(n) /= 0._r8) then ! compute new temp (last term is latent by prec and roff) So_t(n) = somtp(n) + & ( Foxx_swnet(n) + Foxx_lwup(n) + Faxa_lwdn(n) + Foxx_sen(n) + Foxx_lat(n) + & - Fioi_melth(n) - strm_qbot(n) - (Faxa_snow(n)+Foxx_rofi(n))*latice) * dt/(cpsw*rhosw* strm_h(n)) + Fioi_melth(n) - strm_So_qbot(n) - (Faxa_snow(n)+Foxx_rofi(n))*latice ) * dt/(cpsw*rhosw* strm_So_h(n)) ! compute ice formed or melt potential - Fioo_q(n) = (tfreeze(n) - So_t(n))*(cpsw*rhosw*strm_h(n))/dt ! ice formed q>0 + Fioo_q(n) = (tfreeze(n) - So_t(n))*(cpsw*rhosw*strm_So_h(n))/dt ! ice formed q>0 ! reset temp if (reset_temp) then @@ -291,7 +325,7 @@ subroutine docn_datamode_som_advance(importState, exportState, clock, restart_re ! save somtp to restart file somtp(n) = So_t(n) - So_bldepth(n) = strm_h(n) + So_bldepth(n) = strm_So_h(n) endif end do deallocate(tfreeze) @@ -304,7 +338,7 @@ end subroutine docn_datamode_som_advance !=============================================================================== subroutine docn_datamode_som_restart_write(rpfile, case_name, inst_suffix, ymd, tod, & - logunit, my_task, sdat) + logunit, my_task, sdat, rc) ! write restart file @@ -317,8 +351,11 @@ subroutine docn_datamode_som_restart_write(rpfile, case_name, inst_suffix, ymd, integer , intent(in) :: logunit integer , intent(in) :: my_task type(shr_strdata_type) , intent(inout) :: sdat + integer , intent(out) :: rc !------------------------------------------------------------------------------- - integer :: rc + + rc = ESMF_SUCCESS + call dshr_restart_write(rpfile, case_name, 'docn', inst_suffix, ymd, tod, & logunit, my_task, sdat, rc, fld=somtp, fldname='somtp') if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -326,23 +363,27 @@ subroutine docn_datamode_som_restart_write(rpfile, case_name, inst_suffix, ymd, end subroutine docn_datamode_som_restart_write !=============================================================================== - subroutine docn_datamode_som_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat) + subroutine docn_datamode_som_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat, rc) ! read restart file ! input/output arguments - character(len=*) , intent(inout) :: rest_filem - character(len=*) , intent(in) :: rpfile - integer , intent(in) :: logunit - integer , intent(in) :: my_task - integer , intent(in) :: mpicom - type(shr_strdata_type) , intent(inout) :: sdat + character(len=*) , intent(inout) :: rest_filem + character(len=*) , intent(in) :: rpfile + integer , intent(in) :: logunit + integer , intent(in) :: my_task + integer , intent(in) :: mpicom + type(shr_strdata_type) , intent(inout) :: sdat + integer , intent(out) :: rc !------------------------------------------------------------------------------- - integer :: rc + + rc = ESMF_SUCCESS + ! allocate module memory for restart fields that are read in allocate(somtp(sdat%model_lsize)) + ! read restart - call dshr_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat, rc,& + call dshr_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat, rc, & fld=somtp, fldname='somtp') if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/docn/docn_datamode_copyall_mod.F90 b/docn/docn_datamode_sstdata_mod.F90 similarity index 70% rename from docn/docn_datamode_copyall_mod.F90 rename to docn/docn_datamode_sstdata_mod.F90 index a6628f56d..2c4821526 100644 --- a/docn/docn_datamode_copyall_mod.F90 +++ b/docn/docn_datamode_sstdata_mod.F90 @@ -1,19 +1,20 @@ -module docn_datamode_copyall_mod +module docn_datamode_sstdata_mod use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS use NUOPC , only : NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_log_mod , only : shr_log_error use shr_const_mod , only : shr_const_TkFrz, shr_const_pi, shr_const_ocn_ref_sal use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, chkerr use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add - use dshr_strdata_mod , only : shr_strdata_type + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer implicit none - private ! except + private - public :: docn_datamode_copyall_advertise - public :: docn_datamode_copyall_init_pointers - public :: docn_datamode_copyall_advance + public :: docn_datamode_sstdata_advertise + public :: docn_datamode_sstdata_init_pointers + public :: docn_datamode_sstdata_advance ! export fields real(r8), pointer :: So_omask(:) => null() ! real ocean fraction sent to mediator @@ -22,18 +23,21 @@ module docn_datamode_copyall_mod real(r8), pointer :: So_v(:) => null() real(r8), pointer :: So_s(:) => null() + ! pointer to stream field + real(r8), pointer :: strm_So_t(:) => null() + real(r8) , parameter :: tkfrz = shr_const_tkfrz ! freezing point, fresh water (kelvin) real(r8) , parameter :: ocnsalt = shr_const_ocn_ref_sal ! ocean reference salinity - character(*) , parameter :: nullstr = 'null' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains !=============================================================================== - subroutine docn_datamode_copyall_advertise(exportState, fldsexport, flds_scalar_name, rc) + subroutine docn_datamode_sstdata_advertise(exportState, fldsexport, flds_scalar_name, rc) ! input/output variables type(esmf_State) , intent(inout) :: exportState @@ -63,15 +67,16 @@ subroutine docn_datamode_copyall_advertise(exportState, fldsexport, flds_scalar_ fldList => fldList%next enddo - end subroutine docn_datamode_copyall_advertise + end subroutine docn_datamode_sstdata_advertise !=============================================================================== - subroutine docn_datamode_copyall_init_pointers(exportState, ocn_fraction, rc) + subroutine docn_datamode_sstdata_init_pointers(exportState, sdat, ocn_fraction, rc) ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - real(r8) , intent(in) :: ocn_fraction(:) - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat + real(r8) , intent(in) :: ocn_fraction(:) + integer , intent(out) :: rc ! local variables character(len=*), parameter :: subname='(docn_init_pointers): ' @@ -91,36 +96,35 @@ subroutine docn_datamode_copyall_init_pointers(exportState, ocn_fraction, rc) call dshr_state_getfldptr(exportState, 'So_v' , fldptr1=So_v , allowNullReturn=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (associated(So_u)) then - So_u(:) = 0.0_r8 - end if - if (associated(So_v)) then - So_v(:) = 0.0_r8 - end if - if (associated(So_s)) then - So_s(:) = ocnsalt - end if - So_t(:) = TkFrz + ! initialize pointer to stream field + call shr_strdata_get_stream_pointer( sdat, 'So_t', strm_So_t, & + errmsg=subname//'ERROR: strm_So_t must be associated for docn sstdata datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set export state ocean fraction (So_omask) + ! Initialize value of export state So_omask(:) = ocn_fraction(:) + So_t(:) = TkFrz + if (associated(So_u)) So_u(:) = 0.0_r8 + if (associated(So_v)) So_v(:) = 0.0_r8 + if (associated(So_s)) So_s(:) = ocnsalt - end subroutine docn_datamode_copyall_init_pointers + end subroutine docn_datamode_sstdata_init_pointers !=============================================================================== - subroutine docn_datamode_copyall_advance(rc) + subroutine docn_datamode_sstdata_advance(rc) ! input/output variables integer, intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(docn_datamode_copyall_advance): ' + character(len=*), parameter :: subname='(docn_datamode_sstdata_advance): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - So_t(:) = So_t(:) + TkFrz + ! Assume stream sst data is in degrees C + So_t(:) = strm_So_t(:) + TkFrz - end subroutine docn_datamode_copyall_advance + end subroutine docn_datamode_sstdata_advance -end module docn_datamode_copyall_mod +end module docn_datamode_sstdata_mod diff --git a/docn/docn_import_data_mod.F90 b/docn/docn_import_data_mod.F90 index ea4b423c7..6a74b2dc0 100644 --- a/docn/docn_import_data_mod.F90 +++ b/docn/docn_import_data_mod.F90 @@ -7,13 +7,13 @@ module docn_import_data_mod use dshr_methods_mod , only : chkerr implicit none - private ! except + private public :: docn_import_data_advertise private :: docn_get_import_fields - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== diff --git a/docn/ocn_comp_nuopc.F90 b/docn/ocn_comp_nuopc.F90 index 5aab1dead..e9d275060 100644 --- a/docn/ocn_comp_nuopc.F90 +++ b/docn/ocn_comp_nuopc.F90 @@ -23,8 +23,7 @@ module cdeps_docn_comp use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_kind_mod , only : cx=>shr_kind_cx + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx use shr_cal_mod , only : shr_cal_ymd2date use shr_log_mod , only : shr_log_setLogUnit, shr_log_error use dshr_methods_mod , only : dshr_state_diagnose, chkerr, memcheck @@ -32,41 +31,44 @@ module cdeps_docn_comp use dshr_mod , only : dshr_model_initphase, dshr_init, dshr_mesh_init, dshr_restart_read use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_check_restart_alarm use dshr_mod , only : dshr_restart_write - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_realize use nuopc_shr_methods, only : shr_get_rpointer_name ! Datamode specialized modules - use docn_datamode_copyall_mod , only : docn_datamode_copyall_advertise - use docn_datamode_copyall_mod , only : docn_datamode_copyall_init_pointers - use docn_datamode_copyall_mod , only : docn_datamode_copyall_advance - use docn_datamode_iaf_mod , only : docn_datamode_iaf_advertise - use docn_datamode_iaf_mod , only : docn_datamode_iaf_init_pointers - use docn_datamode_iaf_mod , only : docn_datamode_iaf_advance + use docn_datamode_sstdata_mod , only : docn_datamode_sstdata_advertise + use docn_datamode_sstdata_mod , only : docn_datamode_sstdata_init_pointers + use docn_datamode_sstdata_mod , only : docn_datamode_sstdata_advance + use docn_datamode_som_mod , only : docn_datamode_som_advertise use docn_datamode_som_mod , only : docn_datamode_som_init_pointers use docn_datamode_som_mod , only : docn_datamode_som_advance use docn_datamode_som_mod , only : docn_datamode_som_restart_read use docn_datamode_som_mod , only : docn_datamode_som_restart_write + use docn_datamode_aquaplanet_mod , only : docn_datamode_aquaplanet_advertise use docn_datamode_aquaplanet_mod , only : docn_datamode_aquaplanet_init_pointers use docn_datamode_aquaplanet_mod , only : docn_datamode_aquaplanet_advance + use docn_datamode_cplhist_mod , only : docn_datamode_cplhist_advertise use docn_datamode_cplhist_mod , only : docn_datamode_cplhist_init_pointers use docn_datamode_cplhist_mod , only : docn_datamode_cplhist_advance + use docn_datamode_multilev_cplhist_mod , only : docn_datamode_multilev_cplhist_advertise use docn_datamode_multilev_cplhist_mod , only : docn_datamode_multilev_cplhist_init_pointers use docn_datamode_multilev_cplhist_mod , only : docn_datamode_multilev_cplhist_advance - use docn_datamode_multilev_dom_mod , only : docn_datamode_multilev_dom_advertise - use docn_datamode_multilev_dom_mod , only : docn_datamode_multilev_dom_init_pointers - use docn_datamode_multilev_dom_mod , only : docn_datamode_multilev_dom_advance + + use docn_datamode_multilev_sstdata_mod , only : docn_datamode_multilev_sstdata_advertise + use docn_datamode_multilev_sstdata_mod , only : docn_datamode_multilev_sstdata_init_pointers + use docn_datamode_multilev_sstdata_mod , only : docn_datamode_multilev_sstdata_advance + use docn_datamode_multilev_mod , only : docn_datamode_multilev_advertise use docn_datamode_multilev_mod , only : docn_datamode_multilev_init_pointers use docn_datamode_multilev_mod , only : docn_datamode_multilev_advance + use docn_import_data_mod , only : docn_import_data_advertise implicit none - private ! except + private public :: SetServices public :: SetVM @@ -89,12 +91,12 @@ module cdeps_docn_comp integer :: flds_scalar_index_ny = 0 integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom - logical :: mainproc ! true of my_task == main_task + logical :: mainproc ! true of my_task == main_task character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number logical :: restart_read ! start from restart character(CL) :: case_name - character(*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: nullstr = 'null' ! docn_in namelist input character(CX) :: streamfilename = nullstr ! filename to obtain stream info from @@ -109,28 +111,30 @@ module cdeps_docn_comp integer :: ny_global logical :: skip_restart_read = .false. ! true => skip restart read in continuation run logical :: export_all = .false. ! true => export all fields, do not check connected or not + logical :: first_call = .true. ! linked lists type(fldList_type) , pointer :: fldsImport => null() type(fldList_type) , pointer :: fldsExport => null() - type(dfield_type) , pointer :: dfields => null() ! model mask and model fraction real(r8), pointer :: model_frac(:) => null() integer , pointer :: model_mask(:) => null() logical :: valid_ocn = .true. ! used for single column logic + ! first call in run phse + ! constants logical :: aquaplanet = .false. logical :: diagnose_data = .true. integer , parameter :: main_task = 0 ! task number of main task #ifdef CESMCOUPLED - character(*) , parameter :: module_name = "(ocn_comp_nuopc)" + character(len=*) , parameter :: module_name = "(ocn_comp_nuopc)" #else - character(*) , parameter :: module_name = "(cdeps_docn_comp)" + character(len=*) , parameter :: module_name = "(cdeps_docn_comp)" #endif - character(*) , parameter :: modelname = 'docn' - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: modelname = 'docn' + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -200,10 +204,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) real(r8) :: rtmp(1) type(ESMF_VM) :: vm character(len=*),parameter :: subname=trim(module_name)//':(InitializeAdvertise) ' - character(*) ,parameter :: F00 = "('(" // trim(module_name) // ") ',8a)" - character(*) ,parameter :: F01 = "('(" // trim(module_name) // ") ',a,2x,i8)" - character(*) ,parameter :: F02 = "('(" // trim(module_name) // ") ',a,l6)" - character(*) ,parameter :: F03 = "('(" // trim(module_name) // ") ',a,f8.5,2x,f8.5)" !------------------------------------------------------------------------------- namelist / docn_nml / datamode, & @@ -225,8 +225,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Determine logical mainproc mainproc = (my_task == main_task) - if (my_task == main_task) then - + if (mainproc) then ! Read docn_nml from nlfilename nlfilename = "docn_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") @@ -234,23 +233,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) read (nu,nml=docn_nml,iostat=ierr) close(nu) if (ierr > 0) then - write(logunit,F00) 'ERROR: reading input namelist, '//trim(nlfilename)//' iostat=',ierr + if (mainproc) then + write(logunit,'(2a,i0)') subname, & + 'ERROR: reading input namelist, '//trim(nlfilename)//' iostat=',ierr + end if call shr_log_error(subName//': namelist read error '//trim(nlfilename), rc=rc) return end if ! write namelist input to standard out - write(logunit,F00)' case_name = ',trim(case_name) - write(logunit,F00)' datamode = ',trim(datamode) - write(logunit,F00)' model_meshfile = ',trim(model_meshfile) - write(logunit,F00)' model_maskfile = ',trim(model_maskfile) - write(logunit,F01)' nx_global = ',nx_global - write(logunit,F01)' ny_global = ',ny_global - write(logunit,F00)' restfilm = ',trim(restfilm) - write(logunit,F02)' skip_restart_read = ',skip_restart_read - write(logunit,F00)' import_data_fields = ',trim(import_data_fields) - write(logunit,*) ' sst_constant_value = ',sst_constant_value - write(logunit,F02)' export_all = ', export_all + write(logunit,'(3a)') subname,' case_name = ',trim(case_name) + write(logunit,'(3a)') subname,' datamode = ',trim(datamode) + write(logunit,'(3a)') subname,' model_meshfile = ',trim(model_meshfile) + write(logunit,'(3a)') subname,' model_maskfile = ',trim(model_maskfile) + write(logunit,'(2a,i0)') subname,' nx_global = ',nx_global + write(logunit,'(2a,i0)') subname,' ny_global = ',ny_global + write(logunit,'(3a)') subname,' restfilm = ',trim(restfilm) + write(logunit,'(2a,l6)') subname,' skip_restart_read = ',skip_restart_read + write(logunit,'(3a)') subname,' import_data_fields = ',trim(import_data_fields) + write(logunit,'(2a,es13.6)') subname,' sst_constant_value = ',sst_constant_value + write(logunit,'(2a,l6)') subname,' export_all = ',export_all bcasttmp = 0 bcasttmp(1) = nx_global @@ -263,7 +265,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Broadcast namelist input call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, datamode, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, model_meshfile, CX, main_task, rc=rc) @@ -274,10 +275,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, import_data_fields, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, bcasttmp, 4, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, rtmp, 1, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -299,51 +298,54 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) datamode = "sst_aquap_analytic" end if - ! Validate datamode - if ( trim(datamode) == 'sstdata' .or. & ! read stream, no import data - trim(datamode) == 'iaf' .or. & ! read stream, needs import data? - trim(datamode) == 'sst_aquap_file' .or. & ! read stream, no import data - trim(datamode) == 'som' .or. & ! read stream, needs import data - trim(datamode) == 'som_aquap' .or. & ! read stream, needs import data - trim(datamode) == 'cplhist' .or. & ! read stream, needs import data - trim(datamode) == 'sst_aquap_analytic' .or. & ! analytic, no streams, import or export data - trim(datamode) == 'sst_aquap_constant' .or. & ! analytic, no streams, import or export data - trim(datamode) == 'multilev_cplhist' .or. & ! multilevel ocean input - trim(datamode) == 'multilev' .or. & ! multilevel ocean input - trim(datamode) == 'multilev_dom') then ! multilevel ocean input and sst export - ! success do nothing - else + ! Validate datamode - the following values are currently accepted + ! Unless specifically noted below, no import data is needed from the mediator + ! 'sstdata' read stream + ! 'sst_aquap_file' read stream + ! 'som' read stream, needs import data from mediator + ! 'som_aquap' read stream, needs import data from mediator + ! 'cplhist' read stream + ! 'sst_aquap_analytic' analytic, no streams + ! 'sst_aquap_constant' analytic, no streams + ! 'multilev_cplhist' read stream, multilevel ocean export of cplhist data + ! 'multilev' read stream, multilevel ocean export + ! 'multilev_sstdata' read stream, multilevel ocean and sst export + + select case (trim(datamode)) + case ( 'sstdata', 'sst_aquap_file', 'som', 'som_aquap', & + 'cplhist', 'sst_aquap_analytic', 'sst_aquap_constant', & + 'multilev_cplhist', 'multilev', 'multilev_sstdata' ) + if (mainproc) write(logunit,'(3a)') subname,'docn datamode = ',trim(datamode) + case default call shr_log_error(' ERROR illegal docn datamode = '//trim(datamode), rc=rc) return - endif + end select ! Advertise docn fields - if (trim(datamode)=='sst_aquap_analytic' .or. trim(datamode)=='sst_aquap_constant') then + select case (trim(datamode)) + case('sst_aquap_analytic','sst_aquap_constant') aquaplanet = .true. call docn_datamode_aquaplanet_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode(1:3)) == 'som') then - call docn_datamode_som_advertise(importState, exportState, fldsImport, fldsExport, flds_scalar_name, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'sstdata' .or. trim(datamode) == 'sst_aquap_file') then - call docn_datamode_copyall_advertise(exportState, fldsExport, flds_scalar_name, rc) + case('sstdata','sst_aquap_file') + call docn_datamode_sstdata_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'iaf') then - call docn_datamode_iaf_advertise(importState, exportState, fldsImport, fldsExport, flds_scalar_name, rc) + case('som','som_aquap') + call docn_datamode_som_advertise(importState, exportState, fldsImport, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'cplhist') then + case('cplhist') call docn_datamode_cplhist_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'multilev') then + case('multilev') call docn_datamode_multilev_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'multilev_cplhist') then + case('multilev_cplhist') call docn_datamode_multilev_cplhist_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'multilev_dom') then - call docn_datamode_multilev_dom_advertise(exportState, fldsExport, flds_scalar_name, rc) + case('multilev_sstdata') + call docn_datamode_multilev_sstdata_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + end select if (trim(import_data_fields) /= 'none') then call docn_import_data_advertise(importState, fldsImport, flds_scalar_name, import_data_fields, rc) @@ -380,7 +382,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_VMLogMemInfo("Entering "//trim(subname)) + call ESMF_VMLogMemInfo("Entering "//subname) ! Initialize model mesh, restart flag, logunit, model_mask and model_frac call ESMF_TraceRegionEnter('docn_strdata_init') @@ -442,7 +444,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! ******************* ! *** RETURN HERE *** ! ******************* - call ESMF_VMLogMemInfo("Leaving "//trim(subname)) + call ESMF_VMLogMemInfo("Leaving "//subname) RETURN end if @@ -462,7 +464,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_SetScalar(dble(ny_global),flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMLogMemInfo("Leaving "//trim(subname)) + call ESMF_VMLogMemInfo("Leaving "//subname) end subroutine InitializeRealize !=============================================================================== @@ -486,15 +488,13 @@ subroutine ModelAdvance(gcomp, rc) character(len=*),parameter :: subname=trim(module_name)//':(ModelAdvance) ' !------------------------------------------------------------------------------- - rc = ESMF_SUCCESS - call shr_log_setLogUnit(logunit) + call shr_log_setLogUnit(logunit) if (.not. valid_ocn) then RETURN end if - - call memcheck(subname, 5, my_task == main_task) + call memcheck(subname, 5, mainproc) ! query the Component for its clock, importState and exportState call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) @@ -536,9 +536,9 @@ subroutine docn_comp_run(gcomp, importState, exportState, clock, target_ymd, tar integer , intent(out) :: rc ! local variables - logical :: first_time = .true. + logical :: do_restart_read character(len=CL) :: rpfile ! restart pointer file name - character(*), parameter :: subName = "(docn_comp_run) " + character(len=*), parameter :: subName = "(docn_comp_run) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -549,62 +549,54 @@ subroutine docn_comp_run(gcomp, importState, exportState, clock, target_ymd, tar ! First time initialization !-------------------- - if (first_time) then + if (first_call) then - if (trim(datamode) /= 'multilev_cplhist') then - ! with multilev_cplhist we explicitly create initilize dfields - ! within the rpointer call - call docn_init_dfields(importState, exportState, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif ! Initialize datamode module pointers select case (trim(datamode)) case('sstdata', 'sst_aquap_file') - call docn_datamode_copyall_init_pointers(exportState, model_frac, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('iaf') - call docn_datamode_iaf_init_pointers(importState, exportState, model_frac, rc) + call docn_datamode_sstdata_init_pointers(exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('som', 'som_aquap') call docn_datamode_som_init_pointers(importState, exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('sst_aquap_analytic', 'sst_aquap_constant') - skip_restart_read=.true. call docn_datamode_aquaplanet_init_pointers(exportState, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('cplhist') - call docn_datamode_cplhist_init_pointers(exportState, model_frac, rc) + call docn_datamode_cplhist_init_pointers(exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('multilev') - call docn_datamode_multilev_init_pointers(exportState, sdat, model_frac, rc) + call docn_datamode_multilev_init_pointers(exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('multilev_dom') - call docn_datamode_multilev_dom_init_pointers(exportState, sdat, model_frac, rc) + case('multilev_sstdata') + call docn_datamode_multilev_sstdata_init_pointers(exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('multilev_cplhist') - call docn_datamode_multilev_cplhist_init_pointers(dfields, & - exportState, sdat, model_frac, logunit, mainproc, rc) + call docn_datamode_multilev_cplhist_init_pointers(exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Note that there is no call to docn_init_dfields since the - ! initialization of dfields is done in the above routine end select ! Read restart if needed - if (restart_read .and. .not. skip_restart_read) then + do_restart_read = restart_read .and. .not. skip_restart_read + if (datamode == 'sst_aquap_analytic' .or. datamode == 'sst_aquap_constant') then + do_restart_read = .false. + end if + + if (do_restart_read) then call shr_get_rpointer_name(gcomp, 'ocn', target_ymd, target_tod, rpfile, 'read', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return select case (trim(datamode)) - case('sstdata', 'sst_aquap_file', 'iaf', 'cplhist', 'multilev', 'mulitilev_dom', 'multilev_cplhist') + case('sstdata', 'sst_aquap_file', 'cplhist', 'multilev', 'mulitilev_sstdata', 'multilev_cplhist') call dshr_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('som', 'som_aquap') - call docn_datamode_som_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat) + call docn_datamode_som_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end select end if - ! Reset first_time - first_time = .false. + first_call = .false. end if !-------------------- @@ -617,22 +609,10 @@ subroutine docn_comp_run(gcomp, importState, exportState, clock, target_ymd, tar if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TraceRegionExit('docn_strdata_advance') - ! Copy all fields from streams to export state as default - ! This automatically will update the fields in the export state - call ESMF_TraceRegionEnter('docn_dfield_copy') - if (.not. aquaplanet) then - call dshr_dfield_copy(dfields, sdat, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - call ESMF_TraceRegionExit('docn_dfield_copy') - ! Perform data mode specific calculations select case (trim(datamode)) case('sstdata','sst_aquap_file') - call docn_datamode_copyall_advance(rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('iaf') - call docn_datamode_iaf_advance(rc) + call docn_datamode_sstdata_advance(rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('som','som_aquap') call docn_datamode_som_advance(importState, exportState, clock, restart_read, datamode, rc) @@ -649,8 +629,8 @@ subroutine docn_comp_run(gcomp, importState, exportState, clock, target_ymd, tar case('multilev') call docn_datamode_multilev_advance(sdat, logunit, mainproc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('multilev_dom') - call docn_datamode_multilev_dom_advance(sdat, logunit, mainproc, rc=rc) + case('multilev_sstdata') + call docn_datamode_multilev_sstdata_advance(sdat, logunit, mainproc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('multilev_cplhist') call docn_datamode_multilev_cplhist_advance(exportState, rc=rc) @@ -663,21 +643,21 @@ subroutine docn_comp_run(gcomp, importState, exportState, clock, target_ymd, tar if (ChkErr(rc,__LINE__,u_FILE_u)) return select case (trim(datamode)) - case('sstdata', 'sst_aquap_file', 'iaf', 'cplhist', 'multilev', 'mulitilev_dom', 'multilev_cplhist') + case('sstdata', 'sst_aquap_file', 'cplhist', 'multilev', 'mulitilev_sstdata', 'multilev_cplhist') call dshr_restart_write(rpfile, case_name, 'docn', inst_suffix, target_ymd, target_tod, logunit, & my_task, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('som', 'som_aquap') call docn_datamode_som_restart_write(rpfile, case_name, inst_suffix, target_ymd, target_tod, & - logunit, my_task, sdat) - case('sst_aquap_analytic', 'sst_aquap_constant') - ! Do nothing - case default - call shr_log_error(subName//'datamode '//trim(datamode)//' not recognized', rc=rc) - return - end select - - endif + logunit, my_task, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + case('sst_aquap_analytic', 'sst_aquap_constant') + ! Do nothing + case default + call shr_log_error(subName//'datamode '//trim(datamode)//' not recognized', rc=rc) + return + end select + endif call ESMF_TraceRegionExit('DOCN_RUN') @@ -687,57 +667,6 @@ subroutine docn_comp_run(gcomp, importState, exportState, clock, target_ymd, tar if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - contains - - subroutine docn_init_dfields(importState, exportState, rc) - ! ----------------------------- - ! Initialize dfields arrays - ! ----------------------------- - - ! input/output variables - type(ESMF_State) , intent(inout) :: importState - type(ESMF_State) , intent(inout) :: exportState - integer , intent(out) :: rc - - ! local variables - integer :: n - integer :: fieldcount - integer :: dimcount - type(ESMF_Field) :: lfield - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(ESMF_MAXSTR) :: fieldname(1) - character(*), parameter :: subName = "(docn_init_dfields) " - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Initialize dfields data type (to map streams to export state fields) - ! Create dfields linked list - used for copying stream fields to export state fields - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, fieldCount - call ESMF_StateGet(exportState, itemName=trim(lfieldNameList(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(lfieldnamelist(n)) /= flds_scalar_name) then - call ESMF_FieldGet(lfield, dimcount=dimCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dimcount == 2) then - fieldname(1) = trim(lfieldnamelist(n)) - call dshr_dfield_add( dfields, sdat, trim(lfieldnamelist(n)), fieldname, exportState, & - logunit, mainproc, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call dshr_dfield_add( dfields, sdat, trim(lfieldnamelist(n)), trim(lfieldnamelist(n)), exportState, & - logunit, mainproc, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - end if - end do - end subroutine docn_init_dfields - end subroutine docn_comp_run !=============================================================================== @@ -746,7 +675,7 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (my_task == main_task) then + if (mainproc) then write(logunit,*) write(logunit,*) 'docn : end of main integration loop' write(logunit,*) diff --git a/drof/CMakeLists.txt b/drof/CMakeLists.txt index 444c855e6..93fcd4af9 100644 --- a/drof/CMakeLists.txt +++ b/drof/CMakeLists.txt @@ -1,5 +1,7 @@ project(drof Fortran) -set(SRCFILES rof_comp_nuopc.F90) +set(SRCFILES rof_comp_nuopc.F90 + drof_datamode_copyall.F90 + drof_datamode_cplhist.F90) foreach(FILE ${SRCFILES}) if(EXISTS "${CASEROOT}/SourceMods/src.drof/${FILE}") diff --git a/drof/cime_config/config_component.xml b/drof/cime_config/config_component.xml index 285649aa8..a5772acb3 100644 --- a/drof/cime_config/config_component.xml +++ b/drof/cime_config/config_component.xml @@ -14,23 +14,23 @@ Data runoff model - NULL mode - COREv2 normal year forcing: - COREv2 interannual year forcing: - COREv2 interannual year forcing: - COREv2 interannual year forcing: - COREv2 interannual year forcing: - CPLHIST mode: - JRA55 interannual forcing, v1.4, through 2018 - JRA55 interannual forcing, v1.4, through 2018, no rofi around AIS - JRA55 interannual forcing, v1.4, through 2018, no rofl around AIS - JRA55 interannual forcing, v1.4, through 2018, no rofi or rofl around AIS - JRA55 interannual forcing, v1.5, through 2023 - JRA55 interannual forcing - JRA55 Repeat Year Forcing v1.3 1961-1962 - JRA55 Repeat Year Forcing v1.3 1984-1985 - JRA55 Repeat Year Forcing v1.3 1990-1991 - JRA55 Repeat Year Forcing v1.3 2003-2004 + NULL mode + COREv2 normal year forcing: + COREv2 interannual year forcing: + COREv2 interannual year forcing: + COREv2 interannual year forcing: + COREv2 interannual year forcing: + JRA55 interannual forcing, v1.4, through 2018 + JRA55 interannual forcing, v1.4, through 2018, no rofi around AIS + JRA55 interannual forcing, v1.4, through 2018, no rofl around AIS + JRA55 interannual forcing, v1.4, through 2018, no rofi or rofl around AIS + JRA55 interannual forcing, v1.5, through 2023 + JRA55 interannual forcing + JRA55 Repeat Year Forcing v1.3 1961-1962 + JRA55 Repeat Year Forcing v1.3 1984-1985 + JRA55 Repeat Year Forcing v1.3 1990-1991 + JRA55 Repeat Year Forcing v1.3 2003-2004 + CPLHIST mode: @@ -47,27 +47,27 @@ CPLHIST,DIATREN_ANN_RX1,DIATREN_IAF_RX1,DIATREN_IAF_AIS00_RX1,DIATREN_IAF_AIS45_RX1,DIATREN_IAF_AIS55_RX1,IAF_JRA,IAF_JRA_1p4_2018,IAF_JRA_1p4_2018_AIS0ICE,IAF_JRA_1p4_2018_AIS0LIQ,IAF_JRA_1p4_2018_AIS0ROF,IAF_JRA_1p5_2023,RYF6162_JRA,RYF8485_JRA,RYF9091_JRA,RYF0304_JRA,NULL DIATREN_ANN_RX1 - NULL - DIATREN_ANN_RX1 - DIATREN_ANN_AIS00_RX1 - DIATREN_ANN_AIS45_RX1 - DIATREN_ANN_AIS55_RX1 - DIATREN_IAF_RX1 - DIATREN_IAF_AIS00_RX1 - DIATREN_IAF_AIS45_RX1 - DIATREN_IAF_AIS55_RX1 - CPLHIST + NULL + DIATREN_ANN_RX1 + DIATREN_ANN_AIS00_RX1 + DIATREN_ANN_AIS45_RX1 + DIATREN_ANN_AIS55_RX1 + DIATREN_IAF_RX1 + DIATREN_IAF_AIS00_RX1 + DIATREN_IAF_AIS45_RX1 + DIATREN_IAF_AIS55_RX1 IAF_JRA IAF_JRA_1p4_2018 IAF_JRA_1p4_2018_AIS0ICE IAF_JRA_1p4_2018_AIS0LIQ IAF_JRA_1p4_2018_AIS0ROF IAF_JRA_1p5_2023 - RYF6162_JRA - RYF8485_JRA - RYF9091_JRA - RYF0304_JRA - NULL + RYF6162_JRA + RYF8485_JRA + RYF9091_JRA + RYF0304_JRA + CPLHIST + NULL run_component_drof env_run.xml diff --git a/drof/cime_config/namelist_definition_drof.xml b/drof/cime_config/namelist_definition_drof.xml index 56f8646c6..5a09f8309 100644 --- a/drof/cime_config/namelist_definition_drof.xml +++ b/drof/cime_config/namelist_definition_drof.xml @@ -6,7 +6,7 @@ char(100) streams streams_file - List of streams used for the given drof_mode. + List of streams used for the given drof_mode (determined by the xml variable $DROF_MODE) rof.cplhist rof.diatren_ann_rx1 @@ -31,16 +31,19 @@ char drof drof_nml - copyall + copyall,cplhist The runoff data is associated with the river model. Copies all fields directly from the input data streams Any required fields not found on an input stream will be set to zero. - The only datamode is copyall - the streams are determined by the xml variable $DROF_MODE - dataMode = "copyall" + The two modes are copyall and cplhist. In cplhist mode, more fields are advertised + to the mediator than in copyall mode. + The streams are determined by the xml variable $DROF_MODE + dataMode = "copyall,cplhist" copyall + cplhist diff --git a/drof/cime_config/stream_definition_drof.xml b/drof/cime_config/stream_definition_drof.xml index b9f7ddab2..0594b6ce9 100644 --- a/drof/cime_config/stream_definition_drof.xml +++ b/drof/cime_config/stream_definition_drof.xml @@ -641,8 +641,13 @@ $DROF_CPLHIST_DIR/$DROF_CPLHIST_CASE.cpl.hx.rof.24h.avrg.%ymd-00000.nc - rofImp_Forr_rofl Forr_rofl - rofImp_Forr_rofi Forr_rofi + rofImp_Forr_rofl Forr_rofl + rofImp_Forr_rofl_glc Forr_rofl_glc + rofImp_Forr_rofi Forr_rofi + rofImp_Forr_rofi_glc Forr_rofi_glc + rofImp_Flrr_flood Flrr_flood + rofImp_Flrr_volr Flrr_volr + rofImp_Flrr_volrmch Flrr_volrmch null diff --git a/drof/cime_config/testdefs/testlist_drof.xml b/drof/cime_config/testdefs/testlist_drof.xml index 6e423fabe..21252bc61 100644 --- a/drof/cime_config/testdefs/testlist_drof.xml +++ b/drof/cime_config/testdefs/testlist_drof.xml @@ -10,5 +10,13 @@ + + + + + + + + diff --git a/drof/cime_config/testdefs/testmods_dirs/drof/cplhist_noresm/shell_commands b/drof/cime_config/testdefs/testmods_dirs/drof/cplhist_noresm/shell_commands new file mode 100644 index 000000000..54ed06869 --- /dev/null +++ b/drof/cime_config/testdefs/testmods_dirs/drof/cplhist_noresm/shell_commands @@ -0,0 +1,6 @@ +./xmlchange DROF_CPLHIST_DIR=\$DIN_LOC_ROOT/cplhist/noresm3_0/n1850.ne16pg3_tn14.noresm3_0_beta03b.CPLHIST.2025-10-29/cplhist +./xmlchange DROF_CPLHIST_CASE=n1850.ne16pg3_tn14.noresm3_0_beta03b.CPLHIST.2025-10-29 +./xmlchange DROF_CPLHIST_YR_START=350 +./xmlchange DROF_CPLHIST_YR_END=351 +./xmlchange DROF_CPLHIST_YR_ALIGN=1 +./xmlchange ROF_DOMAIN_MESH=\$DIN_LOC_ROOT/share/meshes/r05_nomask_c110308_ESMFmesh.nc \ No newline at end of file diff --git a/drof/drof_datamode_copyall.F90 b/drof/drof_datamode_copyall.F90 new file mode 100644 index 000000000..91608e6e9 --- /dev/null +++ b/drof/drof_datamode_copyall.F90 @@ -0,0 +1,123 @@ +module drof_datamode_copyall_mod + + use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS + use NUOPC , only : NUOPC_Advertise + use shr_kind_mod , only : r8=>shr_kind_r8 + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer + use shr_const_mod , only : SHR_CONST_SPVAL + + implicit none + private + + public :: drof_datamode_copyall_advertise + public :: drof_datamode_copyall_init_pointers + public :: drof_datamode_copyall_advance + + ! export state pointer arrays + real(r8), pointer :: Forr_rofl(:) => null() + real(r8), pointer :: Forr_rofi(:) => null() + + ! stream pointer arrays + real(r8), pointer :: strm_Forr_rofl(:) => null() ! always required + real(r8), pointer :: strm_Forr_rofi(:) => null() ! sometimes present in stream + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine drof_datamode_copyall_advertise(exportState, fldsexport, flds_scalar_name, rc) + + ! input/output variables + type(esmf_State) , intent(inout) :: exportState + type(fldlist_type) , pointer :: fldsexport + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(out) :: rc + + ! local variables + type(fldlist_type), pointer :: fldList + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Advertise export fields + call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) + call dshr_fldlist_add(fldsExport, "Forr_rofl") + call dshr_fldlist_add(fldsExport, "Forr_rofi") + + fldlist => fldsExport ! the head of the linked list + do while (associated(fldlist)) + call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('(drof_comp_advertise): Fr_ocn'//trim(fldList%stdname), ESMF_LOGMSG_INFO) + fldList => fldList%next + enddo + + end subroutine drof_datamode_copyall_advertise + + !=============================================================================== + subroutine drof_datamode_copyall_init_pointers(exportState, sdat, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(drof_init_pointers): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Initialize module ponters + call dshr_state_getfldptr(exportState, 'Forr_rofl' , fldptr1=Forr_rofl , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Forr_rofi' , fldptr1=Forr_rofi , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize module pointers + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofl', strm_Forr_rofl, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Forr_rofl must be associated for drof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofi', strm_Forr_rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. associated(strm_Forr_rofi)) then + Forr_rofi(:) = 0._r8 + end if + + end subroutine drof_datamode_copyall_init_pointers + + !=============================================================================== + subroutine drof_datamode_copyall_advance() + + ! local variables + integer :: ni + !------------------------------------------------------------------------------- + + ! zero out "special values" of export fields + do ni = 1, size(Forr_rofl) + if (abs(strm_Forr_rofl(ni)) < 1.e28_r8) then + Forr_rofl(ni) = strm_Forr_rofl(ni) + else + Forr_rofl(ni) = 0.0_r8 + end if + enddo + + if (associated(strm_Forr_rofi)) then + do ni = 1, size(Forr_rofi) + if (abs(strm_Forr_rofi(ni)) < 1.e28_r8) then + Forr_rofi(ni) = strm_Forr_rofi(ni) + else + Forr_rofi(ni) = 0.0_r8 + end if + end do + end if + + end subroutine drof_datamode_copyall_advance + +end module drof_datamode_copyall_mod diff --git a/drof/drof_datamode_cplhist.F90 b/drof/drof_datamode_cplhist.F90 new file mode 100644 index 000000000..d794adef3 --- /dev/null +++ b/drof/drof_datamode_cplhist.F90 @@ -0,0 +1,198 @@ +module drof_datamode_cplhist_mod + + use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS + use NUOPC , only : NUOPC_Advertise + use shr_kind_mod , only : r8=>shr_kind_r8 + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer + use shr_const_mod , only : SHR_CONST_SPVAL + + implicit none + private + + public :: drof_datamode_cplhist_advertise + public :: drof_datamode_cplhist_init_pointers + public :: drof_datamode_cplhist_advance + + ! export state pointer arrays + real(r8), pointer :: Forr_rofl(:) => null() ! mediator sends this to ocn + real(r8), pointer :: Forr_rofl_glc(:) => null() ! mediator sends this to ocn + real(r8), pointer :: Forr_rofi(:) => null() ! mediator sends this to ocn + real(r8), pointer :: Forr_rofi_glc(:) => null() ! mediator sends this to ocn + real(r8), pointer :: Flrr_flood(:) => null() ! mediator sends this to lnd + real(r8), pointer :: Flrr_volr(:) => null() ! mediator sends this to lnd + real(r8), pointer :: Flrr_volrmch(:) => null() ! mediator sends this to lnd + + ! stream pointer arrays + real(r8), pointer :: strm_Forr_rofl(:) => null() + real(r8), pointer :: strm_Forr_rofi(:) => null() + real(r8), pointer :: strm_Forr_rofl_glc(:) => null() + real(r8), pointer :: strm_Forr_rofi_glc(:) => null() + real(r8), pointer :: strm_Flrr_flood(:) => null() + real(r8), pointer :: strm_Flrr_volr(:) => null() + real(r8), pointer :: strm_Flrr_volrmch(:) => null() + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine drof_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_name, rc) + + ! input/output variables + type(esmf_State) , intent(inout) :: exportState + type(fldlist_type) , pointer :: fldsexport + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(out) :: rc + + ! local variables + type(fldlist_type), pointer :: fldList + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Advertise export fields + call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) + call dshr_fldlist_add(fldsExport, "Forr_rofl") + call dshr_fldlist_add(fldsExport, "Forr_rofl_glc") + call dshr_fldlist_add(fldsExport, "Forr_rofi") + call dshr_fldlist_add(fldsExport, "Forr_rofi_glc") + call dshr_fldlist_add(fldsExport, "Flrr_flood") + call dshr_fldlist_add(fldsExport, "Flrr_volr") + call dshr_fldlist_add(fldsExport, "Flrr_volrmch") + + fldlist => fldsExport ! the head of the linked list + do while (associated(fldlist)) + call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('(drof_comp_advertise): Fr_drof'//trim(fldList%stdname), ESMF_LOGMSG_INFO) + fldList => fldList%next + enddo + + end subroutine drof_datamode_cplhist_advertise + + !=============================================================================== + subroutine drof_datamode_cplhist_init_pointers(exportState, sdat, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(drof_datamode_cplhist_init_pointers): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Initialize module export state pointers + call dshr_state_getfldptr(exportState, 'Forr_rofl' , fldptr1=Forr_rofl , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Forr_rofl_glc', fldptr1=Forr_rofl_glc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Forr_rofi' , fldptr1=Forr_rofi , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Forr_rofi_glc', fldptr1=Forr_rofi_glc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Flrr_flood' , fldptr1=Flrr_flood , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Flrr_volr' , fldptr1=Flrr_volr , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Flrr_volrmch' , fldptr1=Flrr_volrmch, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize module stream pointers + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofl', strm_Forr_rofl, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Forr_rofl must be associated for drof cplhist mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofl_glc', strm_Forr_rofl_glc, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Forr_rofl_glc must be associated for drof cplhist mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofi', strm_Forr_rofi, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Forr_rofi must be associated for drof cplhist mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofi_glc', strm_Forr_rofi_glc, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Forr_rofi_glc must be associated for drof cplhist mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Flrr_flood', strm_Flrr_flood, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Flrr_flood must be associated for drof cplhist mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Flrr_volr', strm_Flrr_volr, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Flrr_volr must be associated for drof cplhist mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Flrr_volrmch', strm_Flrr_volrmch, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Flrr_volrmch must be associated for drof cplhist mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine drof_datamode_cplhist_init_pointers + + !=============================================================================== + subroutine drof_datamode_cplhist_advance() + + ! local variables + integer :: ni + !------------------------------------------------------------------------------- + + ! zero out "special values" of export fields + do ni = 1, size(Forr_rofl) + if (abs(strm_Forr_rofl(ni)) < 1.e28_r8) then + Forr_rofl(ni) = strm_Forr_rofl(ni) + else + Forr_rofl(ni) = 0.0_r8 + end if + enddo + + do ni = 1, size(Forr_rofl_glc) + if (abs(strm_Forr_rofl_glc(ni)) < 1.e28_r8) then + Forr_rofl_glc(ni) = strm_Forr_rofl_glc(ni) + else + Forr_rofl_glc(ni) = 0.0_r8 + end if + end do + + do ni = 1, size(Forr_rofi) + if (abs(strm_Forr_rofi(ni)) < 1.e28_r8) then + Forr_rofi(ni) = strm_Forr_rofi(ni) + else + Forr_rofi(ni) = 0.0_r8 + end if + end do + + do ni = 1, size(Forr_rofi_glc) + if (abs(strm_Forr_rofi_glc(ni)) < 1.e28_r8) then + Forr_rofi_glc(ni) = strm_Forr_rofi_glc(ni) + else + Forr_rofi_glc(ni) = 0.0_r8 + end if + end do + + do ni = 1, size(Flrr_flood) + if (abs(strm_Flrr_flood(ni)) < 1.e28_r8) then + Flrr_flood(ni) = strm_Flrr_flood(ni) + else + Flrr_flood(ni) = 0.0_r8 + end if + enddo + + do ni = 1, size(Flrr_volr) + if (abs(strm_Flrr_volr(ni)) < 1.e28_r8) then + Flrr_volr(ni) = strm_Flrr_volr(ni) + else + Flrr_volr(ni) = 0.0_r8 + end if + enddo + + do ni = 1, size(Flrr_volrmch) + if (abs(strm_Flrr_volrmch(ni)) < 1.e28_r8) then + Flrr_volrmch(ni) = strm_Flrr_volrmch(ni) + else + Flrr_volrmch(ni) = 0.0_r8 + end if + enddo + + end subroutine drof_datamode_cplhist_advance + +end module drof_datamode_cplhist_mod diff --git a/drof/rof_comp_nuopc.F90 b/drof/rof_comp_nuopc.F90 index 4b5852c84..06d837069 100644 --- a/drof/rof_comp_nuopc.F90 +++ b/drof/rof_comp_nuopc.F90 @@ -7,6 +7,7 @@ module cdeps_drof_comp !---------------------------------------------------------------------------- ! This is the NUOPC cap for DROF !---------------------------------------------------------------------------- + use ESMF , only : ESMF_VM, ESMF_VMBroadcast, ESMF_GridCompGet use ESMF , only : ESMF_Mesh, ESMF_GridComp, ESMF_Time, ESMF_TimeInterval use ESMF , only : ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LOGMSG_INFO @@ -22,26 +23,32 @@ module cdeps_drof_comp use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_kind_mod , only : cx=>shr_kind_cx - use shr_const_mod , only : SHR_CONST_SPVAL + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx use shr_cal_mod , only : shr_cal_ymd2date use shr_log_mod , only : shr_log_setLogUnit, shr_log_error - use dshr_methods_mod , only : dshr_state_getfldptr, dshr_state_diagnose, chkerr, memcheck - use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance - use dshr_strdata_mod , only : shr_strdata_init_from_config, shr_strdata_get_stream_pointer + use dshr_methods_mod , only : dshr_state_diagnose, chkerr, memcheck + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance, shr_strdata_init_from_config use dshr_mod , only : dshr_model_initphase, dshr_init use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_check_restart_alarm use dshr_mod , only : dshr_restart_read, dshr_restart_write, dshr_mesh_init - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy - use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add, dshr_fldlist_realize + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_realize use nuopc_shr_methods, only : shr_get_rpointer_name + ! Datamode specialized modules + use drof_datamode_copyall_mod, only : drof_datamode_copyall_advertise + use drof_datamode_copyall_mod, only : drof_datamode_copyall_init_pointers + use drof_datamode_copyall_mod, only : drof_datamode_copyall_advance + + use drof_datamode_cplhist_mod, only : drof_datamode_cplhist_advertise + use drof_datamode_cplhist_mod, only : drof_datamode_cplhist_init_pointers + use drof_datamode_cplhist_mod, only : drof_datamode_cplhist_advance + implicit none - private ! except + private public :: SetServices public :: SetVM + private :: InitializeAdvertise private :: InitializeRealize private :: ModelAdvance @@ -53,56 +60,48 @@ module cdeps_drof_comp !-------------------------------------------------------------------------- type(shr_strdata_type) :: sdat - type(ESMF_Mesh) :: model_mesh ! model mesh + type(ESMF_Mesh) :: model_mesh ! model mesh character(len=CS) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 integer :: flds_scalar_index_nx = 0 integer :: flds_scalar_index_ny = 0 - integer :: mpicom ! mpi communicator - integer :: my_task ! my task in mpi communicator mpicom - logical :: mainproc ! true of my_task == main_task - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") - integer :: logunit ! logging unit number + integer :: mpicom ! mpi communicator + integer :: my_task ! my task in mpi communicator mpicom + logical :: mainproc ! true of my_task == main_task + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + integer :: logunit ! logging unit number logical :: restart_read - character(CL) :: case_name ! case name - character(*) , parameter :: nullstr = 'null' - ! drof_in namelist input - character(CX) :: streamfilename = nullstr ! filename to obtain stream info from - character(CX) :: nlfilename = nullstr ! filename to obtain namelist info from - character(CL) :: dataMode = nullstr ! flags physics options wrt input data - character(CX) :: model_meshfile = nullstr ! full pathname to model meshfile - character(CX) :: model_maskfile = nullstr ! full pathname to obtain mask from - character(CX) :: restfilm = nullstr ! model restart file namelist + character(CL) :: case_name ! case name + character(len=*) , parameter :: nullstr = 'null' + ! drof_in namelist input + character(CX) :: streamfilename = nullstr ! filename to obtain stream info from + character(CX) :: nlfilename = nullstr ! filename to obtain namelist info from + character(CL) :: dataMode = nullstr ! flags physics options wrt input data + character(CX) :: model_meshfile = nullstr ! full pathname to model meshfile + character(CX) :: model_maskfile = nullstr ! full pathname to obtain mask from + character(CX) :: restfilm = nullstr ! model restart file namelist integer :: nx_global integer :: ny_global - logical :: skip_restart_read = .false. ! true => skip restart read - logical :: export_all = .false. ! true => export all fields, do not check connected or not - + logical :: skip_restart_read = .false. ! true => skip restart read + logical :: export_all = .false. ! true => export all fields, do not check connected or not logical :: diagnose_data = .true. - integer , parameter :: main_task=0 ! task number of main task + logical :: first_call = .true. + + integer , parameter :: main_task=0 ! task number of main task #ifdef CESMCOUPLED - character(*) , parameter :: modName = "(rof_comp_nuopc)" + character(len=*) , parameter :: modName = "(rof_comp_nuopc)" #else - character(*) , parameter :: modName = "(cdeps_drof_comp)" + character(len=*) , parameter :: modName = "(cdeps_drof_comp)" #endif ! linked lists type(fldList_type) , pointer :: fldsExport => null() - type(dfield_type) , pointer :: dfields => null() - ! model mask and model fraction - real(r8), pointer :: model_frac(:) => null() - integer , pointer :: model_mask(:) => null() + ! grid mask and fraction + real(r8), pointer :: model_frac(:) ! currently not used + integer , pointer :: model_mask(:) ! currently not used - ! export state pointer arrays - real(r8), pointer :: Forr_rofl(:) => null() - real(r8), pointer :: Forr_rofi(:) => null() - - ! stream pointer arrays - real(r8), pointer :: strm_Forr_rofl(:) => null() ! always required - real(r8), pointer :: strm_Forr_rofi(:) => null() ! sometimes present in stream - - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -156,7 +155,9 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nl_mod, only: shr_nl_find_group_name + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -167,14 +168,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: inst_index ! number of current instance (ie. 1) integer :: nu ! unit number integer :: ierr ! error code - type(fldlist_type), pointer :: fldList type(ESMF_VM) :: vm - integer :: bcasttmp(4) + integer :: bcasttmp(4) character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - character(*) ,parameter :: F00 = "('(" // trim(modName) // ") ',8a)" - character(*) ,parameter :: F01 = "('(" // trim(modName) // ") ',a,2x,i8)" - character(*) ,parameter :: F02 = "('(" // trim(modName) // ") ',a,l6)" - !------------------------------------------------------------------------------- + !-------------------------------- namelist / drof_nml / datamode, model_meshfile, model_maskfile, & restfilm, nx_global, ny_global, skip_restart_read, export_all @@ -203,24 +200,27 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) close(nu) if (ierr > 0) then rc = ierr + write(logunit,'(a,i0)') subname, & + ' ERROR: reading input namelist, '//trim(nlfilename)//' iostat=',ierr call shr_log_error(subName//': namelist read error '//trim(nlfilename), rc=rc) return end if ! write namelist input to standard out - write(logunit,F00)' datamode = ',trim(datamode) - write(logunit,F00)' model_meshfile = ',trim(model_meshfile) - write(logunit,F00)' model_maskfile = ',trim(model_maskfile) - write(logunit,F01)' nx_global = ',nx_global - write(logunit,F01)' ny_global = ',ny_global - write(logunit,F00)' restfilm = ',trim(restfilm) - write(logunit,F02)' skip_restart_read = ',skip_restart_read - write(logunit,F02)' export_all = ', export_all + write(logunit,'(3a)') subname,' datamode = ',trim(datamode) + write(logunit,'(3a)') subname,' model_meshfile = ',trim(model_meshfile) + write(logunit,'(3a)') subname,' model_maskfile = ',trim(model_maskfile) + write(logunit,'(2a,i0)') subname,' nx_global = ',nx_global + write(logunit,'(2a,i0)') subname,' ny_global = ',ny_global + write(logunit,'(3a)') subname,' restfilm = ',trim(restfilm) + write(logunit,'(2a,l6)') subname,' skip_restart_read = ',skip_restart_read + write(logunit,'(2a,l6)') subname,' export_all = ',export_all + bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global - if(skip_restart_read) bcasttmp(3) = 1 - if(export_all) bcasttmp(4) = 1 + if (skip_restart_read) bcasttmp(3) = 1 + if (export_all) bcasttmp(4) = 1 end if ! broadcast namelist input @@ -237,30 +237,30 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nx_global = bcasttmp(1) ny_global = bcasttmp(2) skip_restart_read = (bcasttmp(3) == 1) export_all = (bcasttmp(4) == 1) ! Validate datamode - if (trim(datamode) == 'copyall') then - if (mainproc) write(logunit,*) 'drof datamode = ',trim(datamode) - else + select case (trim(datamode)) + case('copyall','cplhist') + if (mainproc) write(logunit,'(2a)') subname,'drof datamode = ',trim(datamode) + case default call shr_log_error(' ERROR illegal drof datamode = '//trim(datamode), rc=rc) return - end if - - call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) - call dshr_fldlist_add(fldsExport, "Forr_rofl") - call dshr_fldlist_add(fldsExport, "Forr_rofi") + end select - fldlist => fldsExport ! the head of the linked list - do while (associated(fldlist)) - call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) + ! Advertise export fields + select case (trim(datamode)) + case('copyall') + call drof_datamode_copyall_advertise(exportState, fldsexport, flds_scalar_name, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + case('cplhist') + call drof_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('(drof_comp_advertise): Fr_rof '//trim(fldList%stdname), ESMF_LOGMSG_INFO) - fldList => fldList%next - enddo + end select end subroutine InitializeAdvertise @@ -280,9 +280,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: current_mon ! model month integer :: current_day ! model day integer :: current_tod ! model sec into model date - character(len=*), parameter :: F00 = "('" // trim(modName) // ": ')',8a)" character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- + !-------------------------------- rc = ESMF_SUCCESS @@ -345,12 +344,13 @@ subroutine ModelAdvance(gcomp, rc) integer :: day ! day in month logical :: restart_write ! restart alarm is ringing character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- + !-------------------------------- rc = ESMF_SUCCESS call memcheck(subname, 5, mainproc) call shr_log_setLogUnit(logunit) + ! 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 @@ -365,7 +365,7 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, next_ymd) - ! write restart if alarm is ringing + ! determine if restart if alarm is ringing restart_write = dshr_check_restart_alarm(clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -391,11 +391,11 @@ subroutine drof_comp_run(gcomp, exportState, target_ymd, target_tod, restart_wri integer , intent(out) :: rc ! local variables - logical :: first_time = .true. - integer :: n character(len=CL) :: rpfile - character(*), parameter :: subName = "(drof_comp_run) " - !------------------------------------------------------------------------------- + character(len=*), parameter :: subName = "(drof_comp_run) " + !-------------------------------- + + rc = ESMF_SUCCESS call ESMF_TraceRegionEnter('DROF_RUN') @@ -403,28 +403,19 @@ subroutine drof_comp_run(gcomp, exportState, target_ymd, target_tod, restart_wri ! First time initialization !-------------------- - if (first_time) then - ! Initialize dfields - call dshr_dfield_add(dfields, sdat, 'Forr_rofl', 'Forr_rofl', exportState, logunit, mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_dfield_add(dfields, sdat, 'Forr_rofi', 'Forr_rofi', exportState, logunit, mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Initialize module ponters - call dshr_state_getfldptr(exportState, 'Forr_rofl' , fldptr1=Forr_rofl , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call dshr_state_getfldptr(exportState, 'Forr_rofi' , fldptr1=Forr_rofi , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Initialize module pointers - call shr_strdata_get_stream_pointer( sdat, 'Forr_rofl', strm_Forr_rofl, requirePointer=.true., & - errmsg=trim(subname)//'ERROR: strm_Forr_rofl must be associated for drof', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Forr_rofi', strm_Forr_rofi, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. associated(strm_Forr_rofi)) then - Forr_rofi(:) = 0._r8 - end if + if (first_call) then + ! Initialize stream and export state pointers + select case (trim(datamode)) + case('copyall') + call drof_datamode_copyall_init_pointers(exportState, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + case('cplhist') + call drof_datamode_cplhist_init_pointers(exportState, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + case default + call shr_log_error(' ERROR illegal drof datamode = '//trim(datamode), rc=rc) + return + end select ! Read restart if needed if (restart_read .and. .not. skip_restart_read) then @@ -434,7 +425,7 @@ subroutine drof_comp_run(gcomp, exportState, target_ymd, target_tod, restart_wri if (chkerr(rc,__LINE__,u_FILE_u)) return end if - first_time = .false. + first_call = .false. end if !-------------------- @@ -444,35 +435,32 @@ subroutine drof_comp_run(gcomp, exportState, target_ymd, target_tod, restart_wri ! time and spatially interpolate to model time and grid call ESMF_TraceRegionEnter('drof_strdata_advance') call shr_strdata_advance(sdat, target_ymd, target_tod, logunit, 'drof', rc=rc) - call ESMF_TraceRegionExit('drof_strdata_advance') - - ! copy all fields from streams to export state as default - ! This automatically will update the fields in the export state - call ESMF_TraceRegionEnter('drof_dfield_copy') - call dshr_dfield_copy(dfields, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('drof_dfield_copy') + call ESMF_TraceRegionExit('drof_strdata_advance') - ! determine data model behavior based on the mode + ! perform data mode specific calculations call ESMF_TraceRegionEnter('drof_datamode') select case (trim(datamode)) case('copyall') - ! zero out "special values" of export fields - do n = 1, size(Forr_rofl) - if (abs(Forr_rofl(n)) > 1.0e28) Forr_rofl(n) = 0.0_r8 - if (abs(Forr_rofi(n)) > 1.0e28) Forr_rofi(n) = 0.0_r8 - enddo + call drof_datamode_copyall_advance() + case('cplhist') + call drof_datamode_cplhist_advance() + case default + call shr_log_error(' ERROR illegal drof datamode = '//trim(datamode), rc=rc) + return end select + call ESMF_TraceRegionExit('drof_datamode') ! write restarts if needed if (restart_write) then - if(trim(datamode) .eq. 'copyall') then + select case (trim(datamode)) + case('copyall','cplhist') call shr_get_rpointer_name(gcomp, 'rof', target_ymd, target_tod, rpfile, 'write', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_restart_write(rpfile, case_name, 'drof', inst_suffix, target_ymd, target_tod, & logunit, my_task, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end select end if ! write diagnostics @@ -481,15 +469,17 @@ subroutine drof_comp_run(gcomp, exportState, target_ymd, target_tod, restart_wri if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_TraceRegionExit('drof_datamode') call ESMF_TraceRegionExit('DROF_RUN') end subroutine drof_comp_run !=============================================================================== subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc + !-------------------------------- + rc = ESMF_SUCCESS if (mainproc) then write(logunit,*) diff --git a/dshr/dshr_dfield_mod.F90 b/dshr/dshr_dfield_mod.F90 index b10ca3160..9420dc185 100644 --- a/dshr/dshr_dfield_mod.F90 +++ b/dshr/dshr_dfield_mod.F90 @@ -40,7 +40,7 @@ module dshr_dfield_mod end type dfield_type integer , parameter :: iunset = -999 - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -117,7 +117,7 @@ subroutine dshr_dfield_add_1d(dfields, sdat, state_fld, strm_fld, state, logunit if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data1d = 0.0_r8 if (mainproc) then - write(logunit,'(3a)') trim(subname),' setting pointer for export state ',trim(state_fld) + write(logunit,'(3a)') subname,' setting pointer for export state ',trim(state_fld) end if end subroutine dshr_dfield_add_1d @@ -194,7 +194,7 @@ subroutine dshr_dfield_add_1d_stateptr(dfields, sdat, state_fld, strm_fld, state if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data1d = 0.0_r8 if (mainproc) then - write(logunit,'(3a)') trim(subname),' setting pointer for export state ',trim(state_fld) + write(logunit,'(3a)') subname,' setting pointer for export state ',trim(state_fld) end if ! Return array pointer if argument is present @@ -203,7 +203,7 @@ subroutine dshr_dfield_add_1d_stateptr(dfields, sdat, state_fld, strm_fld, state ! write output if (mainproc) then if (found) then - write(logunit,'(4a,i0,a,i0)') trim(subname),& + write(logunit,'(4a,i0,a,i0)') subname,& ' setting pointer to stream field strm_',trim(strm_fld), & ' stream index = ',ns,' field bundle index= ',nf end if @@ -297,7 +297,7 @@ subroutine dshr_dfield_add_2d(dfields, sdat, state_fld, strm_flds, state, & if (trim(strm_flds(nf)) == trim(lfieldnamelist(n))) then dfield_new%fldbun_indices(nf) = n if (mainproc) then - write(logunit,'(5a)') trim(subname), & + write(logunit,'(5a)') subname, & ' using stream field strm_',trim(strm_flds(nf)),' for 2d ',trim(state_fld) end if end if @@ -314,7 +314,7 @@ subroutine dshr_dfield_add_2d(dfields, sdat, state_fld, strm_flds, state, & if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data2d(:,:) = 0._r8 if (mainproc) then - write(logunit,'(3a)') trim(subname),' setting pointer for export state ',trim(state_fld) + write(logunit,'(3a)') subname,' setting pointer for export state ',trim(state_fld) end if end subroutine dshr_dfield_add_2d @@ -404,7 +404,7 @@ subroutine dshr_dfield_add_2d_stateptr(dfields, sdat, state_fld, strm_flds, stat if (trim(strm_flds(nf)) == trim(lfieldnamelist(n))) then dfield_new%fldbun_indices(nf) = n if (mainproc) then - write(logunit,'(5a)') trim(subname), & + write(logunit,'(5a)') subname, & ' using stream field strm_',trim(strm_flds(nf)),' for 2d ',trim(state_fld) end if end if @@ -421,7 +421,7 @@ subroutine dshr_dfield_add_2d_stateptr(dfields, sdat, state_fld, strm_flds, stat if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data2d(:,:) = 0._r8 if (mainproc) then - write(logunit,'(3a)') trim(subname),' setting pointer for export state ',trim(state_fld) + write(logunit,'(3a)') subname,' setting pointer for export state ',trim(state_fld) end if state_ptr => dfield_new%state_data2d diff --git a/dshr/dshr_fldlist_mod.F90 b/dshr/dshr_fldlist_mod.F90 index a06912fc1..fd15c3919 100644 --- a/dshr/dshr_fldlist_mod.F90 +++ b/dshr/dshr_fldlist_mod.F90 @@ -22,7 +22,7 @@ module dshr_fldlist_mod type(fldlist_type), pointer :: next => null() end type fldlist_type - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -87,7 +87,7 @@ subroutine dshr_fldlist_realize(state, fldLists, flds_scalar_name, flds_scalar_n end if if (stdname == trim(flds_scalar_name)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & + call ESMF_LogWrite(subname//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & ESMF_LOGMSG_INFO) ! Create the scalar field call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) @@ -103,7 +103,7 @@ subroutine dshr_fldlist_realize(state, fldLists, flds_scalar_name, flds_scalar_n 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 end if - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & + call ESMF_LogWrite(subname//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & ESMF_LOGMSG_INFO) endif diff --git a/dshr/dshr_mod.F90 b/dshr/dshr_mod.F90 index 214f5ba3d..c0f6afff3 100644 --- a/dshr/dshr_mod.F90 +++ b/dshr/dshr_mod.F90 @@ -78,7 +78,7 @@ module dshr_mod logical :: write_restart_at_endofrun integer , parameter :: main_task = 0 - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -99,7 +99,7 @@ subroutine dshr_model_initphase(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS ! To prevent an unused variable warning if(.not. (ESMF_StateIsCreated(importState) .or. ESMF_StateIsCreated(exportState) .or. ESMF_ClockIsCreated(clock))) then - call shr_log_error(trim(subname)//' state or clock not created', rc=rc) + call shr_log_error(subname//' state or clock not created', rc=rc) return endif @@ -154,7 +154,7 @@ subroutine dshr_init(gcomp, compname, mpicom, my_task, inst_index, inst_suffix, 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) + call ESMF_LogWrite(subname//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -163,7 +163,7 @@ subroutine dshr_init(gcomp, compname, mpicom, my_task, inst_index, inst_suffix, 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) + call ESMF_LogWrite(subname//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -172,7 +172,7 @@ subroutine dshr_init(gcomp, compname, mpicom, my_task, inst_index, inst_suffix, 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) + call ESMF_LogWrite(subname//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -181,7 +181,7 @@ subroutine dshr_init(gcomp, compname, mpicom, my_task, inst_index, inst_suffix, 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) + call ESMF_LogWrite(subname//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -203,7 +203,7 @@ subroutine dshr_init(gcomp, compname, mpicom, my_task, inst_index, inst_suffix, call set_component_logging(gcomp, my_task == main_task, logunit, slogunit, rc=rc) #else if (my_task == main_task) then - call ESMF_LogWrite(trim(subname)//' : output logging is written to '//trim(diro)//"/"//trim(logfile), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//' : output logging is written to '//trim(diro)//"/"//trim(logfile), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return open(newunit=logunit, file=trim(diro)//"/"//trim(logfile)) @@ -271,7 +271,7 @@ subroutine dshr_mesh_init(gcomp, sdat, nullstr, logunit, compname, model_nxg, mo logical :: isPresent, isSet logical :: exists ! check for file existence real(r8) :: scol_spval = -999._r8 - character(*) , parameter :: F00 ="('(dshr_mesh_init) ',a)" + character(len=*) , parameter :: F00 ="('(dshr_mesh_init) ',a)" character(len=*), parameter :: subname='(dshr_mod:dshr_mesh_init)' ! ---------------------------------------------- @@ -332,13 +332,13 @@ subroutine dshr_mesh_init(gcomp, sdat, nullstr, logunit, compname, model_nxg, mo inquire(file=trim(model_meshfile), exist=exists) if (.not.exists) then write(logunit, *)' ERROR: model_meshfile '//trim(model_meshfile)//' does not exist' - call shr_log_error(trim(subname)//' ERROR: model_meshfile '//trim(model_meshfile)//' does not exist', rc=rc) + call shr_log_error(subname//' ERROR: model_meshfile '//trim(model_meshfile)//' does not exist', rc=rc) return end if inquire(file=trim(model_maskfile), exist=exists) if (.not.exists) then write(logunit, *)' ERROR: model_maskfile '//trim(model_maskfile)//' does not exist' - call shr_log_error(trim(subname)//' ERROR: model_maskfile '//trim(model_maskfile)//' does not exist', rc=rc) + call shr_log_error(subname//' ERROR: model_maskfile '//trim(model_maskfile)//' does not exist', rc=rc) return end if endif @@ -356,9 +356,9 @@ subroutine dshr_mesh_init(gcomp, sdat, nullstr, logunit, compname, model_nxg, mo if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mainproc) then - write(logunit,F00) trim(subname)// " obtained "//trim(compname)//" mesh from "// & + write(logunit,F00) subname// " obtained "//trim(compname)//" mesh from "// & trim(model_meshfile) - write(logunit,F00) trim(subname)// " obtained "//trim(compname)//" mask from "// & + write(logunit,F00) subname// " obtained "//trim(compname)//" mask from "// & trim(model_maskfile) end if @@ -384,7 +384,7 @@ subroutine dshr_mesh_init(gcomp, sdat, nullstr, logunit, compname, model_nxg, mo if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mainproc) then - write(logunit,F00) trim(subname)// " obtained "//trim(compname)//" mesh and mask from "// & + write(logunit,F00) subname// " obtained "//trim(compname)//" mesh and mask from "// & trim(model_meshfile) end if end if @@ -601,8 +601,8 @@ subroutine dshr_restart_read(rest_filem, rpfile, & type(io_desc_t) :: pio_iodesc integer :: rcode integer :: tmp(1) - character(*), parameter :: F00 = "('(dshr_restart_read) ',8a)" - character(*), parameter :: subName = "(dshr_restart_read) " + character(len=*), parameter :: F00 = "('(dshr_restart_read) ',8a)" + character(len=*), parameter :: subName = "(dshr_restart_read) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS ! no streams means no restart file is read. @@ -682,7 +682,7 @@ subroutine dshr_restart_write(rpfile, case_name, model_name, inst_suffix, ymd, t type(io_desc_t) :: pio_iodesc integer :: oldmode integer :: rcode - character(*), parameter :: F00 = "('(dshr_restart_write) ',2a,2(i0,2x))" + character(len=*), parameter :: F00 = "('(dshr_restart_write) ',2a,2(i0,2x))" !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -788,7 +788,7 @@ subroutine dshr_state_getscalar(state, scalar_id, scalar_value, flds_scalar_name call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) + call ESMF_LogWrite(subname//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif @@ -837,7 +837,7 @@ subroutine dshr_state_setscalar(scalar_value, scalar_id, State, flds_scalar_name call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//": ERROR in scalar_id", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -891,8 +891,8 @@ subroutine dshr_orbital_init(gcomp, logunit, maintask, rc) if (trim(orb_mode) == trim(orb_fixed_year)) then if (orb_iyear == SHR_ORB_UNDEF_INT) then if (maintask) then - write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) - write(logunit,*) trim(subname),' ERROR: fixed_year settings = ',orb_iyear + write(logunit,*) subname,' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) 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) @@ -905,8 +905,8 @@ subroutine dshr_orbital_init(gcomp, logunit, maintask, rc) elseif (trim(orb_mode) == trim(orb_variable_year)) then if (orb_iyear == SHR_ORB_UNDEF_INT .or. orb_iyear_align == SHR_ORB_UNDEF_INT) then if (maintask) 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(logunit,*) subname,' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) 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) @@ -920,10 +920,10 @@ subroutine dshr_orbital_init(gcomp, logunit, maintask, rc) !-- force orb_iyear to undef to make sure shr_orb_params works properly if (orb_eccen == SHR_ORB_UNDEF_REAL .or. orb_obliq == SHR_ORB_UNDEF_REAL .or. orb_mvelp == SHR_ORB_UNDEF_REAL) then if (maintask) 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(logunit,*) subname,' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) subname,' ERROR: orb_eccen = ',orb_eccen + write(logunit,*) subname,' ERROR: orb_obliq = ',orb_obliq + write(logunit,*) 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) @@ -1182,7 +1182,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else if (trim(cvalue) .eq. '64BIT_DATA') then sdat%io_format = PIO_64BIT_DATA else - call ESMF_LogWrite(trim(subname)//'-'//trim(cname)// & + call ESMF_LogWrite(subname//'-'//trim(cname)// & ' : need to provide valid option for pio_ioformat'// & ' (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_INFO) rc = ESMF_FAILURE @@ -1192,7 +1192,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) cvalue = '64BIT_OFFSET' sdat%io_format = PIO_64BIT_OFFSET end if - if (my_task == main_task) write(logunit,*) trim(subname)//' : pio_netcdf_format = ', & + if (my_task == main_task) write(logunit,*) subname//' : pio_netcdf_format = ', & trim(cvalue), sdat%io_format ! pio_typename @@ -1211,7 +1211,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else if (trim(cvalue) .eq. 'NETCDF4P') then sdat%io_type = PIO_IOTYPE_NETCDF4P else - call ESMF_LogWrite(trim(subname)//'-'//trim(cname)// & + call ESMF_LogWrite(subname//'-'//trim(cname)// & ' : need to provide valid option for pio_typename'// & ' (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_INFO) rc = ESMF_FAILURE @@ -1221,7 +1221,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) cvalue = 'NETCDF' sdat%io_type = PIO_IOTYPE_NETCDF end if - if (my_task == main_task) write(logunit,*) trim(subname)//' : pio_typename = ', & + if (my_task == main_task) write(logunit,*) subname//' : pio_typename = ', & trim(cvalue), sdat%io_type ! pio_root @@ -1238,7 +1238,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else pio_root = 1 end if - if (my_task == main_task) write(logunit,*) trim(subname)//' : pio_root = ', & + if (my_task == main_task) write(logunit,*) subname//' : pio_root = ', & pio_root ! pio_stride @@ -1251,7 +1251,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else pio_stride = -99 end if - if (my_task == main_task) write(logunit,*) trim(subname)//' : pio_stride = ', & + if (my_task == main_task) write(logunit,*) subname//' : pio_stride = ', & pio_stride ! pio_numiotasks @@ -1264,7 +1264,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else pio_numiotasks = -99 end if - if (my_task == main_task) write(logunit,*) trim(subname)//' : pio_numiotasks = ', & + if (my_task == main_task) write(logunit,*) subname//' : pio_numiotasks = ', & pio_numiotasks ! check for parallel IO, it requires at least two io pes @@ -1275,23 +1275,23 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) pio_stride = min(pio_stride, petCount/2) if (my_task == main_task) then write(logunit,*) ' parallel io requires at least two io pes - following parameters are updated:' - write(logunit,*) trim(subname)//' : pio_stride = ', pio_stride - write(logunit,*) trim(subname)//' : pio_numiotasks = ', pio_numiotasks + write(logunit,*) subname//' : pio_stride = ', pio_stride + write(logunit,*) subname//' : pio_numiotasks = ', pio_numiotasks end if endif ! check/set/correct io pio parameters if (pio_stride > 0 .and. pio_numiotasks < 0) then pio_numiotasks = max(1, petCount/pio_stride) - if (my_task == main_task) write(logunit,*) trim(subname)//' : update pio_numiotasks = ', pio_numiotasks + if (my_task == main_task) write(logunit,*) subname//' : update pio_numiotasks = ', pio_numiotasks else if(pio_numiotasks > 0 .and. pio_stride < 0) then pio_stride = max(1, petCount/pio_numiotasks) - if (my_task == main_task) write(logunit,*) trim(subname)//' : update pio_stride = ', pio_stride + if (my_task == main_task) write(logunit,*) subname//' : update pio_stride = ', pio_stride else if(pio_numiotasks < 0 .and. pio_stride < 0) then pio_stride = max(1,petCount/4) pio_numiotasks = max(1,petCount/pio_stride) - if (my_task == main_task) write(logunit,*) trim(subname)//' : update pio_numiotasks = ', pio_numiotasks - if (my_task == main_task) write(logunit,*) trim(subname)//' : update pio_stride = ', pio_stride + if (my_task == main_task) write(logunit,*) subname//' : update pio_numiotasks = ', pio_numiotasks + if (my_task == main_task) write(logunit,*) subname//' : update pio_stride = ', pio_stride end if if (pio_stride == 1) then pio_root = 0 @@ -1316,15 +1316,15 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) end if if (my_task == main_task) then write(logunit,*) 'pio_stride, iotasks or root out of bounds - resetting to defaults:' - write(logunit,*) trim(subname)//' : pio_root = ', pio_root - write(logunit,*) trim(subname)//' : pio_stride = ', pio_stride - write(logunit,*) trim(subname)//' : pio_numiotasks = ', pio_numiotasks + write(logunit,*) subname//' : pio_root = ', pio_root + write(logunit,*) subname//' : pio_stride = ', pio_stride + write(logunit,*) subname//' : pio_numiotasks = ', pio_numiotasks end if end if ! init PIO allocate(sdat%pio_subsystem) - if (my_task == main_task) write(logunit,*) trim(subname)//' : calling pio init' + if (my_task == main_task) write(logunit,*) subname//' : calling pio init' call pio_init(my_task, mpicom, pio_numiotasks, 0, pio_stride, & pio_rearranger, sdat%pio_subsystem, base=pio_root) @@ -1337,7 +1337,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) if (isPresent .and. isSet) then read(cvalue,*) pio_debug_level if (pio_debug_level < 0 .or. pio_debug_level > 6) then - call ESMF_LogWrite(trim(subname)//': need to provide valid option for'// & + call ESMF_LogWrite(subname//': need to provide valid option for'// & ' pio_debug_level (0-6)', ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return @@ -1345,7 +1345,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else pio_debug_level = 0 end if - if (my_task == main_task) write(logunit,*) trim(subname), & + if (my_task == main_task) write(logunit,*) subname, & ' : pio_debug_level = ',pio_debug_level ! set PIO debug level @@ -1362,7 +1362,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else if (trim(cvalue) .eq. 'SUBSET') then pio_rearranger = PIO_REARR_SUBSET else - call ESMF_LogWrite(trim(subname)//'-'//trim(cname)// & + call ESMF_LogWrite(subname//'-'//trim(cname)// & ' : need to provide valid option for pio_rearranger'// & ' (BOX|SUBSET)', ESMF_LOGMSG_INFO) rc = ESMF_FAILURE @@ -1372,12 +1372,12 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) cvalue = 'BOX' pio_rearranger = PIO_REARR_BOX end if - if (my_task == main_task) write(logunit,*) trim(subname)//' : pio_rearranger = ', & + if (my_task == main_task) write(logunit,*) subname//' : pio_rearranger = ', & trim(cvalue), pio_rearranger ! init PIO allocate(sdat%pio_subsystem) - if (my_task == main_task) write(logunit,*) trim(subname)//' : calling pio init' + if (my_task == main_task) write(logunit,*) subname//' : calling pio init' call pio_init(my_task, mpicom, pio_numiotasks, 0, pio_stride, & pio_rearranger, sdat%pio_subsystem, base=pio_root) @@ -1394,7 +1394,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else if (trim(cvalue) .eq. 'COLL') then pio_rearr_comm_type = PIO_REARR_COMM_COLL else - call ESMF_LogWrite(trim(subname)//' : need to provide valid option for'// & + call ESMF_LogWrite(subname//' : need to provide valid option for'// & ' pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return @@ -1403,7 +1403,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) cvalue = 'P2P' pio_rearr_comm_type = PIO_REARR_COMM_P2P end if - if (my_task == main_task) write(logunit,*) trim(subname)// & + if (my_task == main_task) write(logunit,*) subname// & ' : pio_rearr_comm_type = ', trim(cvalue), pio_rearr_comm_type ! pio_rearr_comm_fcd @@ -1422,7 +1422,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) else if (trim(cvalue) .eq. '2DDISABLE') then pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_DISABLE else - call ESMF_LogWrite(trim(subname)//' : need to provide valid option for'// & + call ESMF_LogWrite(subname//' : need to provide valid option for'// & ' pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return @@ -1431,7 +1431,7 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) cvalue = '2DENABLE' pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_ENABLE end if - if (my_task == main_task) write(logunit,*) trim(subname)// & + if (my_task == main_task) write(logunit,*) subname// & ' : pio_rearr_comm_fcd = ', trim(cvalue), pio_rearr_comm_fcd ! pio_rearr_comm_enable_hs_comp2io @@ -1502,22 +1502,22 @@ subroutine dshr_pio_init(gcomp, sdat, logunit, rc) ! print out PIO rearranger parameters if (my_task == main_task) then - write(logunit,*) trim(subname)//' : pio_rearr_comm_enable_hs_comp2io = ', & + write(logunit,*) subname//' : pio_rearr_comm_enable_hs_comp2io = ', & pio_rearr_comm_enable_hs_comp2io - write(logunit,*) trim(subname)//' : pio_rearr_comm_enable_isend_comp2io = ', & + write(logunit,*) subname//' : pio_rearr_comm_enable_isend_comp2io = ', & pio_rearr_comm_enable_isend_comp2io - write(logunit,*) trim(subname)//' : pio_rearr_comm_max_pend_req_comp2io = ', & + write(logunit,*) subname//' : pio_rearr_comm_max_pend_req_comp2io = ', & pio_rearr_comm_max_pend_req_comp2io - write(logunit,*) trim(subname)//' : pio_rearr_comm_enable_hs_io2comp = ', & + write(logunit,*) subname//' : pio_rearr_comm_enable_hs_io2comp = ', & pio_rearr_comm_enable_hs_io2comp - write(logunit,*) trim(subname)//' : pio_rearr_comm_enable_isend_io2comp = ', & + write(logunit,*) subname//' : pio_rearr_comm_enable_isend_io2comp = ', & pio_rearr_comm_enable_isend_io2comp - write(logunit,*) trim(subname)//' : pio_rearr_comm_max_pend_req_io2comp = ', & + write(logunit,*) subname//' : pio_rearr_comm_max_pend_req_io2comp = ', & pio_rearr_comm_max_pend_req_io2comp end if ! set PIO rearranger options - if (my_task == main_task) write(logunit,*) trim(subname)// & + if (my_task == main_task) write(logunit,*) subname// & ' calling pio_set_rearr_opts' ret = pio_set_rearr_opts(sdat%pio_subsystem, pio_rearr_comm_type, & pio_rearr_comm_fcd, & diff --git a/dwav/CMakeLists.txt b/dwav/CMakeLists.txt index 2d96bf3a6..236654f67 100644 --- a/dwav/CMakeLists.txt +++ b/dwav/CMakeLists.txt @@ -1,5 +1,6 @@ project(dwav Fortran) -set(SRCFILES wav_comp_nuopc.F90) +set(SRCFILES wav_comp_nuopc.F90 + dwav_datamode_copyall.F90) foreach(FILE ${SRCFILES}) if(EXISTS "${CASEROOT}/SourceMods/src.dwav/${FILE}") diff --git a/dwav/dwav_datamode_copyall.F90 b/dwav/dwav_datamode_copyall.F90 new file mode 100644 index 000000000..811418a84 --- /dev/null +++ b/dwav/dwav_datamode_copyall.F90 @@ -0,0 +1,108 @@ +module dwav_datamode_copyall_mod + + use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS + use NUOPC , only : NUOPC_Advertise + use shr_kind_mod , only : r8=>shr_kind_r8 + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer + + implicit none + private + + public :: dwav_datamode_copyall_advertise + public :: dwav_datamode_copyall_init_pointers + public :: dwav_datamode_copyall_advance + + ! export state pointer arrays + real(r8), pointer :: Sw_lamult(:) => null() + real(r8), pointer :: Sw_ustokes(:) => null() + real(r8), pointer :: Sw_vstokes(:) => null() + + ! stream pointer arrays + real(r8), pointer :: strm_Sw_lamult(:) => null() + real(r8), pointer :: strm_Sw_ustokes(:) => null() + real(r8), pointer :: strm_Sw_vstokes(:) => null() + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine dwav_datamode_copyall_advertise(exportState, fldsexport, flds_scalar_name, rc) + + ! input/output variables + type(esmf_State) , intent(inout) :: exportState + type(fldlist_type) , pointer :: fldsexport + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(out) :: rc + + ! local variables + type(fldlist_type), pointer :: fldList + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Advertise export fields + call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) + call dshr_fldList_add(fldsExport, 'Sw_lamult' ) + call dshr_fldList_add(fldsExport, 'Sw_ustokes') + call dshr_fldList_add(fldsExport, 'Sw_vstokes') + + fldlist => fldsExport ! the head of the linked list + do while (associated(fldlist)) + call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('(dwav_comp_advertise): Fr_ocn'//trim(fldList%stdname), ESMF_LOGMSG_INFO) + fldList => fldList%next + enddo + + end subroutine dwav_datamode_copyall_advertise + + !=============================================================================== + subroutine dwav_datamode_copyall_init_pointers(exportState, sdat, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(dwav_init_pointers): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Initialize module ponters + call dshr_state_getfldptr(exportState, 'Sw_lamult' , fldptr1=Sw_lamult, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sw_ustokes', fldptr1=Sw_ustokes , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sw_vstokes', fldptr1=Sw_vstokes , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize module pointers + call shr_strdata_get_stream_pointer( sdat, 'Sw_lamult', strm_Sw_lamult, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sw_lamult must be associated for dwav', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sw_ustokes', strm_Sw_ustokes, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sw_ustokes must be associated for dwav', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Sw_vstokes', strm_Sw_vstokes, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sw_vstokes must be associated for dwav', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine dwav_datamode_copyall_init_pointers + + !=============================================================================== + subroutine dwav_datamode_copyall_advance() + + Sw_lamult(:) = strm_Sw_lamult(:) + Sw_ustokes(:) = strm_Sw_ustokes(:) + Sw_vstokes(:) = strm_Sw_vstokes(:) + + end subroutine dwav_datamode_copyall_advance + +end module dwav_datamode_copyall_mod diff --git a/dwav/wav_comp_nuopc.F90 b/dwav/wav_comp_nuopc.F90 index b002c5fbc..dd0e92c69 100644 --- a/dwav/wav_comp_nuopc.F90 +++ b/dwav/wav_comp_nuopc.F90 @@ -7,6 +7,7 @@ module cdeps_dwav_comp !---------------------------------------------------------------------------- ! This is the NUOPC cap for DWAV !---------------------------------------------------------------------------- + use ESMF , only : ESMF_VM, ESMF_VMBroadcast, ESMF_GridCompGet use ESMF , only : ESMF_SUCCESS, ESMF_TraceRegionExit, ESMF_TraceRegionEnter use ESMF , only : ESMF_State, ESMF_Clock, ESMF_Alarm, ESMF_LogWrite, ESMF_Time @@ -22,32 +23,33 @@ module cdeps_dwav_comp use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_kind_mod , only : cx=>shr_kind_cx + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx use shr_cal_mod , only : shr_cal_ymd2date use shr_log_mod , only : shr_log_setLogUnit, shr_log_error - use dshr_methods_mod , only : dshr_state_getfldptr, chkerr, memcheck, dshr_state_diagnose - use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance - use dshr_strdata_mod , only : shr_strdata_init_from_config - use dshr_mod , only : dshr_model_initphase, dshr_init, dshr_check_restart_alarm - use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_log_clock_advance + use dshr_methods_mod , only : dshr_state_diagnose, chkerr, memcheck + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance, shr_strdata_init_from_config + use dshr_mod , only : dshr_model_initphase, dshr_init + use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_check_restart_alarm use dshr_mod , only : dshr_restart_read, dshr_restart_write, dshr_mesh_init - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add, dshr_fldlist_realize use nuopc_shr_methods, only : shr_get_rpointer_name + ! Datamode specialized modules + use dwav_datamode_copyall_mod, only : dwav_datamode_copyall_advertise + use dwav_datamode_copyall_mod, only : dwav_datamode_copyall_init_pointers + use dwav_datamode_copyall_mod, only : dwav_datamode_copyall_advance + implicit none - private ! except + private public :: SetServices public :: SetVM + private :: InitializeAdvertise private :: InitializeRealize private :: ModelAdvance - private :: ModelFinalize - private :: dwav_comp_advertise - private :: dwav_comp_realize private :: dwav_comp_run + private :: ModelFinalize !-------------------------------------------------------------------------- ! Private module data @@ -66,7 +68,7 @@ module cdeps_dwav_comp integer :: logunit ! logging unit number logical :: restart_read character(CL) :: case_name ! case name - character(*) , parameter :: nullstr = 'null' + character(len=*) , parameter :: nullstr = 'null' ! dwav_in namelist input character(CX) :: streamfilename = nullstr ! filename to obtain stream info from @@ -79,25 +81,24 @@ module cdeps_dwav_comp integer :: ny_global logical :: skip_restart_read = .false. ! true => skip restart read logical :: export_all = .false. ! true => export all fields, do not check connected or not - - ! constants - logical :: diagnose_data = .true. - integer , parameter :: main_task=0 ! task number of main task -#ifdef CESMCOUPLED - character(*) , parameter :: modName = "(wav_comp_nuopc)" -#else - character(*) , parameter :: modName = "(cdeps_dwav_comp)" -#endif + logical :: first_call = .true. ! linked lists type(fldList_type) , pointer :: fldsExport => null() - type(dfield_type) , pointer :: dfields => null() ! model mask and model fraction real(r8), pointer :: model_frac(:) => null() integer , pointer :: model_mask(:) => null() - character(*) , parameter :: u_FILE_u = & + ! constants + logical :: diagnose_data = .true. + integer , parameter :: main_task=0 ! task number of main task +#ifdef CESMCOUPLED + character(len=*) , parameter :: modName = "(wav_comp_nuopc)" +#else + character(len=*) , parameter :: modName = "(cdeps_dwav_comp)" +#endif + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -166,9 +167,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_VM) :: vm integer :: bcasttmp(4) character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - character(*) ,parameter :: F00 = "('(" // trim(modName) // ") ',8a)" - character(*) ,parameter :: F01 = "('(" // trim(modName) // ") ',a,2x,i8)" - character(*) ,parameter :: F02 = "('(" // trim(modName) // ") ',a,l6)" + character(len=*) ,parameter :: F00 = "('(" // trim(modName) // ") ',8a)" + character(len=*) ,parameter :: F01 = "('(" // trim(modName) // ") ',a,2x,i8)" + character(len=*) ,parameter :: F02 = "('(" // trim(modName) // ") ',a,l6)" !------------------------------------------------------------------------------- namelist / dwav_nml / datamode, model_meshfile, model_maskfile, & @@ -190,32 +191,33 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) mainproc = (my_task == main_task) ! Read dwav_nml from nlfilename - if (my_task == main_task) then + if (mainproc) then nlfilename = "dwav_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") call shr_nl_find_group_name(nu, 'dwav_nml', status=ierr) read (nu,nml=dwav_nml,iostat=ierr) close(nu) if (ierr > 0) then - write(logunit,*) 'ERROR: reading input namelist, '//trim(nlfilename)//' iostat=',ierr + write(logunit,'(a,i0)') subname,' ERROR: reading input namelist, '//trim(nlfilename)//' iostat=',ierr call shr_log_error(subName//': namelist read error '//trim(nlfilename), rc=rc) return end if ! write namelist input to standard out - write(logunit,F00)' datamode = ',trim(datamode) - write(logunit,F00)' model_meshfile = ',trim(model_meshfile) - write(logunit,F00)' model_maskfile = ',trim(model_maskfile) - write(logunit,F01)' nx_global = ',nx_global - write(logunit,F01)' ny_global = ',ny_global - write(logunit,F00)' restfilm = ',trim(restfilm) - write(logunit,F02)' skip_restart_read = ',skip_restart_read - write(logunit,F02)' export_all = ', export_all + write(logunit,'(3a)') subname,' datamode = ',trim(datamode) + write(logunit,'(3a)') subname,' model_meshfile = ',trim(model_meshfile) + write(logunit,'(3a)') subname,' model_maskfile = ',trim(model_maskfile) + write(logunit,'(2a,i0)') subname,' nx_global = ',nx_global + write(logunit,'(2a,i0)') subname,' ny_global = ',ny_global + write(logunit,'(3a)') subname,' restfilm = ',trim(restfilm) + write(logunit,'(2a,l6)') subname,' skip_restart_read = ',skip_restart_read + write(logunit,'(2a,l6)') subname,' export_all = ',export_all + bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global - if(skip_restart_read) bcasttmp(3) = 1 - if(export_all) bcasttmp(4) = 1 + if (skip_restart_read) bcasttmp(3) = 1 + if (export_all) bcasttmp(4) = 1 endif ! broadcast namelist input @@ -232,25 +234,30 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nx_global = bcasttmp(1) ny_global = bcasttmp(2) skip_restart_read = (bcasttmp(3) == 1) export_all = (bcasttmp(4) == 1) - ! Call advertise phase - if (trim(datamode) == 'copyall') then - if (my_task == main_task) write(logunit,*) 'dwav datamode = ',trim(datamode) - else + ! Validate datamode + select case (trim(datamode)) + case('copyall') + if (mainproc) write(logunit,'(3a)') subname,' dwav datamode = ',trim(datamode) + case default call shr_log_error(' ERROR illegal dwav datamode = '//trim(datamode), rc=rc) return - end if - call dwav_comp_advertise(importState, exportState, rc=rc) + end select + + ! Advertise export fields + call dwav_datamode_copyall_advertise(exportState, fldsexport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -285,9 +292,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TraceRegionExit('dwav_strdata_init') - ! Realize the actively coupled fields, now that a mesh is established and - ! initialize dfields data type (to map streams to export state fields) - call dwav_comp_realize(importState, exportState, export_all, rc=rc) + ! Realize the actively coupled fields, now that a mesh is established + call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & + subname//':dwavExport', export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get the time to interpolate the stream data to @@ -297,7 +304,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(current_year, current_mon, current_day, current_ymd) - ! Read restart if necessary if (restart_read .and. .not. skip_restart_read) then call shr_get_rpointer_name(gcomp, 'wav', current_ymd, current_tod, rpfile, 'read', rc) @@ -307,7 +313,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if ! Run dwav to create export state - call dwav_comp_run(logunit, current_ymd, current_tod, sdat, rc=rc) + call dwav_comp_run(gcomp, exportstate, current_ymd, current_tod, restart_write=.false., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Add scalars to export state @@ -326,25 +332,23 @@ subroutine ModelAdvance(gcomp, rc) integer, intent(out) :: rc ! local variables + type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime, nextTime type(ESMF_TimeInterval) :: timeStep - type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime, nextTime + integer :: next_ymd ! model date + integer :: next_tod ! model sec into model date integer :: yr ! year integer :: mon ! month integer :: day ! day in month - integer :: next_ymd ! model date - integer :: next_tod ! model sec into model date - logical :: write_restart - character(len=CL):: rpfile + logical :: restart_write character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call shr_log_setLogUnit(logunit) - call ESMF_TraceRegionEnter(subname) - call memcheck(subname, 5, my_task == main_task) + call shr_log_setLogUnit(logunit) + call memcheck(subname, 5, mainproc) ! query the Component for its clock, importState and exportState call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) @@ -360,178 +364,116 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, next_ymd) - ! run dwav - call dwav_comp_run(logunit, next_ymd, next_tod, sdat, rc=rc) + ! determine if restart if alarm is ringing + restart_write = dshr_check_restart_alarm(clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! write_restart if alarm is ringing - write_restart = dshr_check_restart_alarm(clock, rc=rc) + ! run dwav + call dwav_comp_run(gcomp, exportState, next_ymd, next_tod, restart_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (write_restart) then - call ESMF_TraceRegionEnter('dwav_restart') - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_get_rpointer_name(gcomp, 'wav', next_ymd, next_tod, rpfile, 'write', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call dshr_restart_write(rpfile, case_name, 'dwav', inst_suffix, next_ymd, next_tod, & - logunit, my_task, sdat, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('dwav_restart') - endif - - ! Write Diagnostics - if (diagnose_data) then - call dshr_state_diagnose(exportState, flds_scalar_name, subname//':ES',rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - call ESMF_TraceRegionExit(subname) end subroutine ModelAdvance !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - if (my_task == main_task) then - write(logunit,*) - write(logunit,*) ' dwav : end of main integration loop' - write(logunit,*) - end if - - end subroutine ModelFinalize - - !=============================================================================== - subroutine dwav_comp_advertise(importState, exportState, rc) + subroutine dwav_comp_run(gcomp, exportState, target_ymd, target_tod, restart_write, rc) - ! determine export and import fields to advertise to mediator + ! -------------------------- + ! advance dwav + ! -------------------------- - ! input/output arguments - type(ESMF_State) , intent(inout) :: importState + ! input/output variables: + type(ESMF_GridComp), intent(in) :: gcomp type(ESMF_State) , intent(inout) :: exportState + integer , intent(in) :: target_ymd ! model date + integer , intent(in) :: target_tod ! model sec into model date + logical , intent(in) :: restart_write integer , intent(out) :: rc ! local variables - type(fldlist_type), pointer :: fldList + character(len=CL) :: rpfile + character(len=*), parameter :: subName = "(dwav_comp_run) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - !------------------- - ! Advertise export fields - !------------------- - - call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) - call dshr_fldList_add(fldsExport, 'Sw_lamult' ) - call dshr_fldList_add(fldsExport, 'Sw_ustokes') - call dshr_fldList_add(fldsExport, 'Sw_vstokes') - - fldlist => fldsExport ! the head of the linked list - do while (associated(fldlist)) - call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('(dwav_comp_advertise): Fr_wav '//trim(fldList%stdname), ESMF_LOGMSG_INFO) - fldList => fldList%next - enddo - - ! currently there is no import state to dwav - - end subroutine dwav_comp_advertise - - !=============================================================================== - subroutine dwav_comp_realize(importState, exportState, export_all, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: importState - type(ESMF_State) , intent(inout) :: exportState - logical , intent(in) :: export_all - integer , intent(out) :: rc - - ! local variables - character(*), parameter :: subName = "(dwav_comp_realize) " - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - ! ------------------------------------- - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - ! ------------------------------------- - - call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':dwavExport', export_all, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Create stream-> export state mapping - - call dshr_dfield_add(dfields, sdat, state_fld='Sw_lamult' , strm_fld='Sw_lamult' , state=exportstate, & - logunit=logunit, mainproc=mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_dfield_add(dfields, sdat, state_fld='Sw_ustokes', strm_fld='Sw_ustokes', state=exportstate, & - logunit=logunit, mainproc=mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_dfield_add(dfields, sdat, state_fld='Sw_vstokes', strm_fld='Sw_vstokes', state=exportstate, & - logunit=logunit, mainproc=mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine dwav_comp_realize - - !=============================================================================== - subroutine dwav_comp_run(logunit, target_ymd, target_tod, sdat, rc) - - ! -------------------------- - ! advance dwav - ! -------------------------- + call ESMF_TraceRegionEnter('DWAV_RUN') - ! input/output variables: - integer , intent(in) :: logunit - integer , intent(in) :: target_ymd ! model date - integer , intent(in) :: target_tod ! model sec into model date - type(shr_strdata_type) , intent(inout) :: sdat - integer , intent(out) :: rc - !------------------------------------------------------------------------------- + if (first_call) then + ! Initialize stream and export state pointers + select case (trim(datamode)) + case('copyall') + call dwav_datamode_copyall_init_pointers(exportState, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end select + + ! Read restart if needed + if (restart_read .and. .not. skip_restart_read) then + call shr_get_rpointer_name(gcomp, 'wav', target_ymd, target_tod, rpfile, 'read', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if - call ESMF_TraceRegionEnter('DWAV_RUN') + first_call = .false. + end if !-------------------- - ! advance dwav streams + ! advance dwav streams and update export state !-------------------- ! time and spatially interpolate to model time and grid call ESMF_TraceRegionEnter('dwav_strdata_advance') call shr_strdata_advance(sdat, target_ymd, target_tod, logunit, 'dwav', rc=rc) - call ESMF_TraceRegionExit('dwav_strdata_advance') - - !-------------------- - ! copy all fields from streams to export state as default - !-------------------- - - ! This automatically will update the fields in the export state - call ESMF_TraceRegionEnter('dwav_strdata_copy') - call dshr_dfield_copy(dfields, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('dwav_strdata_copy') - - !------------------------------------------------- - ! determine data model behavior based on the mode - !------------------------------------------------- + call ESMF_TraceRegionExit('dwav_strdata_advance') + ! perform data mode specific calculations call ESMF_TraceRegionEnter('dwav_datamode') select case (trim(datamode)) case('copyall') - ! do nothing + call dwav_datamode_copyall_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return end select call ESMF_TraceRegionExit('dwav_datamode') + ! write restarts if needed + if (restart_write) then + select case (trim(datamode)) + case('copyall') + call shr_get_rpointer_name(gcomp, 'wav', target_ymd, target_tod, rpfile, 'write', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_restart_write(rpfile, case_name, 'dwav', inst_suffix, target_ymd, target_tod, & + logunit, my_task, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end select + end if + + ! write diagnostics + if (diagnose_data) then + call dshr_state_diagnose(exportState, flds_scalar_name, subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_TraceRegionExit('DWAV_RUN') end subroutine dwav_comp_run + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (my_task == main_task) then + write(logunit,*) + write(logunit,*) ' dwav : end of main integration loop' + write(logunit,*) + end if + + end subroutine ModelFinalize + #ifdef CESMCOUPLED end module wav_comp_nuopc #else diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 94109d456..4c726a669 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -13,7 +13,7 @@ module dshr_strdata_mod use ESMF , only : ESMF_FILEFORMAT_ESMFMESH, ESMF_FieldCreate use ESMF , only : ESMF_FieldBundleCreate, ESMF_MESHLOC_ELEMENT, ESMF_FieldBundleAdd use ESMF , only : ESMF_POLEMETHOD_ALLAVG, ESMF_EXTRAPMETHOD_NEAREST_STOD - use ESMF , only : ESMF_REGRIDMETHOD_BILINEAR, ESMF_REGRIDMETHOD_NEAREST_STOD + use ESMF , only : ESMF_REGRIDMETHOD_BILINEAR, ESMF_REGRIDMETHOD_NEAREST_STOD, ESMF_FieldSMMStore use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_FRACAREA, ESMF_NORMTYPE_DSTAREA use ESMF , only : ESMF_ClockGet, operator(-), operator(==), ESMF_CALKIND_NOLEAP use ESMF , only : ESMF_FieldReGridStore, ESMF_FieldRedistStore, ESMF_UNMAPPEDACTION_IGNORE @@ -91,13 +91,13 @@ module dshr_strdata_mod ! note that the fields in fldbun_stream_lb and fldbun_stream_ub contain the the names fldlist_model type shr_strdata_perstream - character(CL) :: stream_meshfile ! stream mesh file from stream txt file + character(len=CL) :: stream_meshfile ! stream mesh file from stream txt file type(ESMF_Mesh) :: stream_mesh ! stream mesh created from stream mesh file type(io_desc_t) :: stream_pio_iodesc ! stream pio descriptor logical :: stream_pio_iodesc_set =.false. ! true=>pio iodesc has been set type(ESMF_RouteHandle) :: routehandle ! stream n -> model mesh mapping - character(CL), allocatable :: fldlist_stream(:) ! names of stream file fields - character(CL), allocatable :: fldlist_model(:) ! names of stream model fields + character(len=CL), allocatable :: fldlist_stream(:) ! names of stream file fields + character(len=CL), allocatable :: fldlist_model(:) ! names of stream model fields integer :: stream_nlev ! number of vertical levels in stream real(r8), allocatable :: stream_vlevs(:) ! values of vertical levels in stream integer :: stream_lb ! index of the Lowerbound (LB) in fldlist_stream @@ -134,7 +134,7 @@ module dshr_strdata_mod integer, pointer :: model_gindex(:) ! model global index spzce integer :: model_gsize ! model global domain size type(ESMF_CLock) :: model_clock ! model clock - character(CL) :: model_calendar = shr_cal_noleap ! model calendar for ymd,tod + character(len=CL) :: model_calendar = shr_cal_noleap ! model calendar for ymd,tod integer :: ymd, tod ! model time type(iosystem_desc_t), pointer :: pio_subsystem => null() ! pio info real(r8) :: eccen = SHR_ORB_UNDEF_REAL ! cosz t-interp info @@ -457,9 +457,9 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ! local variables type(ESMF_Mesh), pointer :: stream_mesh type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - character(CS) :: calendar ! calendar name + character(len=CS) :: calendar ! calendar name integer :: ns ! stream index - character(CX) :: fileName ! generic file name + character(len=CX) :: fileName ! generic file name integer :: nfld ! loop stream field index type(ESMF_Field) :: lfield ! temporary type(ESMF_Field) :: lfield_dst ! temporary @@ -468,7 +468,8 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) type(ESMF_VM) :: vm integer :: nvars integer :: i, stream_nlev, index, istat - character(CL) :: stream_vector_names + character(len=CL) :: stream_vector_names + character(len=CL) :: mapfile character(len=*), parameter :: subname='(shr_sdat_init)' ! ---------------------------------------------- @@ -675,6 +676,13 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) srcMaskValues=(/sdat%stream(ns)%src_mask_val/), & srcTermProcessing=srcTermProcessing_Value, ignoreDegenerate=.true., & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + else if (trim(sdat%stream(ns)%mapalgo(1:8)) == 'mapfile:') then + mapfile = trim(sdat%stream(ns)%mapalgo(9:)) + call ESMF_FieldSMMStore(sdat%pstrm(ns)%field_stream, lfield_dst, mapfile, & + routehandle=sdat%pstrm(ns)%routehandle, & + ignoreUnmatchedIndices=.true., & + srcTermProcessing=srcTermProcessing_Value, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (trim(sdat%stream(ns)%mapalgo) == 'none') then ! single point stream data, no action required. else @@ -761,12 +769,12 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) type(ESMF_VM) :: vm type(file_desc_t) :: pioid integer :: rcode - character(CX) :: filename + character(len=CX) :: filename integer :: dimid type(var_desc_t) :: varid integer :: stream_nlev integer :: old_handle ! previous setting of pio error handling - character(CS) :: units + character(len=CS) :: units integer :: istat character(len=*), parameter :: subname = '(shr_strdata_get_stream_nlev) ' ! ---------------------------------------------- @@ -843,7 +851,7 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r type(var_desc_t) :: varid type(file_desc_t) :: pioid integer :: rcode - character(CX) :: filename + character(len=CX) :: filename type(io_desc_t) :: pio_iodesc real(r4), allocatable :: data_real(:) real(r8), allocatable :: data_double(:) @@ -991,7 +999,7 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) real(r8), pointer :: data_v_dst(:) ! pointer into field bundle type(ESMF_Time) :: timeLB, timeUB ! lb and ub times type(ESMF_TimeInterval) :: timeint ! delta time - character(CL) :: calendar + character(len=CL) :: calendar integer :: dday ! delta days real(r8) :: dtime ! delta time integer :: year,month,day ! date year month day @@ -1449,12 +1457,12 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) real(r8) :: rDateM,rDateLB,rDateUB ! model,LB,UB dates with fractional days integer :: n_lb, n_ub integer :: i - character(CX) :: filename_lb - character(CX) :: filename_ub - character(CX) :: filename_next - character(CX) :: filename_prev + character(len=CX) :: filename_lb + character(len=CX) :: filename_ub + character(len=CX) :: filename_next + character(len=CX) :: filename_prev logical :: find_bounds - character(len=*), parameter :: subname = '(shr_strdata_readLBUB) ' + character(len=*), parameter :: subname = '(shr_strdata_readLBUB) ' !------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1588,7 +1596,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & ! local variables integer :: stream_nlev type(ESMF_Field) :: field_dst - character(CX) :: currfile + character(len=CX) :: currfile logical :: fileexists logical :: fileopen type(file_desc_t) :: pioid @@ -1620,10 +1628,10 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & real(r8) :: coslat, coslon real(r8) :: scale_factor, add_offset integer(i2) :: fillvalue_i2 - character(CS) :: uname, vname + character(len=CS) :: uname, vname integer :: i, lev logical :: checkflag = .false. - character(CL) :: errmsg + character(len=CL) :: errmsg integer :: istat character(len=*), parameter :: subname = '(shr_strdata_readstrm) ' !------------------------------------------------------------------------------- @@ -2150,7 +2158,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) integer :: n, m, cnt type(var_desc_t) :: varid integer :: ndims - character(CS) :: dimname + character(len=CS) :: dimname integer, allocatable :: dimids(:) integer, allocatable :: dimlens(:) type(ESMF_DistGrid) :: distGrid diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index ba81d4f61..e46e33caf 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -63,31 +63,32 @@ module dshr_stream_mod public :: shr_stream_dataDump ! internal stream data for debugging public :: shr_stream_restIO ! read or write to netcdf restart file - character(CS),parameter,public :: shr_stream_file_null = 'not_set' + character(len=CS),parameter,public :: shr_stream_file_null = 'not_set' ! valid values for time extrapoloation - character(CS),parameter,public :: shr_stream_taxis_cycle = 'cycle' - character(CS),parameter,public :: shr_stream_taxis_extend = 'extend' - character(CS),parameter,public :: shr_stream_taxis_limit = 'limit' + character(len=CS),parameter,public :: shr_stream_taxis_cycle = 'cycle' + character(len=CS),parameter,public :: shr_stream_taxis_extend = 'extend' + character(len=CS),parameter,public :: shr_stream_taxis_limit = 'limit' ! valid values for time interpolation - character(CS),parameter,public :: shr_stream_tinterp_lower = 'lower' - character(CS),parameter,public :: shr_stream_tinterp_upper = 'upper' - character(CS),parameter,public :: shr_stream_tinterp_nearest = 'nearest' - character(CS),parameter,public :: shr_stream_tinterp_linear = 'linear' - character(CS),parameter,public :: shr_stream_tinterp_coszen = 'coszen' + character(len=CS),parameter,public :: shr_stream_tinterp_lower = 'lower' + character(len=CS),parameter,public :: shr_stream_tinterp_upper = 'upper' + character(len=CS),parameter,public :: shr_stream_tinterp_nearest = 'nearest' + character(len=CS),parameter,public :: shr_stream_tinterp_linear = 'linear' + character(len=CS),parameter,public :: shr_stream_tinterp_coszen = 'coszen' ! valid values for mapping interpolation - character(CS),parameter,public :: shr_stream_mapalgo_bilinear = 'bilinear' - character(CS),parameter,public :: shr_stream_mapalgo_redist = 'redist' - character(CS),parameter,public :: shr_stream_mapalgo_nn = 'nn' - character(CS),parameter,public :: shr_stream_mapalgo_consf = 'consf' - character(CS),parameter,public :: shr_stream_mapalgo_consd = 'consd' - character(CS),parameter,public :: shr_stream_mapalgo_none = 'none' + character(len=CS),parameter,public :: shr_stream_mapalgo_bilinear = 'bilinear' + character(len=CS),parameter,public :: shr_stream_mapalgo_redist = 'redist' + character(len=CS),parameter,public :: shr_stream_mapalgo_nn = 'nn' + character(len=CS),parameter,public :: shr_stream_mapalgo_consf = 'consf' + character(len=CS),parameter,public :: shr_stream_mapalgo_consd = 'consd' + character(len=CL),parameter,public :: shr_stream_mapalgo_mapfile = 'mapfile:' + character(len=CS),parameter,public :: shr_stream_mapalgo_none = 'none' ! a useful derived type to use inside shr_streamType --- type shr_stream_file_type - character(CX) :: name = shr_stream_file_null ! the file name (full pathname) + character(len=CX) :: name = shr_stream_file_null ! the file name (full pathname) logical :: haveData = .false. ! has t-coord data been read in? integer :: nt = 0 ! size of time dimension integer ,allocatable :: date(:) ! t-coord date: yyyymmdd @@ -96,8 +97,8 @@ module dshr_stream_mod end type shr_stream_file_type type shr_stream_data_variable - character(CS) :: nameinfile - character(CS) :: nameinmodel + character(len=CS) :: nameinfile + character(len=CS) :: nameinmodel end type shr_stream_data_variable type shr_stream_streamType @@ -112,15 +113,15 @@ module dshr_stream_mod integer :: yearFirst = -1 ! first year to use in t-axis (yyyymmdd) integer :: yearLast = -1 ! last year to use in t-axis (yyyymmdd) integer :: yearAlign = -1 ! align yearFirst with this model year - character(CS) :: lev_dimname = 'null' ! name of vertical dimension if any - character(CS) :: taxMode = shr_stream_taxis_cycle ! cycling option for time axis - character(CS) :: tInterpAlgo = 'linear' ! algorithm to use for time interpolation - character(CS) :: mapalgo = 'bilinear' ! type of mapping - default is 'bilinear' - character(CS) :: readMode = 'single' ! stream read model - 'single' or 'full_file' + character(len=CS) :: lev_dimname = 'null' ! name of vertical dimension if any + character(len=CS) :: taxMode = shr_stream_taxis_cycle ! cycling option for time axis + character(len=CS) :: tInterpAlgo = 'linear' ! algorithm to use for time interpolation + character(len=CL) :: mapalgo = 'bilinear' ! type of mapping - default is 'bilinear' + character(len=CS) :: readMode = 'single' ! stream read model - 'single' or 'full_file' real(r8) :: dtlimit = 1.5_r8 ! delta time ratio limits for time interpolation integer :: offset = 0 ! offset in seconds of stream data - character(CS) :: calendar = shr_cal_noleap ! stream calendar (obtained from first stream data file) - character(CL) :: meshFile = ' ' ! filename for mesh for all fields on stream (full pathname) + character(len=CS) :: calendar = shr_cal_noleap ! stream calendar (obtained from first stream data file) + character(len=CL) :: meshFile = ' ' ! filename for mesh for all fields on stream (full pathname) integer :: k_lvd = -1 ! file/sample of least valid date integer :: n_lvd = -1 ! file/sample of least valid date logical :: found_lvd = .false. ! T <=> k_lvd,n_lvd have been set @@ -128,9 +129,9 @@ module dshr_stream_mod integer :: n_gvd = -1 ! file/sample of greatest valid date logical :: found_gvd = .false. ! T <=> k_gvd,n_gvd have been set logical :: fileopen = .false. ! is current file open - character(CX) :: currfile = ' ' ! current filename + character(len=CX) :: currfile = ' ' ! current filename integer :: nvars ! number of stream variables - character(CL) :: stream_vectors = 'null' ! stream vectors names + character(len=CL) :: stream_vectors = 'null' ! stream vectors names type(file_desc_t) :: currpioid ! current pio file desc type(shr_stream_file_type) , allocatable :: file(:) ! filenames of stream data files (full pathname) type(shr_stream_data_variable), allocatable :: varlist(:) ! stream variable names (on file and in model) @@ -248,8 +249,10 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%mapalgo /= shr_stream_mapalgo_nn .and. & streamdat(i)%mapalgo /= shr_stream_mapalgo_consf .and. & streamdat(i)%mapalgo /= shr_stream_mapalgo_consd .and. & + streamdat(i)%mapalgo(1:8) /= shr_stream_mapalgo_mapfile .and. & streamdat(i)%mapalgo /= shr_stream_mapalgo_none) then - call shr_log_error("mapaglo must have a value of either bilinear, redist, nn, consf or consd", rc=rc) + call shr_log_error("mapaglo must have a value of either bilinear, redist, nn, consf, consd or "//& + " mapalgo(1:8) must equal mapfile: ", rc=rc) return end if endif @@ -423,7 +426,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadCast(vm, streamdat(i)%stream_vectors, CL, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadCast(vm, streamdat(i)%mapalgo, CS, 0, rc=rc) + call ESMF_VMBroadCast(vm, streamdat(i)%mapalgo, CL, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return rtmp(1) = streamdat(i)%dtlimit call ESMF_VMBroadCast(vm, rtmp, 1, 0, rc=rc) @@ -512,7 +515,7 @@ subroutine shr_stream_init_from_inline(streamdat, & integer :: nfiles integer :: nvars integer :: istat - character(CS) :: calendar ! stream calendar + character(len=CS) :: calendar ! stream calendar character(len=*),parameter :: subName = '(shr_stream_init_from_inline) ' ! -------------------------------------------------------- @@ -1312,7 +1315,7 @@ subroutine shr_stream_readTCoord(strm, k, rc) integer,optional ,intent(out) :: rc ! return code ! local variables - character(CX) :: fileName ! filename to read + character(len=CX) :: fileName ! filename to read integer :: nt integer :: num,n integer :: din,dout @@ -1320,15 +1323,15 @@ subroutine shr_stream_readTCoord(strm, k, rc) integer :: lrc integer :: vid,ndims,rcode integer,allocatable :: dids(:) - character(CS) :: units,calendar - character(CS) :: bunits ! time units (days,secs,...) + character(len=CS) :: units,calendar + character(len=CS) :: bunits ! time units (days,secs,...) integer :: bdate ! base date: calendar date real(R8) :: bsec ! base date: elapsed secs integer :: ndate ! calendar date of time value integer :: old_handle ! previous setting of pio error handling real(R8) :: nsec ! elapsed secs on calendar date real(R8),allocatable :: tvar(:) - character(CX) :: msg + character(len=CX) :: msg integer :: istat character(len=*),parameter :: subname = '(shr_stream_readTCoord) ' !------------------------------------------------------------------------------- @@ -1642,8 +1645,8 @@ subroutine shr_stream_getCalendar(strm, k, calendar) ! local integer :: vid, n - character(CX) :: fileName - character(CL) :: lcal + character(len=CX) :: fileName + character(len=CL) :: lcal integer(PIO_OFFSET_KIND) :: attlen integer :: old_handle integer :: rCode