diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 44a0a2972..185f6d85d 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,8 +19,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu " # Versions of all dependencies can be updated here - these match tag names in the github repo - ESMF_VERSION: v8.9.0 - ParallelIO_VERSION: pio2_6_6 + ESMF_VERSION: v8.6.1 + ParallelIO_VERSION: pio2_6_2 steps: - id: checkout-CDEPS uses: actions/checkout@v4 @@ -39,8 +39,8 @@ jobs: id: cache-PARALLELIO uses: actions/cache@v4 with: - path: /home/runner/work/CDEPS/CDEPS/pio - key: ${{ runner.os }}-${{ env.ParallelIO_VERSION }}-parallelio + path: ${GITHUB_WORKSPACE}/pio + key: ${{ runner.os }}-${{ env.ParallelIO_VERSION }}-parallelio2 - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@9390e30e29d4ebbfbef0fc72162cacd9e8f25e4e @@ -49,7 +49,7 @@ jobs: enable_fortran: True install_prefix: ${GITHUB_WORKSPACE}/pio - name: Install ESMF - uses: esmf-org/install-esmf-action@v1.0.2 + uses: esmf-org/install-esmf-action@v1 env: ESMF_COMPILER: gfortran ESMF_BOPT: g diff --git a/datm/CMakeLists.txt b/datm/CMakeLists.txt index 892bed23d..8225f5c1f 100644 --- a/datm/CMakeLists.txt +++ b/datm/CMakeLists.txt @@ -6,7 +6,11 @@ set(SRCFILES atm_comp_nuopc.F90 datm_datamode_jra_mod.F90 datm_datamode_gefs_mod.F90 datm_datamode_era5_mod.F90 - datm_datamode_simple_mod.F90) + datm_datamode_simple_mod.F90 + datm_pres_aero_mod.F90 + datm_pres_co2_mod.F90 + datm_pres_ndep_mod.F90 + datm_pres_o3_mod.F90) foreach(FILE ${SRCFILES}) diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index ff96448fb..9ad7124b6 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 @@ -68,11 +67,28 @@ module cdeps_datm_comp use datm_datamode_simple_mod , only : datm_datamode_simple_init_pointers use datm_datamode_simple_mod , only : datm_datamode_simple_advance + use datm_pres_ndep_mod , only : datm_pres_ndep_advertise + use datm_pres_ndep_mod , only : datm_pres_ndep_init_pointers + use datm_pres_ndep_mod , only : datm_pres_ndep_advance + + use datm_pres_aero_mod , only : datm_pres_aero_advertise + use datm_pres_aero_mod , only : datm_pres_aero_init_pointers + use datm_pres_aero_mod , only : datm_pres_aero_advance + + use datm_pres_o3_mod , only : datm_pres_o3_advertise + use datm_pres_o3_mod , only : datm_pres_o3_init_pointers + use datm_pres_o3_mod , only : datm_pres_o3_advance + + use datm_pres_co2_mod , only : datm_pres_co2_advertise + use datm_pres_co2_mod , only : datm_pres_co2_init_pointers + 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 @@ -92,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 @@ -110,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 @@ -124,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__ !=============================================================================== @@ -156,7 +172,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' + character(len=*),parameter :: subname = modName//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -213,9 +229,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(CL) :: nextsw_cday_calc 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)" !------------------------------------------------------------------------------- namelist / datm_nml / & @@ -231,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, & @@ -274,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 @@ -282,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) @@ -309,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) @@ -316,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. @@ -329,64 +361,45 @@ 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 datm fields + ! Advertise fields that ARE NOT datamode specific + if (flds_co2) then + call datm_pres_co2_advertise(fldsExport, datamode) + end if + if (flds_preso3) then + call datm_pres_o3_advertise(fldsExport) + end if + if (flds_presndep) then + call datm_pres_ndep_advertise(fldsExport) + end if + if (flds_presaero) then + call datm_pres_aero_advertise(fldsExport) + end if + + ! Advertise fields that ARE datamode specific select case (trim(datamode)) case ('CORE2_NYF', 'CORE2_IAF') - call datm_datamode_core2_advertise(exportState, fldsExport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, rc) + call datm_datamode_core2_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case ('CORE_IAF_JRA', 'CORE_RYF6162_JRA', 'CORE_RYF8485_JRA', 'CORE_RYF9091_JRA', 'CORE_RYF0304_JRA') - call datm_datamode_jra_advertise(exportState, fldsExport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, rc) + call datm_datamode_jra_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case ('CLMNCEP') - call datm_datamode_clmncep_advertise(exportState, fldsExport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, flds_preso3, rc) + call datm_datamode_clmncep_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case ('CPLHIST') - call datm_datamode_cplhist_advertise(exportState, fldsExport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, rc) + call datm_datamode_cplhist_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case ('ERA5') call datm_datamode_era5_advertise(exportState, fldsExport, flds_scalar_name, rc) @@ -429,7 +442,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: orbObliqr ! orb obliquity (radians) logical :: isPresent, isSet real(R8) :: dayofYear - character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + character(len=*), parameter :: subname = modName//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -529,7 +542,7 @@ subroutine ModelAdvance(gcomp, rc) real(R8) :: orbLambm0 ! orb mean long of perhelion (radians) real(R8) :: orbObliqr ! orb obliquity (radians) real(R8) :: dayofYear - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' + character(len=*),parameter :: subname = modName//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -582,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 @@ -602,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=CL) :: rpfile + character(len=*), parameter :: subName = '(datm_comp_run) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -615,12 +629,32 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod ! First time initialization !-------------------- - if (first_time) then - ! Initialize dfields - call datm_init_dfields(rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Initialize data pointers for o3 (non datamode specific) + if (flds_preso3) then + call datm_pres_o3_init_pointers(exportState, sdat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Initialize data pointers for nitrogen deposition (non datamode specific and use of ungridded dimensions) + if (flds_presndep) then + call datm_pres_ndep_init_pointers(exportState, sdat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Initialize data pointers for prescribed aerosols (non datamode specific and use of ungridded dimensions) + if (flds_presaero) then + call datm_pres_aero_init_pointers(exportState, sdat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! Initialize datamode module ponters + ! Initialize datamode module pointers select case (trim(datamode)) case('CORE2_NYF','CORE2_IAF') call datm_datamode_core2_init_pointers(exportState, sdat, datamode, factorfn_mesh, factorfn_data, rc) @@ -638,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) @@ -650,7 +684,10 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod call shr_get_rpointer_name(gcomp, 'atm', target_ymd, target_tod, rpfile, 'read', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return 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','ERA5','GEFS','SIMPLE') + case('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA',& + 'CORE_RYF6162_JRA','CORE_RYF8485_JRA' ,& + 'CORE_RYF9091_JRA','CORE_RYF0304_JRA' ,& + 'CLMNCEP','CPLHIST','ERA5','GEFS','SIMPLE') call dshr_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case default @@ -659,31 +696,41 @@ 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 call ESMF_TraceRegionExit('datm_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('datm_dfield_copy') - call dshr_dfield_copy(dfields, sdat, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('datm_dfield_copy') + ! Update export state for non data-mode specific fields + if (flds_co2) then + call datm_pres_co2_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (flds_preso3) then + call datm_pres_o3_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (flds_presndep) then + call datm_pres_ndep_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (flds_presaero) then + call datm_pres_aero_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! 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') @@ -694,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 @@ -718,9 +762,12 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod call shr_get_rpointer_name(gcomp, 'atm', target_ymd, target_tod, rpfile, 'write', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return 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','ERA5','GEFS','SIMPLE') - call dshr_restart_write(rpfile, case_name, 'datm', inst_suffix, target_ymd, target_tod, logunit, & - my_task, sdat, rc) + case('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA',& + 'CORE_RYF6162_JRA','CORE_RYF8485_JRA' ,& + 'CORE_RYF9091_JRA','CORE_RYF0304_JRA' ,& + 'CLMNCEP','CPLHIST','ERA5','GEFS','SIMPLE') + call dshr_restart_write(rpfile, case_name, 'datm', inst_suffix, & + target_ymd, target_tod, logunit, my_task, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case default call shr_log_error(subName//'datamode '//trim(datamode)//' not recognized', rc=rc) @@ -740,100 +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 - character(CS) :: strm_flds2(2) - character(CS) :: strm_flds3(3) - character(CS) :: strm_flds4(4) - 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(trim(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 - if (rank == 1) 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 - else if (rank == 2) then - ! The following maps stream input fields to export fields that have an ungridded dimension - ! TODO: in the future it might be better to change the format of the streams file to have two more entries - ! that could denote how the stream variables are mapped to export fields that have an ungridded dimension - - select case (trim(lfieldnames(n))) - case('Faxa_bcph') - strm_flds3 = (/'Faxa_bcphidry', 'Faxa_bcphodry', 'Faxa_bcphiwet'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds3, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_ocph') - strm_flds3 = (/'Faxa_ocphidry', 'Faxa_ocphodry', 'Faxa_ocphiwet'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds3, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_dstwet') - strm_flds4 = (/'Faxa_dstwet1', 'Faxa_dstwet2', 'Faxa_dstwet3', 'Faxa_dstwet4'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds4, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_dstdry') - strm_flds4 = (/'Faxa_dstdry1', 'Faxa_dstdry2', 'Faxa_dstdry3', 'Faxa_dstdry4'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds4, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_rainc_wiso') - strm_flds3 = (/'Faxa_rainc_16O', 'Faxa_rainc_18O', 'Faxa_rainc_HDO'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds3, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_rainl_wiso') - strm_flds3 = (/'Faxa_rainl_16O', 'Faxa_rainl_18O', 'Faxa_rainl_HDO'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds3, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_snowc_wiso') - strm_flds3 = (/'Faxa_snowc_16O', 'Faxa_snowc_18O', 'Faxa_snowc_HDO'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds3, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_snowl_wiso') - strm_flds3 = (/'Faxa_snowl_16O', 'Faxa_snowl_18O', 'Faxa_snowl_HDO'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds3, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('Faxa_ndep') - strm_flds2 = (/'Faxa_ndep_nhx', 'Faxa_ndep_noy'/) - call dshr_dfield_add(dfields, sdat, trim(lfieldnames(n)), strm_flds2, exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('cpl_scalars') - continue - case default - call shr_log_error(subName//'field '//trim(lfieldnames(n))//' not recognized', rc=rc) - return - end select - end if - end do - end subroutine datm_init_dfields - end subroutine datm_comp_run !=============================================================================== @@ -860,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 c3b5269e7..35bf01b60 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -102,18 +102,22 @@ char - none,clim_1850,clim_2000,clim_2010,hist,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 - clim_2000 - clim_2010 - SSP1-2.6 - SSP2-4.5 - SSP3-7.0 - SSP5-8.5 - hist - hist + clim_1850_cmip6 + clim_2000_cmip6 + clim_2010_cmip6 + hist_cmip6 + hist_cmip6 + SSP1-2.6 + SSP2-4.5 + SSP3-7.0 + SSP5-8.5 cplhist none diff --git a/datm/cime_config/namelist_definition_datm.xml b/datm/cime_config/namelist_definition_datm.xml index 8ca888bb3..92ab3bd14 100644 --- a/datm/cime_config/namelist_definition_datm.xml +++ b/datm/cime_config/namelist_definition_datm.xml @@ -1,7 +1,5 @@ - - @@ -16,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 @@ -331,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/cime_config/stream_definition_datm.xml b/datm/cime_config/stream_definition_datm.xml index 8f838aa20..5ec085c1d 100644 --- a/datm/cime_config/stream_definition_datm.xml +++ b/datm/cime_config/stream_definition_datm.xml @@ -1,7 +1,5 @@ - - @@ -190,10 +188,14 @@ optional stream nitrogen deposition - DATM_NDEP is set by the 4 character time prefix in config_component.xml ======================== - presndep.clim_1850 - presndep.clim_2000 - presndep.clim_2010 - presndep.hist + presndep.clim_1850_cmip7 + presndep.clim_2000_cmip7 + presndep.clim_2010_cmip7 + presndep.hist_cmip7 + presndep.clim_1850_cmip6 + presndep.clim_2000_cmip6 + presndep.clim_2010_cmip6 + presndep.hist_cmip6 presndep.SSP1-2.6 presndep.SSP2-4.5 presndep.SSP3-7.0 @@ -4861,7 +4863,147 @@ - + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_ESMFmesh_cdf5_c20251211.nc + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_CMIP_FZJ-CMIP-nitrogen-1-2_gn_185001-185012-clim_c20251222.nc + + + + drynhx Faxa_ndep_nhx_dry + wetnhx Faxa_ndep_nhx_wet + drynoy Faxa_ndep_noy_dry + wetnoy Faxa_ndep_noy_wet + + null + + bilinear + + null + 1 + 1850 + 1850 + 0 + + linear + + + cycle + + + 1.5 + + single + + + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_ESMFmesh_cdf5_c20251211.nc + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_CMIP_FZJ-CMIP-nitrogen-1-2_gn_185001-202212_c20251222.nc + + + + drynhx Faxa_ndep_nhx_dry + wetnhx Faxa_ndep_nhx_wet + drynoy Faxa_ndep_noy_dry + wetnoy Faxa_ndep_noy_wet + + null + + bilinear + + null + 1 + 2000 + 2000 + 0 + + linear + + + cycle + + + 1.5 + + single + + + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_ESMFmesh_cdf5_c20251211.nc + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_CMIP_FZJ-CMIP-nitrogen-1-2_gn_185001-202212_c20251222.nc + + + + drynhx Faxa_ndep_nhx_dry + wetnhx Faxa_ndep_nhx_wet + drynoy Faxa_ndep_noy_dry + wetnoy Faxa_ndep_noy_wet + + null + + bilinear + + null + 1 + 2010 + 2010 + 0 + + linear + + + cycle + + + 1.5 + + single + + + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_ESMFmesh_cdf5_c20251211.nc + + + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_CMIP_FZJ-CMIP-nitrogen-1-2_gn_185001-202212_c20251222.nc + + + + drynhx Faxa_ndep_nhx_dry + wetnhx Faxa_ndep_nhx_wet + drynoy Faxa_ndep_noy_dry + wetnoy Faxa_ndep_noy_wet + + null + + bilinear + + null + 1 + 1850 + 2022 + 0 + + linear + + + cycle + + + 1.5 + + single + + + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc @@ -4869,6 +5011,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_WACCM6_CMIP6piControl001_y21-50avg_1850monthly_0.95x1.25_c180802.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy @@ -4893,7 +5036,7 @@ single - + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc @@ -4901,6 +5044,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy @@ -4925,7 +5069,7 @@ single - + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc @@ -4957,7 +5101,7 @@ single - + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc @@ -4965,6 +5109,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy @@ -4997,6 +5142,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP1-2.6-WACCM_1849-2101_monthly_c191007.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy @@ -5029,6 +5175,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP2-4.5-WACCM_1849-2101_monthly_c191007.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy @@ -5061,6 +5208,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_SSP370_b.e21.BWSSP370cmip6.f09_g17.CMIP6-SSP3-7.0-WACCM.002_1849-2101_monthly_0.9x1.25_c211216.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy @@ -5094,6 +5242,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy diff --git a/datm/datm_datamode_clmncep_mod.F90 b/datm/datm_datamode_clmncep_mod.F90 index e0da79283..181eac30a 100644 --- a/datm/datm_datamode_clmncep_mod.F90 +++ b/datm/datm_datamode_clmncep_mod.F90 @@ -12,82 +12,71 @@ 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 ! except + private public :: datm_datamode_clmncep_advertise public :: datm_datamode_clmncep_init_pointers public :: datm_datamode_clmncep_advance + 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() -! TODO: water isotope support -! real(r8), pointer :: Sa_shum_wiso(:,:) => null() ! water isotopes - real(r8), pointer :: Sa_dens(:) => null() - real(r8), pointer :: Sa_pbot(:) => null() - real(r8), pointer :: Sa_pslv(:) => null() - real(r8), pointer :: Sa_o3(:) => 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() - real(r8), pointer :: Faxa_ndep(:,:) => 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 - water isotopes - real(r8), pointer :: strm_rh_16O(:) => null() ! water isoptopes - real(r8), pointer :: strm_rh_18O(:) => null() ! water isoptopes - real(r8), pointer :: strm_rh_HDO(:) => null() ! water isoptopes - real(r8), pointer :: strm_precn_16O(:) => null() ! water isoptopes - real(r8), pointer :: strm_precn_18O(:) => null() ! water isoptopes - real(r8), pointer :: strm_precn_HDO(:) => null() ! water isoptopes - - ! 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 @@ -100,26 +89,19 @@ module datm_datamode_clmncep_mod real(r8) , parameter :: stebol = SHR_CONST_STEBOL ! Stefan-Boltzmann constant ~ W/m^2/K^4 real(r8) , parameter :: rdair = SHR_CONST_RDAIR ! dry air gas constant ~ J/K/kg - - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'null' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains !=============================================================================== - subroutine datm_datamode_clmncep_advertise(exportState, fldsexport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, flds_preso3, rc) + subroutine datm_datamode_clmncep_advertise(exportState, fldsexport, flds_scalar_name, rc) ! input/output variables type(esmf_State) , intent(inout) :: exportState type(fldlist_type) , pointer :: fldsexport - logical , intent(in) :: flds_co2 - logical , intent(in) :: flds_wiso - logical , intent(in) :: flds_presaero - logical , intent(in) :: flds_presndep - logical , intent(in) :: flds_preso3 character(len=*) , intent(in) :: flds_scalar_name integer , intent(out) :: rc @@ -151,29 +133,6 @@ subroutine datm_datamode_clmncep_advertise(exportState, fldsexport, flds_scalar_ call dshr_fldList_add(fldsExport, 'Faxa_swnet' ) call dshr_fldList_add(fldsExport, 'Faxa_lwdn' ) call dshr_fldList_add(fldsExport, 'Faxa_swdn' ) - if (flds_co2) then - call dshr_fldList_add(fldsExport, 'Sa_co2prog') - call dshr_fldList_add(fldsExport, 'Sa_co2diag') - end if - if (flds_preso3) then - call dshr_fldList_add(fldsExport, 'Sa_o3') - end if - if (flds_presaero) then - call dshr_fldList_add(fldsExport, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_dstwet' , ungridded_lbound=1, ungridded_ubound=4) - call dshr_fldList_add(fldsExport, 'Faxa_dstdry' , ungridded_lbound=1, ungridded_ubound=4) - end if - if (flds_presndep) then - call dshr_fldList_add(fldsExport, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) - end if - if (flds_wiso) then - call dshr_fldList_add(fldsExport, 'Faxa_rainc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_rainl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_shum_wiso' , ungridded_lbound=1, ungridded_ubound=3) - end if fldlist => fldsExport ! the head of the linked list do while (associated(fldlist)) @@ -201,69 +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) - 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 - call shr_strdata_get_stream_pointer( sdat, 'Faxa_rh_16O' , strm_rh_16O, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_rh_18O' , strm_rh_18O , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_rh_HDO' , strm_rh_HDO , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_precn_16O' , strm_precn_16O, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_precn_18O' , strm_precn_18O, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_precn_HDO' , strm_precn_HDO, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer( sdat, 'Faxa_precn_HDO' , strm_precn_HDO, 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) + ! 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, '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) @@ -272,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) @@ -300,30 +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_lwdn' , fldptr1=Faxa_lwdn , rc=rc) + call dshr_state_getfldptr(exportState, 'Faxa_swdn' , fldptr1=Faxa_swdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(exportstate, 'Faxa_ndep', itemFlag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - call ESMF_StateGet(exportstate, 'Sa_o3', itemFlag, rc=rc) + call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - call dshr_state_getfldptr(exportState, 'Sa_o3', fldptr1=Sa_o3, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! error check - if (.not. associated(strm_wind) .or. .not. associated(strm_tbot)) then - call shr_log_error(trim(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 @@ -338,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. @@ -371,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 @@ -379,7 +341,7 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return tbotmax = rtmp(2) - if (mainproc) write(logunit,*) trim(subname),' tbotmax = ',tbotmax + if (mainproc) write(logunit,*) subname,' tbotmax = ',tbotmax if(tbotmax <= 0) then call shr_log_error(subname//'ERROR: bad value in tbotmax', rc=rc) return @@ -394,15 +356,15 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) else anidrmax = SHR_CONST_SPVAL end if - if (mainproc) write(logunit,*) trim(subname),' anidrmax = ',anidrmax + 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) - if (mainproc) write(logunit,*) trim(subname),' tdewmax = ',tdewmax + if (mainproc) write(logunit,*) subname,' tdewmax = ',tdewmax endif ! reset first_time @@ -410,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 @@ -420,84 +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 - ! for isotopic tracer specific humidity, expect a delta, just keep the delta from the input file - ! if (associated(strm_rh_16O) .and. associated(strm_rh_18O) .and. associated(strm_rh_HDO)) then - ! Sa_shum_wiso(1,n) = strm_rh_16O(n) - ! Sa_shum_wiso(2,n) = strm_rh_18O(n) - ! Sa_shum_wiso(3,n) = strm_rh_HDO(n) - ! end if - 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 --- @@ -514,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) @@ -541,54 +495,49 @@ 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 ) - if (associated(Faxa_ndep)) then - ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) - Faxa_ndep(:,:) = Faxa_ndep(:,:) / 1000._r8 - end if - end subroutine datm_datamode_clmncep_advance !=============================================================================== diff --git a/datm/datm_datamode_core2_mod.F90 b/datm/datm_datamode_core2_mod.F90 index b874dcf98..8e22fb7db 100644 --- a/datm/datm_datamode_core2_mod.F90 +++ b/datm/datm_datamode_core2_mod.F90 @@ -26,7 +26,7 @@ module datm_datamode_core2_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: datm_datamode_core2_advertise public :: datm_datamode_core2_init_pointers @@ -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,14 +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_ndep(:,:) => null() - - ! stream data - real(r8), pointer :: strm_prec(:) => null() - real(r8), pointer :: strm_swdn(:) => null() - real(r8), pointer :: strm_tarcf(:) => null() + real(r8), pointer :: Faxa_swdn(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => 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(:) @@ -82,25 +90,20 @@ module datm_datamode_core2_mod data dTarc / 0.49_R8, 0.06_R8,-0.73_R8, -0.89_R8,-0.77_R8,-1.02_R8, & -1.99_R8,-0.91_R8, 1.72_R8, 2.30_R8, 1.81_R8, 1.06_R8/ - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'null' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains !=============================================================================== - subroutine datm_datamode_core2_advertise(exportState, fldsexport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, rc) + subroutine datm_datamode_core2_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 - logical , intent(in) :: flds_co2 - logical , intent(in) :: flds_wiso - logical , intent(in) :: flds_presaero - logical , intent(in) :: flds_presndep integer , intent(out) :: rc ! local variables @@ -133,27 +136,6 @@ subroutine datm_datamode_core2_advertise(exportState, fldsexport, flds_scalar_na call dshr_fldList_add(fldsExport, 'Faxa_lwdn' ) call dshr_fldList_add(fldsExport, 'Faxa_swdn' ) - if (flds_co2) then - call dshr_fldList_add(fldsExport, 'Sa_co2prog') - call dshr_fldList_add(fldsExport, 'Sa_co2diag') - end if - if (flds_presaero) then - call dshr_fldList_add(fldsExport, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_dstwet' , ungridded_lbound=1, ungridded_ubound=4) - call dshr_fldList_add(fldsExport, 'Faxa_dstdry' , ungridded_lbound=1, ungridded_ubound=4) - end if - if (flds_presndep) then - call dshr_fldList_add(fldsExport, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) - end if - if (flds_wiso) then - call dshr_fldList_add(fldsExport, 'Faxa_rainc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_rainl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_shum_wiso' , ungridded_lbound=1, ungridded_ubound=3) - end if - fldlist => fldsExport ! the head of the linked list do while (associated(fldlist)) call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) @@ -181,37 +163,11 @@ subroutine datm_datamode_core2_init_pointers(exportState, sdat, datamode, factor integer :: spatialDim ! number of dimension in mesh integer :: numOwnedElements ! size of mesh real(r8), pointer :: ownedElemCoords(:) ! mesh lat and lons - type(ESMF_StateItem_Flag) :: itemFlag character(len=*), parameter :: subname='(datm_init_pointers): ' !------------------------------------------------------------------------------- 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 @@ -233,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) @@ -251,29 +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 - call ESMF_StateGet(exportstate, 'Faxa_ndep', itemFlag, 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 - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - if (.not. associated(strm_prec) .or. .not. associated(strm_swdn)) then - call shr_log_error(trim(subname)//'ERROR: prec and swdn must be in streams for CORE2', rc=rc) + 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(trim(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 @@ -313,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) @@ -326,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) @@ -339,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) @@ -350,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 @@ -392,19 +392,16 @@ 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 - if (associated(Faxa_ndep)) then - ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) - Faxa_ndep(:,:) = Faxa_ndep(:,:) / 1000._r8 - end if - end subroutine datm_datamode_core2_advance !=============================================================================== @@ -412,8 +409,8 @@ subroutine datm_get_adjustment_factors(sdat, fileName_mesh, fileName_data, windF ! input/output variables type(shr_strdata_type) , intent(in) :: sdat - character(*) , intent(in) :: fileName_mesh ! file name string - character(*) , intent(in) :: fileName_data ! file name string + character(len=*) , intent(in) :: fileName_mesh ! file name string + character(len=*) , intent(in) :: fileName_data ! file name string real(R8) , pointer :: windF(:) ! wind adjustment factor real(R8) , pointer :: winddF(:) ! wind adjustment factor real(r8) , pointer :: qsatF(:) ! rel humidty adjustment factor @@ -438,7 +435,7 @@ subroutine datm_get_adjustment_factors(sdat, fileName_mesh, fileName_data, windF integer :: nxg, nyg real(r8), pointer :: data(:) integer :: srcTermProcessing_Value = 0 - character(*) ,parameter :: subName = '(datm_get_adjustment_factors) ' + character(len=*) ,parameter :: subName = '(datm_get_adjustment_factors) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/datm/datm_datamode_cplhist_mod.F90 b/datm/datm_datamode_cplhist_mod.F90 index a260182e9..90f11e15c 100644 --- a/datm/datm_datamode_cplhist_mod.F90 +++ b/datm/datm_datamode_cplhist_mod.F90 @@ -5,60 +5,74 @@ 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 use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: datm_datamode_cplhist_advertise 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() - ! TODO: water isotope support - ! real(r8), pointer :: Sa_shum_wiso(:,:) => null() ! water isotopes - 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() - real(r8), pointer :: Faxa_ndep(:,:) => null() - - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + + ! export state data pointers + + 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_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__ !=============================================================================== contains !=============================================================================== - subroutine datm_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, rc) + subroutine datm_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_name, rc) ! input/output variables type(esmf_State) , intent(inout) :: exportState type(fldlist_type) , pointer :: fldsexport - logical , intent(in) :: flds_co2 - logical , intent(in) :: flds_wiso - logical , intent(in) :: flds_presaero - logical , intent(in) :: flds_presndep character(len=*) , intent(in) :: flds_scalar_name integer , intent(out) :: rc @@ -71,45 +85,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_swnet' ) + + 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' ) - if (flds_co2) then - call dshr_fldList_add(fldsExport, 'Sa_co2prog') - call dshr_fldList_add(fldsExport, 'Sa_co2diag') - end if - if (flds_presaero) then - call dshr_fldList_add(fldsExport, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_dstwet' , ungridded_lbound=1, ungridded_ubound=4) - call dshr_fldList_add(fldsExport, 'Faxa_dstdry' , ungridded_lbound=1, ungridded_ubound=4) - end if - if (flds_presndep) then - call dshr_fldList_add(fldsExport, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) - end if - if (flds_wiso) then - call dshr_fldList_add(fldsExport, 'Faxa_rainc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_rainl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_shum_wiso' , ungridded_lbound=1, ungridded_ubound=3) - end if fldlist => fldsExport ! the head of the linked list do while (associated(fldlist)) @@ -131,7 +126,6 @@ subroutine datm_datamode_cplhist_init_pointers(importState, exportState, sdat, r integer , intent(out) :: rc ! local variables - type(ESMF_StateItem_Flag) :: itemFlag character(len=*), parameter :: subname='(datm_init_pointers): ' !------------------------------------------------------------------------------- @@ -140,10 +134,6 @@ subroutine datm_datamode_cplhist_init_pointers(importState, exportState, sdat, r ! 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) - 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, '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) @@ -156,6 +146,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) @@ -164,6 +158,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) @@ -172,28 +168,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_swnet' , fldptr1=Faxa_swnet , rc=rc) + + ! Set pointers into stream data + + 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 dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) + 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 ESMF_StateGet(exportState, 'Faxa_ndep', itemFlag, rc=rc) + 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_wind 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_dens', strm_Sa_dens, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_dens 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 - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if 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): ' @@ -201,10 +246,25 @@ subroutine datm_datamode_cplhist_advance(mainproc, logunit, mpicom, rc) rc = ESMF_SUCCESS - if (associated(Faxa_ndep)) then - ! convert ndep flux to units of kgN/m2/s (assumes that input is in gN/m2/s) - Faxa_ndep(:,:) = Faxa_ndep(:,:) / 1000._r8 - end if + 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_swvdr(:) + Faxa_swvdr(:) = strm_Faxa_swndf(:) + Faxa_swvdf(:) = strm_Faxa_swvdf(:) end subroutine datm_datamode_cplhist_advance diff --git a/datm/datm_datamode_era5_mod.F90 b/datm/datm_datamode_era5_mod.F90 index dad08baf9..63cd34cb3 100644 --- a/datm/datm_datamode_era5_mod.F90 +++ b/datm/datm_datamode_era5_mod.F90 @@ -3,19 +3,19 @@ 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 - private ! except + private public :: datm_datamode_era5_advertise public :: datm_datamode_era5_init_pointers public :: datm_datamode_era5_advance + private :: datm_eSat ! determine saturation vapor pressure ! export state data @@ -44,11 +44,30 @@ module datm_datamode_era5_mod real(r8), pointer :: Faxa_lat(:) => null() real(r8), pointer :: Faxa_taux(:) => null() real(r8), pointer :: Faxa_tauy(:) => null() -! -! real(r8), pointer :: Faxa_ndep(:,:) => 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 @@ -57,16 +76,15 @@ module datm_datamode_era5_mod real(r8) , parameter :: rdair = SHR_CONST_RDAIR ! dry air gas constant ~ J/K/kg real(r8) , parameter :: rhofw = SHR_CONST_RHOFW ! density of fresh water ~ kg/m^3 - character(*), parameter :: nullstr = 'undefined' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'undefined' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== 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 @@ -132,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 @@ -187,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_pslv 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 @@ -216,24 +362,25 @@ 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) t2max = rtmp(2) - if (mainproc) write(logunit,*) trim(subname),' t2max = ',t2max + if (mainproc) write(logunit,*) subname,' t2max = ',t2max 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) - if (mainproc) write(logunit,*) trim(subname),' td2max = ',td2max + if (mainproc) write(logunit,*) subname,' td2max = ',td2max ! reset first_time first_time = .false. @@ -247,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 @@ -267,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 @@ -288,31 +435,31 @@ 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 - !=============================================================================== + !=============================================================================== real(r8) function datm_eSat(tK,tKbot) !---------------------------------------------------------------------------- diff --git a/datm/datm_datamode_gefs_mod.F90 b/datm/datm_datamode_gefs_mod.F90 index 80d5716d8..6cefe6613 100644 --- a/datm/datm_datamode_gefs_mod.F90 +++ b/datm/datm_datamode_gefs_mod.F90 @@ -1,6 +1,8 @@ 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 @@ -9,9 +11,10 @@ module datm_datamode_gefs_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 dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy implicit none - private ! except + private public :: datm_datamode_gefs_advertise public :: datm_datamode_gefs_init_pointers @@ -47,16 +50,17 @@ module datm_datamode_gefs_mod real(r8) , parameter :: rdair = SHR_CONST_RDAIR ! dry air gas constant ~ J/K/kg real(r8) , parameter :: rhofw = SHR_CONST_RHOFW ! density of fresh water ~ kg/m^3 - character(*), parameter :: nullstr = 'undefined' - character(*), parameter :: u_FILE_u = & + type(dfield_type) , pointer :: dfields => null() + + character(len=*), parameter :: nullstr = 'undefined' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== 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,19 +105,41 @@ 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 + integer :: n + integer :: fieldcount + type(ESMF_Field) :: lfield + character(ESMF_MAXSTR) ,pointer :: lfieldnames(:) character(len=*), parameter :: subname='(datm_init_pointers): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + ! Initialize dfields arrays for export fields with no ungridded dimension + ! and that have a corresponding stream field + 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 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 do + ! initialize pointers for module level stream arrays call shr_strdata_get_stream_pointer( sdat, 'Sa_mask' , strm_mask , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -159,16 +185,16 @@ 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 @@ -193,19 +219,26 @@ subroutine datm_datamode_gefs_advance(exportstate, mainproc, logunit, mpicom, ta if (ChkErr(rc,__LINE__,u_FILE_u)) return tbotmax = rtmp(2) - if (mainproc) write(logunit,*) trim(subname),' tbotmax = ',tbotmax + if (mainproc) write(logunit,*) subname,' tbotmax = ',tbotmax ! determine maskmax (see below for use) rtmp(1) = maxval(strm_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) - if (mainproc) write(logunit,*) trim(subname),' maskmax = ',maskmax + if (mainproc) write(logunit,*) subname,' maskmax = ',maskmax ! reset first_time first_time = .false. 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_gefs_dfield_copy') + call dshr_dfield_copy(dfields, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TraceRegionExit('datm_gefs_dfield_copy') + do n = 1, lsize !--- temperature --- if (tbotmax < 50.0_r8) Sa_tbot(n) = Sa_tbot(n) + tkFrz diff --git a/datm/datm_datamode_jra_mod.F90 b/datm/datm_datamode_jra_mod.F90 index 13ef64ebf..a32973791 100644 --- a/datm/datm_datamode_jra_mod.F90 +++ b/datm/datm_datamode_jra_mod.F90 @@ -1,20 +1,17 @@ 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 - private ! except + private public :: datm_datamode_jra_advertise public :: datm_datamode_jra_init_pointers @@ -41,14 +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() - real(r8), pointer :: Faxa_ndep(:,:) => 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 @@ -57,25 +61,20 @@ module datm_datamode_jra_mod real(R8) , parameter :: phs_c0 = 0.298_R8 real(R8) , parameter :: dLWarc = -5.000_R8 - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'null' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains !=============================================================================== - subroutine datm_datamode_jra_advertise(exportState, fldsexport, flds_scalar_name, & - flds_co2, flds_wiso, flds_presaero, flds_presndep, rc) + subroutine datm_datamode_jra_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 - logical , intent(in) :: flds_co2 - logical , intent(in) :: flds_wiso - logical , intent(in) :: flds_presaero - logical , intent(in) :: flds_presndep integer , intent(out) :: rc ! local variables @@ -108,27 +107,6 @@ subroutine datm_datamode_jra_advertise(exportState, fldsexport, flds_scalar_name call dshr_fldList_add(fldsExport, 'Faxa_lwdn' ) call dshr_fldList_add(fldsExport, 'Faxa_swdn' ) - if (flds_co2) then - call dshr_fldList_add(fldsExport, 'Sa_co2prog') - call dshr_fldList_add(fldsExport, 'Sa_co2diag') - end if - if (flds_presaero) then - call dshr_fldList_add(fldsExport, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_dstwet' , ungridded_lbound=1, ungridded_ubound=4) - call dshr_fldList_add(fldsExport, 'Faxa_dstdry' , ungridded_lbound=1, ungridded_ubound=4) - end if - if (flds_presndep) then - call dshr_fldList_add(fldsExport, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) - end if - if (flds_wiso) then - call dshr_fldList_add(fldsExport, 'Faxa_rainc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_rainl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowc_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_snowl_wiso', ungridded_lbound=1, ungridded_ubound=3) - call dshr_fldList_add(fldsExport, 'Faxa_shum_wiso' , ungridded_lbound=1, ungridded_ubound=3) - end if - fldlist => fldsExport ! the head of the linked list do while (associated(fldlist)) call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) @@ -149,18 +127,15 @@ 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 - type(ESMF_StateItem_Flag) :: itemFlag character(len=*), parameter :: subname='(datm_init_pointers): ' !------------------------------------------------------------------------------- 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)) @@ -171,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) @@ -216,19 +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 ESMF_StateGet(exportState, 'Faxa_ndep', itemFlag, rc=rc) + 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 (itemflag /= ESMF_STATEITEM_NOTFOUND) then - call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! erro check - if (.not. associated(strm_prec) .or. .not. associated(strm_swdn)) then - call shr_log_error(trim(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 @@ -260,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) @@ -276,28 +275,23 @@ 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 - if (associated(Faxa_ndep)) then - ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) - Faxa_ndep(:,:) = Faxa_ndep(:,:) / 1000._r8 - end if - end subroutine datm_datamode_jra_advance end module datm_datamode_jra_mod diff --git a/datm/datm_datamode_simple_mod.F90 b/datm/datm_datamode_simple_mod.F90 index e9db91118..4937f7505 100644 --- a/datm/datm_datamode_simple_mod.F90 +++ b/datm/datm_datamode_simple_mod.F90 @@ -25,9 +25,9 @@ module datm_datamode_simple_mod use dshr_strdata_mod , only : shr_strdata_type use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add use shr_log_mod , only : shr_log_error - + implicit none - private ! except + private public :: datm_datamode_simple_advertise public :: datm_datamode_simple_init_pointers @@ -53,7 +53,6 @@ module datm_datamode_simple_mod real(r8), pointer :: Faxa_swvdr(:) => null() real(r8), pointer :: Faxa_swvdf(:) => null() real(r8), pointer :: Faxa_swnet(:) => null() - real(r8), pointer :: Faxa_ndep(:,:) => null() ! othe module arrays real(R8), pointer :: yc(:) ! array of model latitudes @@ -75,8 +74,8 @@ module datm_datamode_simple_mod real(R8) , parameter :: phs_c0 = 0.298_R8 real(R8) , parameter :: dLWarc = -5.000_R8 - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'null' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -85,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 @@ -191,7 +191,6 @@ subroutine datm_datamode_simple_init_pointers(exportState, sdat, rc) integer :: spatialDim ! number of dimension in mesh integer :: numOwnedElements ! size of mesh real(r8), pointer :: ownedElemCoords(:) ! mesh lat and lons - type(ESMF_StateItem_Flag) :: itemFlag character(len=*), parameter :: subname='(datm_init_pointers): ' !------------------------------------------------------------------------------- @@ -251,13 +250,6 @@ subroutine datm_datamode_simple_init_pointers(exportState, sdat, rc) call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(exportstate, 'Faxa_ndep', itemFlag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end subroutine datm_datamode_simple_init_pointers !=============================================================================== @@ -319,7 +311,7 @@ subroutine datm_datamode_simple_advance(target_ymd, target_tod, target_mon, & ! long wave solar_decl = (epsilon_deg * degtorad) * sin( 2.0_R8 * shr_const_pi * (int(rday) + 284.0_R8) / 365.0_R8) zenith_angle = acos(sin(yc(n) * degtorad ) * sin(solar_decl) + cos(yc(n) * degtorad) * cos(solar_decl) ) - Faxa_lwdn(n) = max(0.0_R8, peak_lwdn * cos(zenith_angle)) + Faxa_lwdn(n) = max(0.0_R8, peak_lwdn * cos(zenith_angle)) ! short wave hour_angle = (15.0_R8 * (target_tod/3600.0_R8 - 12.0_R8) + xc(n) ) * degtorad @@ -332,11 +324,6 @@ subroutine datm_datamode_simple_advance(target_ymd, target_tod, target_mon, & enddo ! lsize - if (associated(Faxa_ndep)) then - ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) - Faxa_ndep(:,:) = Faxa_ndep(:,:) / 1000._r8 - end if - end subroutine datm_datamode_simple_advance end module datm_datamode_simple_mod diff --git a/datm/datm_pres_aero_mod.F90 b/datm/datm_pres_aero_mod.F90 new file mode 100644 index 000000000..dc3401c2d --- /dev/null +++ b/datm/datm_pres_aero_mod.F90 @@ -0,0 +1,172 @@ +module datm_pres_aero_mod + + use ESMF , only : ESMF_SUCCESS, ESMF_State + use shr_kind_mod , only : r8=>shr_kind_r8 + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + + implicit none + private + + public :: datm_pres_aero_advertise + public :: datm_pres_aero_init_pointers + public :: datm_pres_aero_advance + + ! pointers to export state data + real(r8), pointer :: Faxa_bcph(:,:) => null() + real(r8), pointer :: Faxa_ocph(:,:) => null() + real(r8), pointer :: Faxa_dstwet(:,:) => null() + real(r8), pointer :: Faxa_dstdry(:,:) => null() + + ! pointers to stream data + real(r8), pointer :: strm_Faxa_bcphidry(:) => null() + real(r8), pointer :: strm_Faxa_bcphiwet(:) => null() + real(r8), pointer :: strm_Faxa_bcphodry(:) => null() + + real(r8), pointer :: strm_Faxa_ocphidry(:) => null() + real(r8), pointer :: strm_Faxa_ocphiwet(:) => null() + real(r8), pointer :: strm_Faxa_ocphodry(:) => null() + + real(r8), pointer :: strm_Faxa_dstwet1(:) => null() + real(r8), pointer :: strm_Faxa_dstwet2(:) => null() + real(r8), pointer :: strm_Faxa_dstwet3(:) => null() + real(r8), pointer :: strm_Faxa_dstwet4(:) => null() + + real(r8), pointer :: strm_Faxa_dstdry1(:) => null() + real(r8), pointer :: strm_Faxa_dstdry2(:) => null() + real(r8), pointer :: strm_Faxa_dstdry3(:) => null() + real(r8), pointer :: strm_Faxa_dstdry4(:) => null() + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine datm_pres_aero_advertise(fldsExport) + + ! input/output variables + type(fldlist_type) , pointer :: fldsexport + !---------------------------------------------------------- + + call dshr_fldList_add(fldsExport, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) + call dshr_fldList_add(fldsExport, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) + call dshr_fldList_add(fldsExport, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call dshr_fldList_add(fldsExport, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + + end subroutine datm_pres_aero_advertise + + !=============================================================================== + subroutine datm_pres_aero_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='(datm_pres_aero_init_pointers): ' + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Set module pointers into export state + + call dshr_state_getfldptr(exportState, 'Faxa_bcph', fldptr2=Faxa_bcph, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_ocph', fldptr2=Faxa_ocph, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_dstwet', fldptr2=Faxa_dstwet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_dstdry', fldptr2=Faxa_dstdry, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set module pointers into streams and check that they are associated + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphidry' , strm_Faxa_bcphidry, requirePointer=.true., & + errmsg=subname//'strm_Faxa_bcphidry must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphodry' , strm_Faxa_bcphodry, requirePointer=.true., & + errmsg=subname//'strm_Faxa_bcphodry must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphiwet' , strm_Faxa_bcphiwet, requirePointer=.true., & + errmsg=subname//'strm_Faxa_bcphiwet must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphidry' , strm_Faxa_ocphidry, requirePointer=.true., & + errmsg=subname//'strm_Faxa_ocphidry must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphodry' , strm_Faxa_ocphodry, requirePointer=.true., & + errmsg=subname//'strm_Faxa_ocphodry must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphiwet' , strm_Faxa_ocphiwet, requirePointer=.true., & + errmsg=subname//'strm_Faxa_ocphiwet must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry1' , strm_Faxa_dstdry1 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstdry1 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry2' , strm_Faxa_dstdry2 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstdry2 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry3' , strm_Faxa_dstdry3 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstdry3 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry4' , strm_Faxa_dstdry4 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstdry4 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet1' , strm_Faxa_dstwet1 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstwet1 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet2' , strm_Faxa_dstwet2 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstwet2 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet3' , strm_Faxa_dstwet3 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstwet3 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet4' , strm_Faxa_dstwet4 , requirePointer=.true., & + errmsg=subname//'strm_Faxa_dstwet4 must be associated if flds_presaero is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine datm_pres_aero_init_pointers + + !=============================================================================== + subroutine datm_pres_aero_advance() + + ! The following maps stream input fields to export fields that + ! have an ungridded dimension + + Faxa_bcph(1,:) = strm_Faxa_bcphidry(:) + Faxa_bcph(2,:) = strm_Faxa_bcphodry(:) + Faxa_bcph(3,:) = strm_Faxa_bcphiwet(:) + + Faxa_ocph(1,:) = strm_Faxa_ocphidry(:) + Faxa_ocph(2,:) = strm_Faxa_ocphodry(:) + Faxa_ocph(3,:) = strm_Faxa_ocphiwet(:) + + Faxa_dstdry(1,:) = strm_Faxa_dstdry1(:) + Faxa_dstdry(2,:) = strm_Faxa_dstdry2(:) + Faxa_dstdry(3,:) = strm_Faxa_dstdry3(:) + Faxa_dstdry(4,:) = strm_Faxa_dstdry4(:) + + Faxa_dstwet(1,:) = strm_Faxa_dstwet1(:) + Faxa_dstwet(2,:) = strm_Faxa_dstwet2(:) + Faxa_dstwet(3,:) = strm_Faxa_dstwet3(:) + Faxa_dstwet(4,:) = strm_Faxa_dstwet4(:) + + end subroutine datm_pres_aero_advance + +end module datm_pres_aero_mod diff --git a/datm/datm_pres_co2_mod.F90 b/datm/datm_pres_co2_mod.F90 new file mode 100644 index 000000000..0a792a224 --- /dev/null +++ b/datm/datm_pres_co2_mod.F90 @@ -0,0 +1,98 @@ +module datm_pres_co2_mod + + use ESMF , only : ESMF_SUCCESS, ESMF_State + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + + implicit none + private + + public :: datm_pres_co2_advertise + public :: datm_pres_co2_init_pointers + public :: datm_pres_co2_advance + + ! export state data + real(r8), pointer :: Sa_co2diag(:) => null() + real(r8), pointer :: Sa_co2prog(:) => null() + + ! stream pointer + real(r8), pointer :: strm_Sa_co2diag(:) => null() + real(r8), pointer :: strm_Sa_co2prog(:) => null() + + character(len=CL) :: datamode + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine datm_pres_co2_advertise(fldsExport, datamode_in) + + ! input/output variables + type(fldlist_type) , pointer :: fldsexport + character(len=*) , intent(in) :: datamode_in + !---------------------------------------------------------- + + ! Set module variable + datamode = datamode_in + + call dshr_fldList_add(fldsExport, 'Sa_co2diag') + call dshr_fldList_add(fldsExport, 'Sa_co2prog') + + end subroutine datm_pres_co2_advertise + + !=============================================================================== + subroutine datm_pres_co2_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='(datm_pres_co2_init_pointers): ' + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get pointer to export state + call dshr_state_getfldptr(exportState, 'Sa_co2diag', fldptr1=Sa_co2diag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_state_getfldptr(exportState, 'Sa_co2prog', fldptr1=Sa_co2prog, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get pointer to stream data that will be used below + call shr_strdata_get_stream_pointer(sdat, 'Sa_co2diag', strm_Sa_co2diag, requirePointer=.true., & + errmsg=subname//'strm_Sa_co2diag must be associated if flds_co2 is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (datamode == 'CPLHIST') then + call shr_strdata_get_stream_pointer(sdat, 'Sa_co2prog', strm_Sa_co2prog, requirePointer=.true., & + errmsg=subname//'strm_Sa_co2prog must be associated if flds_co2 is .true. '// & + ' and datamode is CPLHIST', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine datm_pres_co2_init_pointers + + !=============================================================================== + subroutine datm_pres_co2_advance() + + if (datamode == 'CPLHIST') then + Sa_co2diag(:) = strm_Sa_co2diag(:) + Sa_co2prog(:) = strm_Sa_co2prog(:) + else + ! Because we do not currently have any Sa_co2prog in this case, + ! for now set Sa_co2prog equal to Sa_co2diag + Sa_co2diag(:) = strm_Sa_co2diag(:) + Sa_co2prog(:) = strm_Sa_co2diag(:) + end if + + end subroutine datm_pres_co2_advance + +end module datm_pres_co2_mod diff --git a/datm/datm_pres_ndep_mod.F90 b/datm/datm_pres_ndep_mod.F90 new file mode 100644 index 000000000..2b1548e12 --- /dev/null +++ b/datm/datm_pres_ndep_mod.F90 @@ -0,0 +1,113 @@ +module datm_pres_ndep_mod + + use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateItem_Flag + use shr_kind_mod , only : r8=>shr_kind_r8 + 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_fldlist_mod , only : fldlist_type, dshr_fldlist_add + + implicit none + private + + public :: datm_pres_ndep_advertise + public :: datm_pres_ndep_init_pointers + public :: datm_pres_ndep_advance + + ! export state data + real(r8), pointer :: Faxa_ndep(:,:) => null() + + ! stream data + real(r8), pointer :: strm_Faxa_ndep_nhx_dry(:) => null() ! stream cmip7 ndep data + real(r8), pointer :: strm_Faxa_ndep_nhx_wet(:) => null() ! stream cmip7 ndep data + real(r8), pointer :: strm_Faxa_ndep_noy_dry(:) => null() ! stream cmip7 ndep data + real(r8), pointer :: strm_Faxa_ndep_noy_wet(:) => null() ! stream cmip7 ndep data + + real(r8), pointer :: strm_Faxa_ndep_nhx(:) => null() ! pre-cmip7 ndep data + real(r8), pointer :: strm_Faxa_ndep_noy(:) => null() ! pre-cmip7 ndep data + + logical :: use_cmip7_ndep + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine datm_pres_ndep_advertise(fldsExport) + + ! input/output variables + type(fldlist_type) , pointer :: fldsexport + !---------------------------------------------------------- + + call dshr_fldList_add(fldsExport, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) + + end subroutine datm_pres_ndep_advertise + + !=============================================================================== + subroutine datm_pres_ndep_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='(datm_ndep_init_pointers): ' + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get pointer to export state + call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get pointer to stream data that will be used below - if the + ! following stream fields are not in any sdat streams, then a null value is returned + + ! cmip7 ndep forcing + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_nhx_dry', strm_Faxa_ndep_nhx_dry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_nhx_wet', strm_Faxa_ndep_nhx_wet, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_noy_dry', strm_Faxa_ndep_noy_dry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_noy_wet', strm_Faxa_ndep_noy_wet, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! cmip6 ndep forcing + call shr_strdata_get_stream_pointer( sdat, 'Faxa_ndep_nhx', strm_Faxa_ndep_nhx, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_ndep_noy', strm_Faxa_ndep_noy, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine use_cmip_ndep module variable + if (associated(strm_Faxa_ndep_nhx_dry) .and. associated(strm_Faxa_ndep_nhx_wet) .and. & + associated(strm_Faxa_ndep_noy_dry) .and. associated(strm_Faxa_ndep_noy_wet)) then + use_cmip7_ndep = .true. + else if (associated(strm_Faxa_ndep_nhx) .and. associated(strm_Faxa_ndep_noy)) then + use_cmip7_ndep = .false. + else + call shr_log_error('datm_ndep_advance: ERROR: no associated stream pointers for ndep forcing', rc=rc) + return + end if + + end subroutine datm_pres_ndep_init_pointers + + !=============================================================================== + subroutine datm_pres_ndep_advance() + + if (use_cmip7_ndep) then + ! assume data is in kgN/m2/s + Faxa_ndep(1,:) = strm_Faxa_ndep_nhx_dry(:) + strm_Faxa_ndep_nhx_wet(:) + Faxa_ndep(2,:) = strm_Faxa_ndep_noy_dry(:) + strm_Faxa_ndep_noy_wet(:) + else + ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) + Faxa_ndep(1,:) = strm_Faxa_ndep_nhx(:) / 1000._r8 + Faxa_ndep(2,:) = strm_Faxa_ndep_noy(:) / 1000._r8 + end if + + end subroutine datm_pres_ndep_advance + +end module datm_pres_ndep_mod diff --git a/datm/datm_pres_o3_mod.F90 b/datm/datm_pres_o3_mod.F90 new file mode 100644 index 000000000..d6cfa3c00 --- /dev/null +++ b/datm/datm_pres_o3_mod.F90 @@ -0,0 +1,70 @@ +module datm_pres_o3_mod + + use ESMF , only : ESMF_SUCCESS, ESMF_State + use shr_kind_mod , only : r8=>shr_kind_r8 + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + + implicit none + private + + public :: datm_pres_o3_advertise + public :: datm_pres_o3_init_pointers + public :: datm_pres_o3_advance + + ! export state data + real(r8), pointer :: Sa_o3(:) => null() + + ! stream pointer + real(r8), pointer :: strm_Sa_o3(:) => null() + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine datm_pres_o3_advertise(fldsExport) + + ! input/output variables + type(fldlist_type) , pointer :: fldsexport + + call dshr_fldList_add(fldsExport, 'Sa_o3') + + end subroutine datm_pres_o3_advertise + + !=============================================================================== + subroutine datm_pres_o3_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='(datm_o3_init_pointers): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get pointer to export state + call dshr_state_getfldptr(exportState, 'Sa_o3', fldptr1=Sa_o3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get pointer to stream data that will be used below + call shr_strdata_get_stream_pointer(sdat, 'Sa_o3', strm_Sa_o3, requirePointer=.true., & + errmsg=subname//'ERROR: strm_Sa_o3 must be associated if flds_pres_o3 is .true.', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine datm_pres_o3_init_pointers + + !=============================================================================== + subroutine datm_pres_o3_advance() + + Sa_o3(:) = strm_Sa_o3(:) + + end subroutine datm_pres_o3_advance + +end module datm_pres_o3_mod diff --git a/dglc/cime_config/namelist_definition_dglc.xml b/dglc/cime_config/namelist_definition_dglc.xml index 2de7f7143..d860e6d8f 100644 --- a/dglc/cime_config/namelist_definition_dglc.xml +++ b/dglc/cime_config/namelist_definition_dglc.xml @@ -1,7 +1,5 @@ - - - - - - - - $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 03b43af9d..321530056 100644 --- a/docn/cime_config/namelist_definition_docn.xml +++ b/docn/cime_config/namelist_definition_docn.xml @@ -1,7 +1,5 @@ - - @@ -53,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" @@ -68,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 diff --git a/docn/cime_config/stream_definition_docn.xml b/docn/cime_config/stream_definition_docn.xml index ea8738750..fc20d8b32 100644 --- a/docn/cime_config/stream_definition_docn.xml +++ b/docn/cime_config/stream_definition_docn.xml @@ -1,7 +1,5 @@ - - 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..141c20f64 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_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 - use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, chkerr + 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,39 @@ 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 + + if (associated(So_u) .and. .not. associated(strm_So_u)) then + call shr_log_error(subname//& + 'ERROR: strm_So_u must be associated if So_u is associated for docn cplhist mode', rc=rc) + return + end if + if (associated(So_v) .and. .not. associated(strm_So_v)) then + call shr_log_error(subname//& + 'ERROR: strm_So_v must be associated if So_v is associated for docn cplhist mode', rc=rc) + return + end if + if (associated(So_bldepth) .and. .not. associated(strm_So_bldepth)) then + call shr_log_error(subname//& + 'ERROR: strm_So_bldepth must be associated if So_bldepth is associated for docn cplhist mode', rc=rc) + return + end if + + ! 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 +155,27 @@ 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 + So_u(:) = strm_So_u(:) + end if + if (associated(So_v)) then + So_v(:) = strm_So_v(:) + end if + if (associated(So_bldepth)) then + So_bldepth(:) = strm_So_bldepth(:) + 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..a314dfa25 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_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 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..c0d67cbe7 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,6 +204,32 @@ 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(:) @@ -230,8 +256,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 +266,13 @@ subroutine docn_datamode_som_advance(importState, exportState, clock, restart_re rc = ESMF_SUCCESS + So_u(:) = strm_So_u(:) + So_u(:) = 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 +306,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 +324,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 +337,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 +350,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 +362,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..54abfd371 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,53 @@ 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 + ! 'sstdata' read stream, no import data + ! 'sst_aquap_file' read stream, no import data + ! 'som' read stream, needs import data + ! 'som_aquap' read stream, needs import data + ! 'cplhist' read stream, needs import data + ! 'sst_aquap_analytic' analytic, no streams, import or export data + ! 'sst_aquap_constant' analytic, no streams, import or export data + ! 'multilev_cplhist' multilevel ocean input from cplhist data + ! 'multilev' multilevel ocean input + ! 'multilev_sstdata' multilevel ocean input 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') + 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 +381,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 +443,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 +463,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 +487,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 +535,8 @@ subroutine docn_comp_run(gcomp, importState, exportState, clock, target_ymd, tar integer , intent(out) :: rc ! local variables - logical :: first_time = .true. 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 +547,56 @@ 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 + select case (trim(datamode)) + case('sst_aquap_analytic', 'sst_aquap_constant') + skip_restart_read=.true. + case default + skip_restart_read=.false. + end select + if (restart_read .and. .not. skip_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..847a23670 100644 --- a/drof/CMakeLists.txt +++ b/drof/CMakeLists.txt @@ -1,5 +1,6 @@ project(drof Fortran) -set(SRCFILES rof_comp_nuopc.F90) +set(SRCFILES rof_comp_nuopc.F90 + drof_datamode_copyall.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..930de36bd 100644 --- a/drof/cime_config/config_component.xml +++ b/drof/cime_config/config_component.xml @@ -13,24 +13,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 + 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: + 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 + 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 +46,26 @@ 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 694c9c401..56f8646c6 100644 --- a/drof/cime_config/namelist_definition_drof.xml +++ b/drof/cime_config/namelist_definition_drof.xml @@ -1,7 +1,5 @@ - - @@ -46,7 +44,7 @@ - + char streams abs diff --git a/drof/cime_config/stream_definition_drof.xml b/drof/cime_config/stream_definition_drof.xml index d43883ec9..b9f7ddab2 100644 --- a/drof/cime_config/stream_definition_drof.xml +++ b/drof/cime_config/stream_definition_drof.xml @@ -1,7 +1,5 @@ - - diff --git a/drof/drof_datamode_copyall.F90 b/drof/drof_datamode_copyall.F90 new file mode 100644 index 000000000..5d584c4f6 --- /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)) < SHR_CONST_SPVAL) 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_rofl) + if (abs(strm_Forr_rofi(ni)) < SHR_CONST_SPVAL) then + Forr_rofi(:) = strm_Forr_rofi(:) + 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/rof_comp_nuopc.F90 b/drof/rof_comp_nuopc.F90 index 1a1cc6669..ac4886871 100644 --- a/drof/rof_comp_nuopc.F90 +++ b/drof/rof_comp_nuopc.F90 @@ -4,10 +4,10 @@ module rof_comp_nuopc module cdeps_drof_comp #endif - !---------------------------------------------------------------------------- ! 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 @@ -23,26 +23,28 @@ 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, shr_strdata_get_stream_domain - use dshr_strdata_mod , only : shr_strdata_init_from_config + 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 + implicit none - private ! except + private public :: SetServices public :: SetVM + private :: InitializeAdvertise private :: InitializeRealize private :: ModelAdvance @@ -54,52 +56,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() - ! module pointer arrays - real(r8), pointer :: Forr_rofl(:) => null() - real(r8), pointer :: Forr_rofi(:) => null() + ! grid mask and fraction + real(r8), pointer :: model_frac(:) ! currently not used + integer , pointer :: model_mask(:) ! currently not used - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -153,7 +151,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 @@ -164,14 +164,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 @@ -200,24 +196,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 @@ -234,30 +233,26 @@ 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') + if (mainproc) then + write(logunit,'(2a)') subname,'drof datamode = ',trim(datamode) + end if + 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) - 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 + ! Advertise export fields + call drof_datamode_copyall_advertise(exportState, fldsexport, flds_scalar_name, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine InitializeAdvertise @@ -277,9 +272,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 @@ -342,12 +336,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 @@ -362,7 +357,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 @@ -388,11 +383,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') @@ -400,18 +395,13 @@ 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 + 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 + end select ! Read restart if needed if (restart_read .and. .not. skip_restart_read) then @@ -421,7 +411,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 !-------------------- @@ -431,35 +421,27 @@ 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() 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') 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 @@ -468,15 +450,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 eba63087e..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,8 +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,110)'(dshr_addfield_add) setting pointer for export state '//trim(state_fld) -110 format(a) + write(logunit,'(3a)') subname,' setting pointer for export state ',trim(state_fld) end if end subroutine dshr_dfield_add_1d @@ -195,8 +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,110)'(dshr_addfield_add) setting pointer for export state '//trim(state_fld) -110 format(a) + write(logunit,'(3a)') subname,' setting pointer for export state ',trim(state_fld) end if ! Return array pointer if argument is present @@ -205,9 +203,9 @@ subroutine dshr_dfield_add_1d_stateptr(dfields, sdat, state_fld, strm_fld, state ! write output if (mainproc) then if (found) then - write(logunit,100)'(dshr_addfield_add) set pointer to stream field strm_'//trim(strm_fld)//& + write(logunit,'(4a,i0,a,i0)') subname,& + ' setting pointer to stream field strm_',trim(strm_fld), & ' stream index = ',ns,' field bundle index= ',nf -100 format(a,i6,2x,a,i6) end if write(logunit,*) end if @@ -299,8 +297,8 @@ 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,*)'(dshr_addfield_add) using stream field strm_'//& - trim(strm_flds(nf))//' for 2d '//trim(state_fld) + write(logunit,'(5a)') subname, & + ' using stream field strm_',trim(strm_flds(nf)),' for 2d ',trim(state_fld) end if end if end do @@ -316,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,*)'(dshr_addfield_add) 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 @@ -406,8 +404,8 @@ 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,*)'(dshr_addfield_add) using stream field strm_'//& - trim(strm_flds(nf))//' for 2d '//trim(state_fld) + write(logunit,'(5a)') subname, & + ' using stream field strm_',trim(strm_flds(nf)),' for 2d ',trim(state_fld) end if end if end do @@ -423,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,*)'(dshr_addfield_add) 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/cime_config/namelist_definition_dwav.xml b/dwav/cime_config/namelist_definition_dwav.xml index 16517984f..9cfbd3d91 100644 --- a/dwav/cime_config/namelist_definition_dwav.xml +++ b/dwav/cime_config/namelist_definition_dwav.xml @@ -1,7 +1,5 @@ - - diff --git a/dwav/cime_config/stream_definition_dwav.xml b/dwav/cime_config/stream_definition_dwav.xml index 9bd1ecaab..46d1b4fe4 100644 --- a/dwav/cime_config/stream_definition_dwav.xml +++ b/dwav/cime_config/stream_definition_dwav.xml @@ -1,7 +1,5 @@ - - diff --git a/dwav/dwav_datamode_copyall.F90 b/dwav/dwav_datamode_copyall.F90 new file mode 100644 index 000000000..def12cc4e --- /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_ustokes', 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_methods_mod.F90 b/streams/dshr_methods_mod.F90 index 59500d11d..733cb2548 100644 --- a/streams/dshr_methods_mod.F90 +++ b/streams/dshr_methods_mod.F90 @@ -14,7 +14,7 @@ module dshr_methods_mod use ESMF , only : ESMF_TraceRegionEnter, ESMF_TraceRegionExit use shr_kind_mod , only : r8=>shr_kind_r8, cs=>shr_kind_cs, cl=>shr_kind_cl use shr_log_mod , only : shr_log_error - + implicit none public @@ -32,7 +32,7 @@ module dshr_methods_mod character(len=1024) :: msgString integer, parameter :: memdebug_level=1 - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -41,6 +41,8 @@ module dshr_methods_mod subroutine dshr_state_getfldptr(State, fldname, fldptr1, fldptr2, allowNullReturn, rc) + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + ! ---------------------------------------------- ! Get pointer to a state field ! ---------------------------------------------- @@ -50,10 +52,11 @@ subroutine dshr_state_getfldptr(State, fldname, fldptr1, fldptr2, allowNullRetur character(len=*) , intent(in) :: fldname real(R8) , pointer, intent(inout), optional :: fldptr1(:) real(R8) , pointer, intent(inout), optional :: fldptr2(:,:) - logical , intent(in),optional :: allowNullReturn + logical , intent(in) , optional :: allowNullReturn integer , intent(out) :: rc ! local variables + integer :: ni, nj type(ESMF_Field) :: lfield integer :: itemCount character(len=*), parameter :: subname='(dshr_state_getfldptr)' @@ -61,6 +64,12 @@ subroutine dshr_state_getfldptr(State, fldname, fldptr1, fldptr2, allowNullRetur rc = ESMF_SUCCESS + ! only one of fldptr1 or fldptr2 can be present + if (present(fldptr1) .and. present(fldptr2)) then + call shr_log_error(subname//": both fldptr1 and fldptr2 cannot be present ",rc=rc) + return + end if + if (present(allowNullReturn)) then call ESMF_StateGet(State, itemSearch=trim(fldname), itemCount=itemCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -74,7 +83,9 @@ subroutine dshr_state_getfldptr(State, fldname, fldptr1, fldptr2, allowNullRetur if (chkerr(rc,__LINE__,u_FILE_u)) return else ! the call to just returns if it cannot find the field - call ESMF_LogWrite(trim(subname)//" Could not find the field: "//trim(fldname)//" just returning", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//" Could not find the field: "//trim(fldname)//& + " just returning", ESMF_LOGMSG_INFO) + return end if else call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) @@ -84,6 +95,19 @@ subroutine dshr_state_getfldptr(State, fldname, fldptr1, fldptr2, allowNullRetur if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Initialize pointer value + if (present(fldptr1)) then + do ni = 1,size(fldptr1) + fldptr1(ni) = nan + end do + else if (present(fldptr2)) then + do nj = 1,size(fldptr2, dim=2) + do ni = 1,size(fldptr2, dim=1) + fldptr2(ni,nj) = nan + end do + end do + end if + end subroutine dshr_state_getfldptr !=============================================================================== @@ -141,7 +165,7 @@ subroutine dshr_state_diagnose(State, flds_scalar_name, string, rc) write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" endif else - call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) + call shr_log_error(subname//": ERROR rank not supported ", rc=rc) return endif call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -178,7 +202,7 @@ subroutine dshr_fldbun_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) rc = ESMF_SUCCESS if (.not. dshr_fldbun_FldChk(FB, trim(fldname), rc=rc)) then - call shr_log_error(trim(subname)//": ERROR field "//trim(fldname)//" not in FB ", rc=rc) + call shr_log_error(subname//": ERROR field "//trim(fldname)//" not in FB ", rc=rc) return endif call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) @@ -187,7 +211,7 @@ subroutine dshr_fldbun_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound(1) > 0) then if (.not.present(fldptr2)) then - call shr_log_error(trim(subname)//": ERROR missing rank=2 array ", & + call shr_log_error(subname//": ERROR missing rank=2 array ", & line=__LINE__, file=u_FILE_u, rc=rc) return endif @@ -196,7 +220,7 @@ subroutine dshr_fldbun_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) lrank = 2 else if (.not.present(fldptr1)) then - call shr_log_error(trim(subname)//": ERROR missing rank=1 array ", & + call shr_log_error(subname//": ERROR missing rank=1 array ", & line=__LINE__, file=u_FILE_u, rc=rc) return endif @@ -258,7 +282,7 @@ subroutine dshr_fldbun_regrid(FBsrc, FBdst, RH, zeroregion, rc) ! check that input and output field bundles have identical number of fields if (fieldcount_src /= fieldcount_dst) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldcount_src and field_count_dst are not the same") + call ESMF_LogWrite(subname//": ERROR fieldcount_src and field_count_dst are not the same") rc = ESMF_FAILURE if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) @@ -337,7 +361,7 @@ subroutine dshr_fldbun_getNameN(FB, fieldnum, fieldname, rc) call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then - call shr_log_error(trim(subname)//": ERROR fieldnum > fieldCount ", rc=rc) + call shr_log_error(subname//": ERROR fieldnum > fieldCount ", rc=rc) return endif @@ -374,7 +398,7 @@ logical function dshr_fldbun_FldChk(FB, fldname, rc) call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) then - call shr_log_error(trim(subname)//" Error checking field: "//trim(fldname), rc=rc) + call shr_log_error(subname//" Error checking field: "//trim(fldname), rc=rc) return endif @@ -417,20 +441,20 @@ subroutine dshr_fldbun_Field_diagnose(FB, fieldname, string, rc) ! no local data elseif (lrank == 1) then if (size(dataPtr1d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + write(msgString,'(A,3g14.7,i8)') subname//' '//trim(lstring)//': '//trim(fieldname), & minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + write(msgString,'(A,a)') subname//' '//trim(lstring)//': '//trim(fieldname)," no data" endif elseif (lrank == 2) then if (size(dataPtr2d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + write(msgString,'(A,3g14.7,i8)') subname//' '//trim(lstring)//': '//trim(fieldname), & minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + write(msgString,'(A,a)') subname//' '//trim(lstring)//': '//trim(fieldname)," no data" endif else - call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) + call shr_log_error(subname//": ERROR rank not supported ", rc=rc) return endif call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -484,23 +508,23 @@ subroutine dshr_fldbun_diagnose(FB, string, rc) elseif (lrank == 1) then if (size(dataPtr1d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + write(msgString,'(A,3g14.7,i8)') subname//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), " no data" + write(msgString,'(A,a)') subname//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), " no data" endif elseif (lrank == 2) then if (size(dataPtr2d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + write(msgString,'(A,3g14.7,i8)') subname//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + write(msgString,'(A,a)') subname//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & " no data" endif else - call shr_log_error(trim(subname)//": ERROR rank not supported ", rc=rc) + call shr_log_error(subname//": ERROR rank not supported ", rc=rc) return endif call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -509,7 +533,7 @@ subroutine dshr_fldbun_diagnose(FB, string, rc) ! Deallocate memory deallocate(lfieldnamelist) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO) end subroutine dshr_fldbun_diagnose @@ -551,17 +575,17 @@ subroutine dshr_field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) if (labort) then call ESMF_FieldGet(field, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_log_error(trim(subname)//": field "//trim(name)//" has no data not allocated ", rc=rc) + call shr_log_error(subname//": field "//trim(name)//" has no data not allocated ", rc=rc) return else - call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(subname//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) endif else call ESMF_FieldGet(field, ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound(1) > 0) then if (.not.present(fldptr2)) then - call shr_log_error(trim(subname)//": ERROR missing rank=2 array for "//trim(name), & + call shr_log_error(subname//": ERROR missing rank=2 array for "//trim(name), & line=__LINE__, file=u_FILE_u, rc=rc) return endif @@ -570,7 +594,7 @@ subroutine dshr_field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) lrank = 2 else if (.not.present(fldptr1)) then - call shr_log_error(trim(subname)//": ERROR missing rank=1 array for "//trim(name), & + call shr_log_error(subname//": ERROR missing rank=1 array for "//trim(name), & line=__LINE__, file=u_FILE_u, rc=rc) return endif diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 5c1ba395c..94109d456 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -19,7 +19,7 @@ module dshr_strdata_mod use ESMF , only : ESMF_FieldReGridStore, ESMF_FieldRedistStore, ESMF_UNMAPPEDACTION_IGNORE use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_FieldRegrid, ESMF_FieldFill, ESMF_FieldIsCreated use ESMF , only : ESMF_REGION_TOTAL, ESMF_FieldGet, ESMF_TraceRegionExit, ESMF_TraceRegionEnter - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF , only : ESMF_LOGMSG_INFO use shr_kind_mod , only : r8=>shr_kind_r8, r4=>shr_kind_r4, i2=>shr_kind_I2 use shr_kind_mod , only : cs=>shr_kind_cs, cl=>shr_kind_cl, cxx=>shr_kind_cxx, cx=>shr_kind_cx use shr_log_mod , only : shr_log_error @@ -45,7 +45,6 @@ module dshr_strdata_mod use dshr_methods_mod , only : dshr_fldbun_getfldptr, dshr_fldbun_getfieldN, dshr_fldbun_fldchk, chkerr use dshr_methods_mod , only : dshr_fldbun_diagnose, dshr_fldbun_regrid, dshr_field_getfldptr use shr_sys_mod , only : shr_sys_abort - use pio , only : file_desc_t, iosystem_desc_t, io_desc_t, var_desc_t use pio , only : pio_openfile, pio_closefile, pio_nowrite use pio , only : pio_seterrorhandling, pio_initdecomp, pio_freedecomp @@ -54,11 +53,15 @@ module dshr_strdata_mod use pio , only : pio_double, pio_real, pio_int, pio_offset_kind, pio_get_var use pio , only : pio_read_darray, pio_setframe, pio_fill_double, pio_get_att, pio_inq_att use pio , only : PIO_BCAST_ERROR, PIO_RETURN_ERROR, PIO_NOERR, PIO_INTERNAL_ERROR, PIO_SHORT + use shr_strconvert_mod, only : toString implicit none private + ! Public data types public :: shr_strdata_type + + ! Public routines public :: shr_strdata_init_from_config public :: shr_strdata_init_from_inline public :: shr_strdata_setOrbs @@ -69,17 +72,18 @@ module dshr_strdata_mod public :: shr_strdata_get_stream_fieldbundle public :: shr_strdata_print - private :: shr_strdata_init_model_domain - private :: shr_strdata_get_stream_nlev - private :: shr_strdata_readLBUB - interface shr_strdata_get_stream_pointer module procedure shr_strdata_get_stream_pointer_1d module procedure shr_strdata_get_stream_pointer_2d end interface shr_strdata_get_stream_pointer - ! public data members: - integer :: debug = 0 ! local debug flag + ! Private routines + private :: shr_strdata_init_model_domain + private :: shr_strdata_get_stream_nlev + private :: shr_strdata_readLBUB + + ! Public data members: + integer :: debug_level = 0 ! local debug flag character(len=*) ,parameter, public :: shr_strdata_nullstr = 'null' character(len=*) ,parameter :: shr_strdata_unset = 'NOT_SET' integer ,parameter :: main_task = 0 @@ -116,6 +120,7 @@ module dshr_strdata_mod type(shr_strdata_perstream), allocatable :: pstrm(:) ! stream info type(shr_stream_streamType), pointer :: stream(:)=> null() ! stream datatype logical :: mainproc + integer :: logunit ! logunit if mainproc == main_taks integer :: io_type ! pio info integer :: io_format ! pio info integer :: modeldt = 0 ! model dt in seconds @@ -142,7 +147,7 @@ module dshr_strdata_mod type(ESMF_Field) :: field_vector_dst ! needed for vector fields real(r8) ,parameter :: deg2rad = SHR_CONST_PI/180.0_r8 - character(*) ,parameter :: u_FILE_u = & + character(len=*) ,parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -195,12 +200,13 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, integer , intent(out) :: rc ! local variables - type(ESMF_VM) :: vm integer :: localPet + type(ESMF_VM) :: vm + integer :: stream_count + integer :: istat character(len=*), parameter :: subname='(shr_strdata_init_from_config)' ! ---------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) #ifdef CESMCOUPLED ! Initialize sdat pio @@ -209,23 +215,35 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, sdat%io_format = shr_pio_getioformat(trim(compname)) #endif + ! Initialize module variable mainproc call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Initialize sdat streams (read xml file for streams) sdat%mainproc = (localPet == main_task) + ! Initialize sdat logunit + sdat%logunit = logunit + + ! Initialize sdat streams #ifdef DISABLE_FoX - call shr_stream_init_from_esmfconfig(streamfilename, sdat%stream, logunit, & + ! Read input ESMF config file + call shr_stream_init_from_esmfconfig(streamfilename, sdat%stream, sdat%logunit, & sdat%pio_subsystem, sdat%io_type, sdat%io_format, rc=rc) #else - call shr_stream_init_from_xml(streamfilename, sdat%stream, sdat%mainproc, logunit, & + ! Read input xml file + call shr_stream_init_from_xml(streamfilename, sdat%stream, sdat%mainproc, sdat%logunit, & sdat%pio_subsystem, sdat%io_type, sdat%io_format, trim(compname), rc=rc) #endif - allocate(sdat%pstrm(shr_strdata_get_stream_count(sdat))) + ! Allocate pstrm array + stream_count = shr_strdata_get_stream_count(sdat) + allocate(sdat%pstrm(stream_count), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for sdat%pstrm with stream_count '//toString(stream_count), rc=rc) + return + end if ! Initialize sdat model domain sdat%model_mesh = model_mesh @@ -248,39 +266,51 @@ subroutine shr_strdata_init_from_inline(sdat, my_task, logunit, compname, & stream_src_mask, stream_dst_mask, stream_name, rc) ! input/output variables - type(shr_strdata_type) , intent(inout) :: sdat ! stream data type - integer , intent(in) :: my_task ! my mpi task - integer , intent(in) :: logunit ! stdout logunit - character(len=*) , intent(in) :: compname ! component name (e.g. ATM, OCN, ...) - type(ESMF_Clock) , intent(in) :: model_clock ! model clock - type(ESMF_Mesh) , intent(in) :: model_mesh ! model mesh - character(*) , intent(in) :: stream_meshFile ! full pathname to stream mesh file - character(*) , intent(in) :: stream_lev_dimname ! name of vertical dimension in stream - character(*) , intent(in) :: stream_mapalgo ! stream mesh -> model mesh mapping type - character(*) , intent(in) :: stream_filenames(:) ! stream data filenames (full pathnamesa) - character(*) , intent(in) :: stream_fldListFile(:) ! file field names, colon delim list - character(*) , intent(in) :: stream_fldListModel(:) ! model field names, colon delim list - integer , intent(in) :: stream_yearFirst ! first year to use - integer , intent(in) :: stream_yearLast ! last year to use - integer , intent(in) :: stream_yearAlign ! align yearFirst with this model year - integer , intent(in) :: stream_offset ! offset in seconds of stream data - character(*) , intent(in) :: stream_taxMode ! time axis mode - real(r8) , intent(in) :: stream_dtlimit ! ratio of max/min stream delta times - character(*) , intent(in) :: stream_tintalgo ! time interpolation algorithm - integer, optional , intent(in) :: stream_src_mask ! source mask value - integer, optional , intent(in) :: stream_dst_mask ! destination mask value - character(*), optional , intent(in) :: stream_name ! name of stream - integer, optional , intent(out) :: rc ! error code + type(shr_strdata_type) , intent(inout) :: sdat ! stream data type + integer , intent(in) :: my_task ! my mpi task + integer , intent(in) :: logunit ! stdout logunit + character(len=*) , intent(in) :: compname ! component name (e.g. ATM, OCN, ...) + type(ESMF_Clock) , intent(in) :: model_clock ! model clock + type(ESMF_Mesh) , intent(in) :: model_mesh ! model mesh + character(len=*) , intent(in) :: stream_meshFile ! full pathname to stream mesh file + character(len=*) , intent(in) :: stream_lev_dimname ! name of vertical dimension in stream + character(len=*) , intent(in) :: stream_mapalgo ! stream mesh -> model mesh mapping type + character(len=*) , intent(in) :: stream_filenames(:) ! stream data filenames (full pathnamesa) + character(len=*) , intent(in) :: stream_fldListFile(:) ! file field names, colon delim list + character(len=*) , intent(in) :: stream_fldListModel(:) ! model field names, colon delim list + integer , intent(in) :: stream_yearFirst ! first year to use + integer , intent(in) :: stream_yearLast ! last year to use + integer , intent(in) :: stream_yearAlign ! align yearFirst with this model year + integer , intent(in) :: stream_offset ! offset in seconds of stream data + character(len=*) , intent(in) :: stream_taxMode ! time axis mode + real(r8) , intent(in) :: stream_dtlimit ! ratio of max/min stream delta times + character(len=*) , intent(in) :: stream_tintalgo ! time interpolation algorithm + integer , optional , intent(in) :: stream_src_mask ! source mask value + integer , optional , intent(in) :: stream_dst_mask ! destination mask value + character(len=*) , optional , intent(in) :: stream_name ! name of stream + integer , optional , intent(out) :: rc ! error code ! local variables - integer :: src_mask = 0 - integer :: dst_mask = 0 + integer :: src_mask = 0 + integer :: dst_mask = 0 + integer :: istat + character(len=*), parameter :: subname='(shr_strdata_init_from_inline)' ! ---------------------------------------------- rc = ESMF_SUCCESS ! Initialize sdat%logunit and sdat%mainproc sdat%mainproc = (my_task == main_task) + sdat%logunit = logunit + + if (sdat%mainproc) then + if (present(stream_name)) then + write(sdat%logunit,'(3a)') subname,' inline call for stream ',trim(stream_name) + else + write(sdat%logunit,'(2a)') subname,' inline call for generic stream stream_data' + end if + end if + #ifdef CESMCOUPLED ! Initialize sdat pio sdat%pio_subsystem => shr_pio_getiosys(trim(compname)) @@ -293,7 +323,11 @@ subroutine shr_strdata_init_from_inline(sdat, my_task, logunit, compname, & if (present(stream_dst_mask)) dst_mask = stream_dst_mask ! Initialize sdat%pstrm - ASSUME only 1 stream - allocate(sdat%pstrm(1)) + allocate(sdat%pstrm(1), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//': allocation error for sdat%pstrm(1)', rc=rc) + return + end if ! Initialize sdat model domain sdat%model_mesh = model_mesh @@ -307,7 +341,7 @@ subroutine shr_strdata_init_from_inline(sdat, my_task, logunit, compname, & stream_yearFirst, stream_yearLast, stream_yearAlign, & stream_offset, stream_taxmode, stream_tintalgo, stream_dtlimit, & stream_fldlistFile, stream_fldListModel, stream_fileNames, & - logunit, trim(compname), src_mask, dst_mask) + sdat%logunit, trim(compname), sdat%mainproc, src_mask, dst_mask) ! Now finish initializing sdat call shr_strdata_init(sdat, model_clock, stream_name, rc) @@ -328,6 +362,7 @@ subroutine shr_strdata_init_model_domain( sdat, rc) ! local variables integer :: n ! generic counters + integer :: istat type(ESMF_DistGrid) :: distGrid integer :: tileCount integer, allocatable :: elementCountPTile(:) @@ -346,14 +381,25 @@ subroutine shr_strdata_init_model_domain( sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! initialize sdat%model_gindex - allocate(sdat%model_gindex(sdat%model_lsize)) + allocate(sdat%model_gindex(sdat%model_lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for sdat%model_gindex with size '//toString(sdat%model_lsize), rc=rc) + return + end if + call ESMF_DistGridGet(distGrid, localDe=0, seqIndexList=sdat%model_gindex, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! initialize sdat%model_gsize call ESMF_DistGridGet(distGrid, tileCount=tileCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(elementCountPTile(tileCount)) + allocate(elementCountPTile(tileCount), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for distGrid elementCountPTile with size '//toString(tileCount), rc=rc) + return + end if call ESMF_distGridGet(distGrid, elementCountPTile=elementCountPTile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sdat%model_gsize = 0 @@ -366,11 +412,32 @@ subroutine shr_strdata_init_model_domain( sdat, rc) call ESMF_MeshGet(sdat%model_mesh, spatialDim=spatialDim, & numOwnedElements=numOwnedElements, elementdistGrid=distGrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) + allocate(ownedElemCoords(spatialDim*numOwnedElements), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for mesh ownedElemCoords with size '//toString(spatialDim*numOwnedElements), rc=rc) + return + end if + allocate(elementCountPTile(tileCount), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for mesh elementCountPTile with size '//toString(tileCount), rc=rc) + return + end if call ESMF_MeshGet(sdat%model_mesh, ownedElemCoords=ownedElemCoords) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(sdat%model_lon(numOwnedElements)) - allocate(sdat%model_lat(numOwnedElements)) + allocate(sdat%model_lon(numOwnedElements), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for sdat%model_lon with size '//toString(numOwnedElements), rc=rc) + return + end if + allocate(sdat%model_lat(numOwnedElements), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for sdat%model_lat with size '//toString(numOwnedElements), rc=rc) + return + end if do n = 1, numOwnedElements sdat%model_lon(n) = ownedElemCoords(2*n-1) sdat%model_lat(n) = ownedElemCoords(2*n) @@ -382,10 +449,10 @@ end subroutine shr_strdata_init_model_domain subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ! input/output variables - type(shr_strdata_type) , intent(inout), target :: sdat - type(ESMF_Clock) , intent(in) :: model_clock - character(*), optional , intent(in) :: stream_name - integer , intent(out) :: rc + type(shr_strdata_type) , intent(inout), target :: sdat + type(ESMF_Clock) , intent(in) :: model_clock + character(len=*), optional , intent(in) :: stream_name + integer , intent(out) :: rc ! local variables type(ESMF_Mesh), pointer :: stream_mesh @@ -397,46 +464,42 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) type(ESMF_Field) :: lfield ! temporary type(ESMF_Field) :: lfield_dst ! temporary integer :: srcTermProcessing_Value = 0 ! should this be a module variable? - integer :: localpet logical :: fileExists type(ESMF_VM) :: vm - logical :: mainproc integer :: nvars - integer :: i, stream_nlev, index + integer :: i, stream_nlev, index, istat character(CL) :: stream_vector_names character(len=*), parameter :: subname='(shr_sdat_init)' ! ---------------------------------------------- rc = ESMF_SUCCESS + ! Obtain vm (needed in following loop) call ESMF_VmGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localpet=localPet, rc=rc) - mainproc= (localPet==main_task) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over streams - do ns = 1,shr_strdata_get_stream_count(sdat) + loop_over_streams1: do ns = 1,shr_strdata_get_stream_count(sdat) ! Initialize calendar for stream n call ESMF_VMBroadCast(vm, sdat%stream(ns)%calendar, CS, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set pointer for stream_mesh stream_mesh => sdat%pstrm(ns)%stream_mesh ! Create the target stream mesh from the stream mesh file - ! TODO: add functionality if the stream mesh needs to be created from a grid call shr_stream_getMeshFileName (sdat%stream(ns), filename) - if (filename /= 'none' .and. mainproc) then + if (filename /= 'none' .and. sdat%mainproc) then inquire(file=trim(filename),exist=fileExists) if (.not. fileExists) then - call shr_log_error(subName//"ERROR: file does not exist: "//trim(fileName), rc=rc) + call shr_log_error(subname//"ERROR: stream mesh file does not exist: "//trim(fileName), rc=rc) return end if endif - ! - ! We do not yet have mask information, but we are required to set it here and change it - ! later. - ! - if(filename /= 'none') then + + ! We do not yet have mask information, but we are required to set it here and change it later. + if (filename /= 'none') then stream_mesh = ESMF_MeshCreate(trim(filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -449,19 +512,33 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) nvars = sdat%stream(ns)%nvars ! Allocate memory - allocate(sdat%pstrm(ns)%fldList_model(nvars)) + allocate(sdat%pstrm(ns)%fldList_model(nvars), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for sdat%pstrm('//toString(ns)//')%fldlist_model with nvars '//toString(nvars), rc=rc) + return + end if call shr_stream_getModelFieldList(sdat%stream(ns), sdat%pstrm(ns)%fldlist_model) - allocate(sdat%pstrm(ns)%fldlist_stream(nvars)) + allocate(sdat%pstrm(ns)%fldlist_stream(nvars), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for sdat%pstrm('//toString(ns)//')%fldlist_stream with nvars '//toString(nvars), rc=rc) + return + end if call shr_stream_getStreamFieldList(sdat%stream(ns), sdat%pstrm(ns)%fldlist_stream) ! Create field bundles on model mesh if (sdat%stream(ns)%readmode=='single') then sdat%pstrm(ns)%stream_lb = 1 sdat%pstrm(ns)%stream_ub = 2 - allocate(sdat%pstrm(ns)%fldbun_data(2)) - if (mainproc) then - write(sdat%stream(1)%logunit,'(a,i8)') trim(subname)//" Creating field bundle array fldbun_data of size 2 for stream ",& - ns + allocate(sdat%pstrm(ns)%fldbun_data(2), stat=istat) + if (istat /= 0) then + call shr_log_error(subName//': allocation error for sdat%pstrm(ns)%fldbun_data(2) ',rc=rc) + return + end if + if (sdat%mainproc) then + write(sdat%logunit,'(2a,i0)') subname, & + " Creating field bundle array on model mesh for (lb,ub) of input data for stream ",ns end if else if(sdat%stream(ns)%readmode=='full_file') then ! TODO: add this in @@ -485,10 +562,10 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) end if call ESMF_FieldBundleAdd(sdat%pstrm(ns)%fldbun_data(i), (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mainproc) then + if (sdat%mainproc) then if (i == 1) then - write(sdat%stream(1)%logunit,'(a,i8)') " adding field "//trim(sdat%pstrm(ns)%fldlist_model(nfld))//& - " to fldbun_data for stream ",ns + write(sdat%logunit,'(4a)') subname,& + " adding field ",trim(sdat%pstrm(ns)%fldlist_model(nfld))," to field bundle array " end if end if enddo @@ -606,10 +683,11 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) end if end if - end do ! end of loop over streams + end do loop_over_streams1 ! end of loop over streams ! Check for vector pairs in the stream - BOTH ucomp and vcomp MUST BE IN THE SAME STREAM - do ns = 1,shr_strdata_get_stream_count(sdat) + loop_over_stream2: do ns = 1,shr_strdata_get_stream_count(sdat) + stream_mesh => sdat%pstrm(ns)%stream_mesh stream_nlev = sdat%pstrm(ns)%stream_nlev stream_vector_names = trim(sdat%stream(ns)%stream_vectors) @@ -637,12 +715,12 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ESMF_TYPEKIND_r8, name='stream_vector', meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/1/), ungriddedUbound=(/2/), gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mainproc) then - write(sdat%stream(1)%logunit,'(a,i8)') "creating ESMF stream vector field with names" //& - trim(stream_vector_names)//" for stream ",ns + if (sdat%mainproc) then + write(sdat%logunit,'(4a,i0)') subname," creating ESMF stream vector field with names", & + trim(stream_vector_names)," for stream ",ns end if end if - enddo + enddo loop_over_stream2 ! initialize sdat model clock and calendar sdat%model_clock = model_clock @@ -658,13 +736,13 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) end if ! print sdat output - if (mainproc) then + if (sdat%mainproc) then if (present(stream_name)) then call shr_strdata_print(sdat, trim(stream_name)) else call shr_strdata_print(sdat, 'stream_data') end if - write(sdat%stream(1)%logunit,*) ' successfully initialized sdat' + write(sdat%logunit,'(2a)') subname,' successfully initialized sdat' endif end subroutine shr_strdata_init @@ -689,7 +767,8 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) integer :: stream_nlev integer :: old_handle ! previous setting of pio error handling character(CS) :: units - character(*), parameter :: subname = '(shr_strdata_set_stream_domain) ' + integer :: istat + character(len=*), parameter :: subname = '(shr_strdata_get_stream_nlev) ' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -704,10 +783,18 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) call shr_stream_getData(sdat%stream(stream_index), 1, filename) end if call ESMF_VMBroadCast(vm, filename, CX, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return rcode = pio_openfile(sdat%pio_subsystem, pioid, sdat%io_type, trim(filename), pio_nowrite) rcode = pio_inq_dimid(pioid, trim(sdat%stream(stream_index)%lev_dimname), dimid) rcode = pio_inq_dimlen(pioid, dimid, stream_nlev) - allocate(sdat%pstrm(stream_index)%stream_vlevs(stream_nlev)) + allocate(sdat%pstrm(stream_index)%stream_vlevs(stream_nlev), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for sdat%pstrm('//toString(stream_index)//')%stream_vlevs '//& + ' with stream_nlev '//toString(stream_nlev), rc=rc) + return + end if + rcode = pio_inq_varid(pioid, trim(sdat%stream(stream_index)%lev_dimname), varid) rcode = pio_get_var(pioid, varid, sdat%pstrm(stream_index)%stream_vlevs) @@ -724,9 +811,13 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) call pio_closefile(pioid) end if if (sdat%mainproc) then - write(sdat%stream(1)%logunit,*) trim(subname)//' stream_nlev = ',stream_nlev + write(sdat%logunit,*) + write(sdat%logunit,'(2a,i0,a,i0)') subname, & + 'Stream: ',stream_index,' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then - write(sdat%stream(1)%logunit,*)' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs + write(sdat%logunit,'(2a,i0,a)') subname,& + 'Stream: ',stream_index,' has following vertical levels ' + write(sdat%logunit,*)sdat%pstrm(stream_index)%stream_vlevs end if end if @@ -758,7 +849,8 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r real(r8), allocatable :: data_double(:) integer :: pio_iovartype integer :: lsize - character(*), parameter :: subname = '(shr_strdata_set_stream_domain) ' + integer :: istat + character(len=*), parameter :: subname = '(shr_strdata_set_stream_domain) ' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -770,6 +862,7 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r call shr_stream_getData(sdat%stream(stream_index), 1, filename) end if call ESMF_VMBroadCast(vm, filename, CX, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Open the file rcode = pio_openfile(sdat%pio_subsystem, pioid, sdat%io_type, trim(filename), pio_nowrite) @@ -783,12 +876,20 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r rcode = pio_inq_varid(pioid, trim(fldname), varid) rcode = pio_inq_vartype(pioid, varid, pio_iovartype) if (pio_iovartype == PIO_REAL) then - allocate(data_real(lsize)) + allocate(data_real(lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_real with size '//toString(lsize), rc=rc) + return + end if call pio_read_darray(pioid, varid, pio_iodesc, data_real, rcode) flddata(:) = real(data_real(:), kind=r8) deallocate(data_real) else if (pio_iovartype == PIO_DOUBLE) then - allocate(data_double(lsize)) + allocate(data_double(lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_double with size '//toString(lsize), rc=rc) + return + end if call pio_read_darray(pioid, varid, pio_iodesc, data_double, rcode) flddata(:) = data_double(:) deallocate(data_double) @@ -897,16 +998,18 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) integer :: datayear,datamonth,dataday ! data date year month day integer :: nstreams integer :: stream_index + integer :: istat real(r8) ,parameter :: solZenMin = 0.001_r8 ! minimum solar zenith angle integer ,parameter :: tadj = 2 character(len=*) ,parameter :: timname = "_strd_adv" - character(*) ,parameter :: subname = "(shr_strdata_advance) " - character(*) ,parameter :: F00 = "('(shr_strdata_advance) ',a)" - character(*) ,parameter :: F01 = "('(shr_strdata_advance) ',a,a,i4,2(f10.5,2x))" + character(len=*) ,parameter :: subname = "(shr_strdata_advance) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + ! Note that input variable logunit is no longer used, but is kept in place here for + ! backwards compatibility + nullify(dataptr1d) nullify(dataptr1d_ub) nullify(dataptr1d_lb) @@ -927,15 +1030,23 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) lstr = trim(istr) ! To avoid an unused dummy variable warning if(present(timers)) then - write(sdat%stream(1)%logunit,*) trim(subname),'optional variable timers present but unused' + write(sdat%logunit,'(2a)') subname,'optional variable timers present but unused' endif call ESMF_TraceRegionEnter(trim(lstr)//trim(timname)//'_total') sdat%ymd = ymd sdat%tod = tod if (nstreams > 0) then - allocate(newData(nstreams)) - allocate(ymdmod(nstreams)) + allocate(newData(nstreams), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of newData with size '//toString(nstreams), rc=rc) + return + end if + allocate(ymdmod(nstreams), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of ymd with size '//toString(nstreams), rc=rc) + return + end if do ns = 1,nstreams ! --------------------------------------------------------- @@ -972,15 +1083,18 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) case ('full_file') ! TODO: need to put in capability to read all stream data at once case default - write(logunit,F00) "ERROR: Unsupported readmode : ", trim(sdat%stream(ns)%readmode) + if (sdat%mainproc) then + write(sdat%logunit,'(2a)') "ERROR: Unsupported readmode : ", trim(sdat%stream(ns)%readmode) + end if call shr_log_error(subName//"ERROR: Unsupported readmode: "//trim(sdat%stream(ns)%readmode), rc=rc) return end select - if (debug > 0 .and. sdat%mainproc) then - write(sdat%stream(1)%logunit,*) trim(subname),' newData flag = ',ns,newData(ns) - write(sdat%stream(1)%logunit,*) trim(subname),' LB ymd,tod = ',ns,sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB - write(sdat%stream(1)%logunit,*) trim(subname),' UB ymd,tod = ',ns,sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB + if (sdat%mainproc .and. newData(ns)) then + write(sdat%logunit,'(2a,i0,a,a,2(i0,2x),a,2(i0,2x))') subname, & + ' Stream: ',ns,' reading new data with ', & + ' LB ymd,tod = ',sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB, & + ' UB ymd,tod = ',sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB endif ! --------------------------------------------------------- @@ -999,9 +1113,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) else if (.not. ( trim(sdat%model_calendar) == trim(shr_cal_gregorian)) .and. & (trim(sdat%stream(ns)%calendar) == trim(shr_cal_noleap))) then ! case (3), abort - write(logunit,*) trim(subname),' ERROR: mismatch calendar ', & - trim(sdat%model_calendar),':',trim(sdat%stream(ns)%calendar) - call shr_log_error(trim(subname)//' ERROR: mismatch calendar ', rc=rc) + if (sdat%mainproc) then + write(sdat%logunit,'(3a)') subname,' ERROR: mismatch calendar ', & + trim(sdat%model_calendar),':',trim(sdat%stream(ns)%calendar) + end if + call shr_log_error(subname//' ERROR: mismatch calendar ', rc=rc) return endif else ! calendars are the same @@ -1036,8 +1152,9 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) if (.not. sdat%pstrm(ns)%override_annual_cycle) then if(sdat%stream(ns)%dtlimit == -1) then sdat%pstrm(ns)%override_annual_cycle = .true. - if(sdat%mainproc) then - write(logunit,*) trim(subname),' WARNING: Stream ',ns,' is not cycling on annual boundaries, and dtlimit check has been overridden' + if (sdat%mainproc) then + write(sdat%logunit,'(2a,2x,i0,a)') subname,' WARNING: Stream ',& + ns,' is not cycling on annual boundaries, and dtlimit check has been overridden' endif else dtime = abs(real(dday,r8) + real(sdat%pstrm(ns)%todUB-sdat%pstrm(ns)%todLB,r8)/shr_const_cDay) @@ -1047,19 +1164,15 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) if ((sdat%pstrm(ns)%dtmax/sdat%pstrm(ns)%dtmin) > sdat%stream(ns)%dtlimit) then if (sdat%mainproc) then - write(sdat%stream(1)%logunit,'(a,i8)') trim(subname),' ERROR: for stream ',ns - write(sdat%stream(1)%logunit,'(a,i8)') trim(subname),' ERROR: dday = ',dday - write(sdat%stream(1)%logunit,'(a,4(f15.5,2x))') trim(subName),' ERROR: dtime, dtmax, dtmin, dtlimit = ',& + write(sdat%logunit,'(2a,i0)') subname,' ERROR: for stream ',ns + write(sdat%logunit,'(3a)') subname,' ERROR: calendar = ',trim(calendar) + write(sdat%logunit,'(2a,i0)') subname,' ERROR: dday = ',dday + write(sdat%logunit,'(2a,4(es13.6,2x))') subname,' ERROR: dtime, dtmax, dtmin, dtlimit = ',& dtime, sdat%pstrm(ns)%dtmax, sdat%pstrm(ns)%dtmin, sdat%stream(ns)%dtlimit - write(sdat%stream(1)%logunit,'(a,4(i10,2x))') trim(subName),' ERROR: ymdLB, todLB, ymdUB, todUB = ', & + write(sdat%logunit,'(a,4(i0,2x))') subname,' ERROR: ymdLB, todLB, ymdUB, todUB = ', & sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB end if - write(6,*) trim(subname),' ERROR: for stream ',ns, ' and calendar ',trim(calendar) - write(6,*) trim(subName),' ERROR: dtime, dtmax, dtmin, dtlimit = ',& - dtime, sdat%pstrm(ns)%dtmax, sdat%pstrm(ns)%dtmin, sdat%stream(ns)%dtlimit - write(6,*) trim(subName),' ERROR: ymdLB, todLB, ymdUB, todUB = ', & - sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB - call shr_log_error(trim(subName)//' ERROR dt limit for stream, see atm.log output', rc=rc) + call shr_log_error(subname//' ERROR dt limit for stream, see atm.log output', rc=rc) return endif endif @@ -1085,18 +1198,22 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) ! ------------------------------------------ call ESMF_TraceRegionEnter(trim(lstr)//trim(timname)//'_coszen') - allocate(coszen(sdat%model_lsize)) + allocate(coszen(sdat%model_lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of coszen with size '//toString(sdat%model_lsize), rc=rc) + return + end if ! get coszen call ESMF_TraceRegionEnter(trim(lstr)//trim(timname)//'_coszenC') call shr_tInterp_getCosz(coszen, sdat%model_lon, sdat%model_lat, ymdmod(ns), todmod, & sdat%eccen, sdat%mvelpp, sdat%lambm0, sdat%obliqr, sdat%stream(ns)%calendar, & - sdat%mainproc, sdat%stream(1)%logunit) + sdat%mainproc, sdat%logunit) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenC') - if (debug > 0 .and. sdat%mainproc) then + if (debug_level > 0 .and. sdat%mainproc) then do n = 1,size(coszen) - write(sdat%stream(1)%logunit,'(a,i4,2x,2(i18,2x),i8,d20.10)')' stream,ymdmod,todmod,n,coszen= ',& - ns, ymd, tod, n, coszen(n) + write(sdat%logunit,'(2a,4(i0,2x),es13.6)') subname,& + ' stream,ymdmod,todmod,n,coszen= ',ns, ymd, tod, n, coszen(n) end do end if @@ -1105,16 +1222,22 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) ! compute a new avg cosz call ESMF_TraceRegionEnter(trim(lstr)//trim(timname)//'_coszenN') if (.not. allocated(sdat%tavCoszen)) then - allocate(sdat%tavCoszen(sdat%model_lsize)) + allocate(sdat%tavCoszen(sdat%model_lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of sdat%tavCoszen with size '// & + toString(sdat%model_lsize), rc=rc) + return + end if end if call shr_tInterp_getAvgCosz(sdat%tavCoszen, sdat%model_lon, sdat%model_lat, & sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB, & sdat%eccen, sdat%mvelpp, sdat%lambm0, sdat%obliqr, sdat%modeldt, & - sdat%stream(ns)%calendar, sdat%mainproc, sdat%stream(1)%logunit, rc=rc) + sdat%stream(ns)%calendar, sdat%mainproc, sdat%logunit, rc=rc) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenN') - if (debug > 0 .and. sdat%mainproc) then + if (debug_level > 0 .and. sdat%mainproc) then do n = 1,size(coszen) - write(sdat%stream(1)%logunit,'(a,i4,2x,4(i18,2x),i8,d20.10)')' stream,lbymd,lbsec,ubymd,ubsec,newdata,n,tavgCoszen= ',& + write(sdat%logunit,'(2a,i0,2x,4(i0,2x),i0,es13.6)') subname, & + ' stream,lbymd,lbsec,ubymd,ubsec,newdata,n,tavgCoszen= ',& ns, sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB, & n, sdat%tavCoszen(n) end do @@ -1166,12 +1289,13 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) call ESMF_TraceRegionEnter(trim(lstr)//trim(timname)//'_tint') call shr_tInterp_getFactors(sdat%pstrm(ns)%ymdlb, sdat%pstrm(ns)%todlb, & sdat%pstrm(ns)%ymdub, sdat%pstrm(ns)%todub, & - ymdmod(ns), todmod, flb, fub, calendar=sdat%stream(ns)%calendar, logunit=sdat%stream(1)%logunit, & + ymdmod(ns), todmod, flb, fub, calendar=sdat%stream(ns)%calendar, logunit=sdat%logunit, & algo=trim(sdat%stream(ns)%tinterpalgo), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (debug > 0 .and. sdat%mainproc) then - write(sdat%stream(1)%logunit,'(a,i4,2(f10.5,2x))') & - trim(subname)//' non-cosz-interp stream, flb, fub= ',ns,flb,fub + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0,2(2x,f10.5))') & + subname,' non-cosz-interp stream, flb, fub= ',ns,flb,fub + write(sdat%logunit,'(a)') '------------------------------------------------------' endif do nf = 1,size(sdat%pstrm(ns)%fldlist_model) if (sdat%pstrm(ns)%stream_nlev > 1) then @@ -1270,40 +1394,33 @@ subroutine shr_strdata_print(sdat, name) ! local variables integer :: ns - character(*),parameter :: subName = "(shr_strdata_print) " - character(*),parameter :: F00 = "('(shr_strdata_print) ',8a)" - character(*),parameter :: F01 = "('(shr_strdata_print) ',a,i6,a)" - character(*),parameter :: F02 = "('(shr_strdata_print) ',a,es13.6)" - character(*),parameter :: F03 = "('(shr_strdata_print) ',a,i2,a,a)" - character(*),parameter :: F04 = "('(shr_strdata_print) ',a)" - character(*),parameter :: F05 = "('(shr_strdata_print) ',a,i2,a,es13.6)" - character(*),parameter :: F06 = "('(shr_strdata_print) ',a,i2,a,i1)" - character(*),parameter :: F90 = "('(shr_strdata_print) ',58('-'))" + character(len=*),parameter :: subName = "(shr_strdata_print) " !------------------------------------------------------------------------------- - write(sdat%stream(1)%logunit,*) - write(sdat%stream(1)%logunit,F90) - write(sdat%stream(1)%logunit,F00) "name = ",trim(name) - write(sdat%stream(1)%logunit,F00) "calendar = ",trim(sdat%model_calendar) - write(sdat%stream(1)%logunit,F02) "eccen = ",sdat%eccen - write(sdat%stream(1)%logunit,F02) "mvelpp = ",sdat%mvelpp - write(sdat%stream(1)%logunit,F02) "lambm0 = ",sdat%lambm0 - write(sdat%stream(1)%logunit,F02) "obliqr = ",sdat%obliqr - write(sdat%stream(1)%logunit,F01) "pio_iotype = ",sdat%io_type - write(sdat%stream(1)%logunit,F01) "nstreams = ",shr_strdata_get_stream_count(sdat) - write(sdat%stream(1)%logunit,F04) "Per stream information " + write(sdat%logunit,*) + write(sdat%logunit,'(a)') '------------------------------------------------------' + write(sdat%logunit,'(3a)') subname," name = ",trim(name) + write(sdat%logunit,'(3a)') subname," calendar = ",trim(sdat%model_calendar) + write(sdat%logunit,'(2a,2x,es13.6)') subname," eccen = ",sdat%eccen + write(sdat%logunit,'(2a,2x,es13.6)') subname," mvelpp = ",sdat%mvelpp + write(sdat%logunit,'(2a,2x,es13.6)') subname," lambm0 = ",sdat%lambm0 + write(sdat%logunit,'(2a,2x,es13.6)') subname," obliqr = ",sdat%obliqr + write(sdat%logunit,'(2a,i0)') subname," pio_iotype = ",sdat%io_type + write(sdat%logunit,'(2a,2x,i0)') subname," nstreams = ",shr_strdata_get_stream_count(sdat) + write(sdat%logunit,'(2a)') subname," Per stream information " do ns = 1, shr_strdata_get_stream_count(sdat) - write(sdat%stream(1)%logunit,F03) " taxMode (",ns,") = ",trim(sdat%stream(ns)%taxmode) - write(sdat%stream(1)%logunit,F05) " dtlimit (",ns,") = ",sdat%stream(ns)%dtlimit - write(sdat%stream(1)%logunit,F03) " mapalgo (",ns,") = ",trim(sdat%stream(ns)%mapalgo) - write(sdat%stream(1)%logunit,F03) " tintalgo(",ns,") = ",trim(sdat%stream(ns)%tinterpalgo) - write(sdat%stream(1)%logunit,F03) " readmode(",ns,") = ",trim(sdat%stream(ns)%readmode) - write(sdat%stream(1)%logunit,F03) " vectors (",ns,") = ",trim(sdat%stream(ns)%stream_vectors) - write(sdat%stream(1)%logunit,F06) " src_mask(",ns,") = ",sdat%stream(ns)%src_mask_val - write(sdat%stream(1)%logunit,F06) " dst_mask(",ns,") = ",sdat%stream(ns)%dst_mask_val - write(sdat%stream(1)%logunit,F01) " " + write(sdat%logunit,'(2a,i0,2a)') subname," taxMode (",ns,") = ",trim(sdat%stream(ns)%taxmode) + write(sdat%logunit,'(2a,i0,a,es13.6)') subname," dtlimit (",ns,") = ",sdat%stream(ns)%dtlimit + write(sdat%logunit,'(2a,i0,2a)') subname," tintalgo(",ns,") = ",trim(sdat%stream(ns)%tinterpalgo) + write(sdat%logunit,'(2a,i0,2a)') subname," mapalgo (",ns,") = ",trim(sdat%stream(ns)%mapalgo) + write(sdat%logunit,'(2a,i0,2a)') subname," readmode(",ns,") = ",trim(sdat%stream(ns)%readmode) + write(sdat%logunit,'(2a,i0,2a)') subname," vectors (",ns,") = ",trim(sdat%stream(ns)%stream_vectors) + write(sdat%logunit,'(2a,i0,a,i0)') subname," src_mask(",ns,") = ",sdat%stream(ns)%src_mask_val + write(sdat%logunit,'(2a,i0,a,i0)') subname," dst_mask(",ns,") = ",sdat%stream(ns)%dst_mask_val + write(sdat%logunit,'(2a)') subname," " end do - write(sdat%stream(1)%logunit,F90) + write(sdat%logunit,'(a)') '------------------------------------------------------' + write(sdat%logunit,*) end subroutine shr_strdata_print @@ -1326,7 +1443,6 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) ! local variables type(shr_stream_streamType), pointer :: stream type(ESMF_Mesh) , pointer :: stream_mesh - type(ESMF_VM) :: vm logical :: fileexists integer :: oDateLB,oSecLB,dDateLB integer :: oDateUB,oSecUB,dDateUB @@ -1338,9 +1454,7 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) character(CX) :: filename_next character(CX) :: filename_prev logical :: find_bounds - character(*), parameter :: subname = '(shr_strdata_readLBUB) ' - character(*), parameter :: F00 = "('(shr_strdata_readLBUB) ',8a)" - character(*), parameter :: F01 = "('(shr_strdata_readLBUB) ',a,5i8)" + character(len=*), parameter :: subname = '(shr_strdata_readLBUB) ' !------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1349,8 +1463,6 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) call ESMF_TraceRegionEnter(trim(istr)//'_setup') ! allocate streamdat instance on all tasks - call ESMF_VMGetCurrent(vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return newData = .false. n_lb = -1 @@ -1373,39 +1485,52 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) ! if model current date is outside of model lower or upper bound - find the stream bounds find_bounds = (rDateM < rDateLB .or. rDateM >= rDateUB) - if (debug > 0 .and. sdat%mainproc) then - write(sdat%stream(1)%logunit,'(a,i4,2x,6(i18,2x),l7)')' stream,lbymd,lbsec,mdate,msec,ubymd,ubsec,newdata= ',ns,& - sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB, & - mdate,msec, & - sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB,find_bounds - write(sdat%stream(1)%logunit,'(a,i4,2x,3(f20.3,2x),l7)')' stream,rdateLB,rdateM,rdateUB,newdata= ',& - ns,rdateLB,rdateM,rdateUB,find_bounds - end if if (find_bounds) then call ESMF_TraceRegionEnter(trim(istr)//'_fbound') - call shr_stream_findBounds(stream, mDate, mSec, sdat%mainproc, & + call shr_stream_findBounds(stream, mDate, mSec, & sdat%pstrm(ns)%ymdLB, dDateLB, sdat%pstrm(ns)%todLB, n_lb, filename_lb, & sdat%pstrm(ns)%ymdUB, dDateUB, sdat%pstrm(ns)%todUB, n_ub, filename_ub) call ESMF_TraceRegionExit(trim(istr)//'_fbound') - if (debug > 0 .and. sdat%mainproc) then - write(sdat%stream(1)%logunit,'(a,i4,2x,6(i18,2x),l7)')' stream,lbymd,lbsec,mdate,msec,ubymd,ubsec,newdata= ',ns,& - sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB,& - mdate,msec, & - sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB - write(sdat%stream(1)%logunit,'(a,i4,2x,3(f20.3,2x),l7)')' stream,rdateLB,rdateM,rdateUB,newdata= ',& - ns,rdateLB,rdateM,rdateUB,find_bounds - end if - endif + end if ! determine if need to read in new stream data newdata = (sdat%pstrm(ns)%ymdLB /= oDateLB .or. sdat%pstrm(ns)%todLB /= oSecLB) + + ! write time bounds info + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0,a,l7,a,l7)') subname, & + 'Stream: ',ns,& + ' find_bounds = ',find_bounds,' newdata is = ',newdata + write(sdat%logunit,'(2a,i0,a,4(2x,i0))') subname, & + 'Stream: ',ns,& + ' oDateLB, OSecLb, oDateUB, OsecUB = ',& + oDateLB, OSecLb, oDateUB, OsecUB + write(sdat%logunit,'(2a,i0,a,2x,3(f13.6,2x))') subname, & + 'Stream: ',ns,& + ' rdateLB,rdateM,rdateUB = ',& + rdateLB, rdateM, rdateUB + write(sdat%logunit,'(2a,i0,a,6(i0,2x))') subname, & + 'Stream: ',ns,& + ' lbymd,lbsec,mdate,msec,ubymd,ubsec = ',& + sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, & + mdate, msec, & + sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB + end if + + ! if newdata, determine if do a copy or read in new lower bound data if (newdata) then if (sdat%pstrm(ns)%ymdLB == oDateUB .and. sdat%pstrm(ns)%todLB == oSecUB) then + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0,a)') subname,' Stream: ',ns,' Copying upper bound bound of data to lower bound' + end if ! copy fldbun_stream_ub to fldbun_stream_lb i = sdat%pstrm(ns)%stream_ub sdat%pstrm(ns)%stream_ub = sdat%pstrm(ns)%stream_lb sdat%pstrm(ns)%stream_lb = i else + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0,a)') subname,' Stream: ',ns,' Reading in new lower bound of data' + end if ! read lower bound of data call shr_strdata_readstrm(sdat, sdat%pstrm(ns), stream, & sdat%pstrm(ns)%fldbun_data(sdat%pstrm(ns)%stream_lb), & @@ -1420,6 +1545,9 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) sdat%pstrm(ns)%fldbun_data(sdat%pstrm(ns)%stream_ub), & filename_ub, n_ub, istr=trim(istr)//'_UB', boundstr='ub', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0,a)') subname,' Stream: ',ns,' Reading in new upper bound of data' + end if endif ! determine previous & next data files in list of files @@ -1495,10 +1623,9 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & character(CS) :: uname, vname integer :: i, lev logical :: checkflag = .false. - character(*), parameter :: subname = '(shr_strdata_readstrm) ' - character(*), parameter :: F00 = "('(shr_strdata_readstrm) ',8a)" - character(*), parameter :: F02 = "('(shr_strdata_readstrm) ',2a,i8)" character(CL) :: errmsg + integer :: istat + character(len=*), parameter :: subname = '(shr_strdata_readstrm) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1530,10 +1657,14 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & else ! otherwise close the old file if open and open new file if (fileopen) then - if (sdat%mainproc) write(sdat%stream(1)%logunit,F00) 'close : ',trim(currfile) + if (sdat%mainproc) then + write(sdat%logunit,'(3a)') subname,' closing : ',trim(currfile) + end if call pio_closefile(pioid) endif - if (sdat%mainproc) write(sdat%stream(1)%logunit,F00) 'opening : ',trim(filename) + if (sdat%mainproc) then + write(sdat%logunit,'(3a)') subname,' opening : ',trim(filename) + end if rcode = pio_openfile(sdat%pio_subsystem, pioid, sdat%io_type, trim(filename), pio_nowrite) call shr_stream_setCurrFile(stream, fileopen=.true., currfile=trim(filename), currpioid=pioid) endif @@ -1546,7 +1677,9 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (ESMF_MeshIsCreated(per_stream%stream_mesh)) then if (.not. per_stream%stream_pio_iodesc_set) then - if (sdat%mainproc) write(sdat%stream(1)%logunit,F00) 'setting pio descriptor : ',trim(filename) + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a)') subname,' setting pio descriptor : ' + end if call shr_strdata_set_stream_iodesc(sdat, per_stream, trim(per_stream%fldlist_stream(1)), & pioid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1577,7 +1710,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & call ESMF_TraceRegionEnter(trim(istr)//'_readpio') if (sdat%mainproc) then - write(sdat%stream(1)%logunit,F02) 'reading file ' // trim(boundstr) //': ',trim(filename), nt + write(sdat%logunit,'(5a)') subname,' reading file ',trim(boundstr),': ',trim(filename) endif if (ESMF_FieldIsCreated(per_stream%field_stream_vector)) then @@ -1597,20 +1730,50 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (stream_nlev > 1) then lsize = size(dataptr2d, dim=2) if (pio_iovartype == PIO_REAL .and. .not. allocated(data_real2d)) then - allocate(data_real2d(lsize, stream_nlev)) + allocate(data_real2d(lsize, stream_nlev), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_real2d with size '// & + toString(lsize*stream_nlev), rc=rc) + return + end if else if (pio_iovartype == PIO_DOUBLE .and. .not. allocated(data_dbl2d)) then - allocate(data_dbl2d(lsize, stream_nlev)) + allocate(data_dbl2d(lsize, stream_nlev), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_dbl2d with size '// & + toString(lsize*stream_nlev), rc=rc) + return + end if else if(pio_iovartype == PIO_SHORT .and. .not. allocated(data_short2d)) then - allocate(data_short2d(lsize, stream_nlev)) + allocate(data_short2d(lsize, stream_nlev), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_short2d with size '// & + toString(lsize*stream_nlev), rc=rc) + return + end if endif else lsize = size(dataptr1d) if (pio_iovartype == PIO_REAL .and. .not. allocated(data_real1d)) then - allocate(data_real1d(lsize)) + allocate(data_real1d(lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_real1d with size '// & + toString(lsize), rc=rc) + return + end if else if (pio_iovartype == PIO_DOUBLE .and. .not. allocated(data_dbl1d)) then - allocate(data_dbl1d(lsize)) + allocate(data_dbl1d(lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_dbl1d with size '// & + toString(lsize), rc=rc) + return + end if else if(pio_iovartype == PIO_SHORT .and. .not. allocated(data_short1d)) then - allocate(data_short1d(lsize)) + allocate(data_short1d(lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of data_short1d with size '// & + toString(lsize), rc=rc) + return + end if endif end if @@ -1639,9 +1802,10 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if(rcode == PIO_NOERR) handlefill=.true. call PIO_seterrorhandling(pioid, old_error_handle) - if (debug>0 .and. sdat%mainproc) then - write(sdat%stream(1)%logunit,F02)' reading '//& - trim(per_stream%fldlist_stream(nf))//' into '//trim(per_stream%fldlist_model(nf)),& + if (debug_level>0 .and. sdat%mainproc) then + write(sdat%logunit,'(a,4x,5a,i0)') subname,& + ' reading ',trim(per_stream%fldlist_stream(nf)), & + ' into ',trim(per_stream%fldlist_model(nf)), & ' at time index: ',nt end if @@ -1665,8 +1829,11 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (handlefill) then ! Single point streams are not allowed to have missing values if (stream%mapalgo == 'none' .and. any(data_real2d == fillvalue_r4)) then - write(errmsg,*) ' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - if(sdat%mainproc) write(sdat%stream(1)%logunit,*) trim(errmsg) + write(errmsg,'(2a)')' ERROR: _Fillvalue found in stream input variable: ',& + trim(per_stream%fldlist_stream(nf)) + if (sdat%mainproc) then + write(sdat%logunit,'(2a)') subname,trim(errmsg) + end if call shr_log_error(errmsg, rc=rc) return endif @@ -1700,8 +1867,10 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (handlefill) then ! Single point streams are not allowed to have missing values if (stream%mapalgo == 'none' .and. any(data_real1d == fillvalue_r4)) then - write(errmsg,*) ' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - if(sdat%mainproc) write(sdat%stream(1)%logunit,*) trim(errmsg) + write (errmsg,'(2a)')' ERROR: _Fillvalue found in stream input variable: ',trim(per_stream%fldlist_stream(nf)) + if (sdat%mainproc) then + write(sdat%logunit,'(2a)') subname,trim(errmsg) + end if call shr_log_error(errmsg, rc=rc) return endif @@ -1771,7 +1940,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & ! Single point streams are not allowed to have missing values if (stream%mapalgo == 'none' .and. any(data_dbl1d == fillvalue_r8)) then write(errmsg,*) ' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - call shr_log_error(errmsg, rc=rc) + call shr_log_error(subname//trim(errmsg), rc=rc) return endif do n = 1,size(dataptr1d) @@ -1880,12 +2049,23 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & ! get lon and lat of stream u and v fields lsize = size(dataptr1d) - allocate(dataptr(lsize)) + allocate(dataptr(lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of dataptr with size '// & + toString(lsize), rc=rc) + return + end if call ESMF_MeshGet(per_stream%stream_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(nu_coords(spatialDim*numOwnedElements)) + allocate(nu_coords(spatialDim*numOwnedElements), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of nu_coords with size '// & + toString(spatialDim*numOwnedElements), rc=rc) + return + end if + call ESMF_MeshGet(per_stream%stream_mesh, ownedElemCoords=nu_coords) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1978,11 +2158,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) integer, pointer :: compdof(:) integer, pointer :: compdof3d(:) integer :: rCode ! pio return code (only used when pio error handling is PIO_BCAST_ERROR) - character(*), parameter :: subname = '(shr_strdata_set_stream_iodesc) ' - character(*), parameter :: F00 = "('(shr_strdata_set_stream_iodesc) ',a,i8,2x,i8,2x,a)" - character(*), parameter :: F01 = "('(shr_strdata_set_stream_iodesc) ',a,i8,2x,i8,2x,a)" - character(*), parameter :: F02 = "('(shr_strdata_set_stream_iodesc) ',a,i8,2x,i8,2x,i8,2x,a)" - character(*), parameter :: F03 = "('(shr_strdata_set_stream_iodesc) ',a,i8,2x,a)" + integer :: istat + character(len=*), parameter :: subname = '(shr_strdata_set_stream_iodesc) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1999,8 +2176,17 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_varndims(pioid, varid, ndims) ! allocate memory for dimids and dimlens - allocate(dimids(ndims)) - allocate(dimlens(ndims)) + allocate(dimids(ndims), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of dimids with size '//toString(ndims), rc=rc) + return + end if + + allocate(dimlens(ndims), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of dimlens with size '//toString(ndims), rc=rc) + return + end if rcode = pio_inq_vardimid(pioid, varid, dimids(1:ndims)) do n = 1, ndims rcode = pio_inq_dimlen(pioid, dimids(n), dimlens(n)) @@ -2011,13 +2197,51 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_DistGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(compdof(lsize)) + allocate(compdof(lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of compdof '//toString(lsize), rc=rc) + return + end if call ESMF_DistGridGet(distGrid, localDe=0, seqIndexList=compdof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (stream_nlev > 1) then - allocate(compdof3d(stream_nlev*lsize)) + allocate(compdof3d(stream_nlev*lsize), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//'allocation error of compdof3d '// & + toString(stream_nlev*lsize), rc=rc) + return + end if ! Assume that first 2 dimensions correspond to the compdof - gsize2d = dimlens(1)*dimlens(2) + rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) + if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then + if (ndims == 3) then + ! second dimension is lev and third dimension is time + ! this would then corresond to an unstructured grid with just ncol + gsize2d = dimlens(1) + else if (ndims == 4) then + ! third dimension is lev and fourth dimension is time + ! first two dimensions are lon,lat + gsize2d = dimlens(1)*dimlens(2) + else + call shr_log_error(subname//' only ndims of 3 and 4 '//& + ' total dimensions are currently supported for multiple level fields '// & + ' with a time dimension', rc=rc) + return + end if + else + if (ndims == 2) then + ! second dimension is lev + gsize2d = dimlens(1) + else if (ndims == 3) then + ! third dimension is lev + gsize2d = dimlens(1)*dimlens(2) + else + call shr_log_error(subname//' only ndims of 2 and 3 '// & + ' total dimensions are currently supported for multiple level fields '// & + ' without a time dimension', rc=rc) + return + end if + end if cnt = 0 do n = 1,stream_nlev do m = 1,size(compdof) @@ -2031,62 +2255,96 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_vartype(pioid, varid, pio_iovartype) ! determine io descriptor + !------------------------------- if (ndims == 2) then + !------------------------------- rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) - if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then + if ((trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then if (sdat%mainproc) then - write(sdat%stream(1)%logunit,F03) 'setting iodesc for : '//trim(fldname)// & - ' with dimlens(1) = ',dimlens(1),' and the variable has a time dimension ' + write(sdat%logunit,'(4a,i0,a)') subname,' setting iodesc for 2d: ',trim(fldname), & + ' with dimlens(1) = ',dimlens(1),' and dimlens(2) is a time dimension ' end if call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1)/), compdof, & per_stream%stream_pio_iodesc) + else if (stream_nlev > 1) then + if (sdat%mainproc) then + write(sdat%logunit,'(4a,i0,2x,i0,a)') subname,' setting iodesc for 2d: ',trim(fldname), & + ' with dimlens(1),dimlens(2) = ',dimlens(1),dimlens(2), & + ' and dimlens(2) is a vertical dimension' + end if + call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1)/), compdof3d, & + per_stream%stream_pio_iodesc) else if (sdat%mainproc) then - write(sdat%stream(1)%logunit,F00) 'setting iodesc for : '//trim(fldname)// & - ' with dimlens(1), dimlens(2) = ',dimlens(1),dimlens(2),& - ' variable has no time dimension ' + write(sdat%logunit,'(4a,i0,2x,i0,a)') subname,' setting iodesc for 2d: ',trim(fldname), & + ' with dimlens(1),dimlens(2) = ',dimlens(1),dimlens(2),& + ' and the variable has no time or vertical dimension ' end if call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof, & per_stream%stream_pio_iodesc) end if + !------------------------------- else if (ndims == 3) then + !------------------------------- rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) - if (stream_nlev > 1) then - write(sdat%stream(1)%logunit,F01) 'setting iodesc for : '//trim(fldname)// & - ' with dimlens(1), dimlens(2), dimlens(3) = ',dimlens(1),dimlens(2), dimlens(3), & - ' variable has no time dimension '//trim(dimname) - call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2),dimlens(3)/), compdof3d, & - per_stream%stream_pio_iodesc) - else if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then - if (sdat%mainproc) then - write(sdat%stream(1)%logunit,F01) 'setting iodesc for : '//trim(fldname)// & - ' with dimlens(1), dimlens(2) = ',dimlens(1),dimlens(2),& - ' variable as time dimension '//trim(dimname) + if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then + if (stream_nlev > 1) then + if (sdat%mainproc) then + write(sdat%logunit,'(4a,i0,2x,i0,a)') subname, & + 'setting iodesc for 3d: ',trim(fldname),' with dimlens(1),dimlens(2) = ', & + dimlens(1),dimlens(2), & + ' where dimlen(2) is a vertical dimension and dimlen(3) is time dimension ' + end if + call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof3d, & + per_stream%stream_pio_iodesc) + else + if (sdat%mainproc) then + write(sdat%logunit,'(4a,i0,2x,i0,a)') subname,& + ' setting iodesc for 3d: ',trim(fldname),' with dimlens(1),dimlens(2) = ', & + dimlens(1),dimlens(2), & + ' and dimlen(3) is a time dimension ' + end if + call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof, & + per_stream%stream_pio_iodesc) + end if + else + if (stream_nlev > 1) then + if (sdat%mainproc) then + write(sdat%logunit,'(4a,3(i0,2x),a)') subname, & + ' setting iodesc for 3d: ',trim(fldname),' with dimlens(1), dimlens(2), dimlens(3) = ',& + dimlens(1),dimlens(2), dimlens(3), & + ' where dimlens(3) is a vertical dimension' + end if + call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2),dimlens(3)/), compdof3d, & + per_stream%stream_pio_iodesc) + else + call shr_log_error(subname//& + ' the third dimension of a 3d field must be either time or a vertical level', rc=rc) + return end if - call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof, & - per_stream%stream_pio_iodesc) end if + !------------------------------- else if (ndims == 4) then + !------------------------------- rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if (stream_nlev > 1 .and. (trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then if (sdat%mainproc) then - write(sdat%stream(1)%logunit,F02) 'setting iodesc for : '//trim(fldname)// & - ' with dimlens(1), dimlens(2),dimlens(3) = ',dimlens(1),dimlens(2),dimlens(3),& - ' variable has time dimension ' + write(sdat%logunit,'(4a,3(i0,2x),a)') subname, & + ' setting iodesc for 4d: ',trim(fldname),' with dimlens(1), dimlens(2),dimlens(3) = ',& + dimlens(1),dimlens(2),dimlens(3), & + ' where dimlens(3) is a vertical dimension and dimlens(4) is a time dimension ' end if call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2),dimlens(3)/), compdof3d, & per_stream%stream_pio_iodesc) else - write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' dimlens = 4 assumes a time dimension', rc=rc) + call shr_log_error(subname//' dimlens = 4 assumes a time dimension and a vertical dimension', rc=rc) return end if else - write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' only ndims of 2 and 3 and 4 are currently supported', rc=rc) + call shr_log_error(subname//' only ndims of 2 and 3 and 4 are currently supported', rc=rc) return end if @@ -2099,83 +2357,137 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) end subroutine shr_strdata_set_stream_iodesc !=============================================================================== - subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, rc) + subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, & + rc, requirePointer, errmsg) + + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) ! Set a pointer, strm_ptr, for field, strm_fld, into sdat fldbun_model field bundle ! input/output variables - type(shr_strdata_type) , intent(in) :: sdat - character(len=*) , intent(in) :: strm_fld - real(r8) , pointer :: strm_ptr(:) - integer , intent(out) :: rc + type(shr_strdata_type) , intent(in) :: sdat + character(len=*) , intent(in) :: strm_fld + real(r8) , pointer :: strm_ptr(:) + integer , intent(out) :: rc + logical, optional , intent(in) :: requirePointer + character(len=*), optional , intent(in) :: errmsg ! local variables - integer :: ns, nf + integer :: ns, nf, ni logical :: found - character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d)' - character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_1d) ',8a)" + character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d) ' ! ---------------------------------------------- rc = ESMF_SUCCESS + found = .false. + ! loop over all input streams and determine if the strm_fld is in the field bundle of the target stream - do ns = 1, shr_strdata_get_stream_count(sdat) - found = .false. - ! Check if requested stream field is read in - and if it is then point into the stream field bundle - do nf = 1,size(sdat%pstrm(ns)%fldlist_model) + stream_loop: do ns = 1, shr_strdata_get_stream_count(sdat) + ! Check if requested stream field is read in - and if it is, set pointer + fld_loop: do nf = 1,size(sdat%pstrm(ns)%fldlist_model) if (trim(strm_fld) == trim(sdat%pstrm(ns)%fldlist_model(nf))) then call dshr_fldbun_getfldptr(sdat%pstrm(ns)%fldbun_model, trim(sdat%pstrm(ns)%fldlist_model(nf)), & fldptr1=strm_ptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (sdat%mainproc) then - write(sdat%stream(1)%logunit,F00)' strm_ptr is allocated for stream field strm_'//trim(strm_fld) - end if found = .true. - exit + exit stream_loop end if + end do fld_loop + end do stream_loop + + if (found) then + ! If pointer found, preset value + if (sdat%mainproc) then + write(sdat%logunit,'(3a)') subname, & + ' strm_ptr is allocated and preset to nan for stream field strm_',trim(strm_fld) + end if + do ni = 1,size(strm_ptr) + strm_ptr(ni) = nan end do - if (found) exit - end do + else + ! What to do if fldbun pointer is not found + if (present(requirePointer)) then + if (requirePointer) then + if (present(errmsg)) then + if (sdat%mainproc) then + write(sdat%logunit,'(2a)') subname, trim(errmsg) + end if + end if + call shr_log_error(subName//"ERROR: pointer not found for "//trim(strm_fld), rc=rc) + return + end if + end if + end if + end subroutine shr_strdata_get_stream_pointer_1d !=============================================================================== - subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, rc) + subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & + rc, requirePointer, errmsg) + + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) ! Set a pointer, strm_ptr, for field, strm_fld, into sdat fldbun_model field bundle ! input/output variables - type(shr_strdata_type) , intent(in) :: sdat - character(len=*) , intent(in) :: strm_fld - real(r8) , pointer :: strm_ptr(:,:) - integer , intent(out) :: rc + type(shr_strdata_type) , intent(in) :: sdat + character(len=*) , intent(in) :: strm_fld + real(r8) , pointer :: strm_ptr(:,:) + integer , intent(out) :: rc + logical, optional , intent(in) :: requirePointer + character(len=*), optional , intent(in) :: errmsg ! local variables - integer :: ns, nf + integer :: ns, nf, ni, nj logical :: found - character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d)' - character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_2d) ',8a)" + character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d) ' ! ---------------------------------------------- rc = ESMF_SUCCESS + found = .false. + ! loop over all input streams and determine if the strm_fld is in the field bundle of the target stream - do ns = 1, shr_strdata_get_stream_count(sdat) - found = .false. - ! Check if requested stream field is read in - and if it is then point into the stream field bundle - do nf = 1,size(sdat%pstrm(ns)%fldlist_model) + stream_loop: do ns = 1, shr_strdata_get_stream_count(sdat) + ! Check if requested stream field is read in - and if it is, set pointer + fld_loop: do nf = 1,size(sdat%pstrm(ns)%fldlist_model) if (trim(strm_fld) == trim(sdat%pstrm(ns)%fldlist_model(nf))) then call dshr_fldbun_getfldptr(sdat%pstrm(ns)%fldbun_model, trim(sdat%pstrm(ns)%fldlist_model(nf)), & fldptr2=strm_ptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (sdat%mainproc) then - write(sdat%stream(1)%logunit,F00)' strm_ptr is allocated for stream field strm_'//trim(strm_fld) - end if found = .true. - exit + exit stream_loop end if + end do fld_loop + end do stream_loop + + if (found) then + ! If pointer found, preset value + if (sdat%mainproc) then + write(sdat%logunit,'(3a)') subname, & + ' strm_ptr is allocated and preset to nan for stream field strm_',trim(strm_fld) + end if + do nj = 1,size(strm_ptr, dim=2) + do ni = 1,size(strm_ptr, dim=1) + strm_ptr(ni,nj) = nan + end do end do - if (found) exit - end do + else + ! What to do if fldbun pointer is not found + if (present(requirePointer)) then + if (requirePointer) then + if (present(errmsg)) then + if (sdat%mainproc) then + write(sdat%logunit,'(2a)') subname,trim(errmsg) + end if + end if + call shr_log_error(subName//"ERROR: pointer not found for "//trim(strm_fld), rc=rc) + return + end if + end if + end if + end subroutine shr_strdata_get_stream_pointer_2d end module dshr_strdata_mod diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index 0b5026169..ba81d4f61 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -35,6 +35,8 @@ module dshr_stream_mod use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat #endif use shr_sys_mod , only : shr_sys_abort + use shr_strconvert_mod, only : toString + implicit none private ! default private @@ -101,9 +103,10 @@ module dshr_stream_mod type shr_stream_streamType !private ! no public access to internal components type(iosystem_desc_t), pointer :: pio_subsystem + logical :: mainproc + integer :: logunit integer :: pio_iotype integer :: pio_ioformat - integer :: logunit ! stdout log unit logical :: init = .false. ! has stream been initialized integer :: nFiles = 0 ! number of data files integer :: yearFirst = -1 ! first year to use in t-axis (yyyymmdd) @@ -136,9 +139,11 @@ module dshr_stream_mod end type shr_stream_streamType !----- parameters ----- - integer :: debug = 0 ! edit/turn-on for debug write statements + integer :: debug_level = 0 ! edit/turn-on for debug write statements real(R8) , parameter :: spd = shr_const_cday ! seconds per day - character(*) , parameter :: u_FILE_u = & + integer , parameter :: main_task = 0 + + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -148,9 +153,10 @@ module dshr_stream_mod #ifndef DISABLE_FoX subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logunit, & pio_subsystem, io_type, io_format, compname, rc) + use FoX_DOM, only : extractDataContent, destroy, Node, NodeList, parseFile, getElementsByTagname use FoX_DOM, only : getLength, item - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadCast, ESMF_SUCCESS + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadCast, ESMF_SUCCESS ! --------------------------------------------------------------------- ! The xml format of a stream txt file will look like the following @@ -199,14 +205,14 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu integer :: status integer :: tmp(6) real(r8) :: rtmp(1) - character(*),parameter :: subName = '(shr_stream_init_from_xml) ' + character(len=*),parameter :: subName = '(shr_stream_init_from_xml) ' ! -------------------------------------------------------- rc = ESMF_SUCCESS nstrms = 0 - if (isroot_task) then + if_isroot_task: if (isroot_task) then Sdoc => parseFile(streamfilename, iostat=status) if (status /= 0) then @@ -216,7 +222,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamlist => getElementsByTagname(Sdoc, "stream_info") nstrms = getLength(streamlist) - ! allocate an array of shr_streamtype objects on just isroot_task + ! allocate an array of shr_streamtype objects on just mainproc allocate(streamdat(nstrms)) ! fill in non-default values for the streamdat attributes @@ -270,23 +276,21 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if(associated(p)) then call extractDataContent(p, streamdat(i)%yearFirst) else - call shr_log_error("yearFirst must be provided", rc=rc) - return + call shr_sys_abort(subname//" yearFirst must be provided") endif p=> item(getElementsByTagname(streamnode, "year_last"), 0) if(associated(p)) then call extractDataContent(p, streamdat(i)%yearLast) else - call shr_log_error("yearLast must be provided", rc=rc) - return + call shr_sys_abort(subname//" yearLast must be provided") endif p=> item(getElementsByTagname(streamnode, "year_align"), 0) if(associated(p)) then call extractDataContent(p, streamdat(i)%yearAlign) else - call shr_log_error("yearAlign must be provided", rc=rc) + call shr_sys_abort(subname//" yearAlign must be provided") return endif @@ -304,16 +308,14 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%meshfile) else - call shr_log_error("mesh file name must be provided", rc=rc) - return + call shr_sys_abort(subname//" mesh file name must be provided") endif p => item(getElementsByTagname(streamnode, "vectors"), 0) if (associated(p)) then call extractDataContent(p, streamdat(i)%stream_vectors) else - call shr_log_error("stream vectors must be provided", rc=rc) - return + call shr_sys_abort(subname//" stream vectors must be provided") endif ! Determine name of vertical dimension @@ -321,19 +323,17 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%lev_dimname) else - call shr_log_error("stream vertical level dimension name must be provided", rc=rc) - return + call shr_sys_abort(subname//" stream vertical level dimension name must be provided") endif ! Determine input data files p => item(getElementsByTagname(streamnode, "datafiles"), 0) if (.not. associated(p)) then - call shr_log_error("stream data files must be provided", rc=rc) - return + call shr_sys_abort(subname//" stream data files must be provided") endif filelist => getElementsByTagname(p,"file") streamdat(i)%nfiles = getLength(filelist) - allocate(streamdat(i)%file( streamdat(i)%nfiles)) + allocate(streamdat(i)%file(streamdat(i)%nfiles)) do n=1, streamdat(i)%nfiles p => item(filelist, n-1) call extractDataContent(p, streamdat(i)%file(n)%name) @@ -353,10 +353,10 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu enddo #ifndef CPRPGI -! PGI compiler has an issue with this call (empty procedure) + ! PGI compiler has an issue with this call (empty procedure) call destroy(Sdoc) #endif - endif + endif if_isroot_task ! allocate streamdat instance on all tasks call ESMF_VMGetCurrent(vm, rc=rc) @@ -365,30 +365,42 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nstrms = tmp(1) + if (.not. isroot_task) then allocate(streamdat(nstrms)) endif + ! Set the logunit and mainproc attributes for each stream + do i = 1,nstrms + streamdat(i)%mainproc = isroot_task + streamdat(i)%logunit = logunit + end do + ! broadcast the contents of streamdat from the main task to all tasks - do i=1,nstrms + loop_over_streams: do i=1,nstrms + tmp(1) = streamdat(i)%nfiles tmp(2) = streamdat(i)%nvars tmp(3) = streamdat(i)%yearFirst tmp(4) = streamdat(i)%yearLast tmp(5) = streamdat(i)%yearAlign tmp(6) = streamdat(i)%offset + call ESMF_VMBroadCast(vm, tmp, 6, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + streamdat(i)%nfiles = tmp(1) streamdat(i)%nvars = tmp(2) streamdat(i)%yearFirst = tmp(3) streamdat(i)%yearLast = tmp(4) streamdat(i)%yearAlign = tmp(5) streamdat(i)%offset = tmp(6) - if(.not. isroot_task) then + + if (.not. streamdat(i)%mainproc) then allocate(streamdat(i)%file(streamdat(i)%nfiles)) allocate(streamdat(i)%varlist(streamdat(i)%nvars)) endif + do n=1,streamdat(i)%nfiles call ESMF_VMBroadCast(vm, streamdat(i)%file(n)%name, CX, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -410,7 +422,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu call ESMF_VMBroadCast(vm, streamdat(i)%tinterpAlgo, CS, 0, rc=rc) 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -423,29 +434,33 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%pio_subsystem => shr_pio_getiosys(trim(compname)) streamdat(i)%pio_iotype = shr_pio_getiotype(trim(compname)) streamdat(i)%pio_ioformat = shr_pio_getioformat(trim(compname)) + ! This is to avoid an unused dummy argument warning - if(.false.) then - if(associated(pio_subsystem)) print *, io_type, io_format + if (.false.) then + if (associated(pio_subsystem)) print *, io_type, io_format endif #else streamdat(i)%pio_subsystem => pio_subsystem streamdat(i)%pio_iotype = io_type streamdat(i)%pio_ioformat = io_format #endif - ! Set logunit - streamdat(i)%logunit = logunit - + if (streamdat(i)%mainproc) then + write(streamdat(i)%logunit,'(2a,i0)') subname,' getting calendar for stream ',i + end if call shr_stream_getCalendar(streamdat(i), 1, streamdat(i)%calendar) + if (streamdat(i)%mainproc) then + write(streamdat(i)%logunit,'(2a,i0,2a)') subname,' calendar for stream ',i,' is ',trim(streamdat(i)%calendar) + end if ! Error check if (trim(streamdat(i)%taxmode) == shr_stream_taxis_extend .and. streamdat(i)%dtlimit < 1.e10) then - call shr_log_error(trim(subName)//" ERROR: if taxmode value is extend set dtlimit to 1.e30", rc=rc) + call shr_log_error(subname//" ERROR: if taxmode value is extend set dtlimit to 1.e30", rc=rc) return end if ! initialize flag that stream has been set streamdat(i)%init = .true. - enddo + enddo loop_over_streams end subroutine shr_stream_init_from_xml @@ -459,7 +474,9 @@ subroutine shr_stream_init_from_inline(streamdat, & stream_yearFirst, stream_yearLast, stream_yearAlign, & stream_offset, stream_taxmode, stream_tintalgo, stream_dtlimit, & stream_fldlistFile, stream_fldListModel, stream_fileNames, & - logunit, compname, stream_src_mask_val, stream_dst_mask_val) + logunit, compname, isroot_task, stream_src_mask_val, stream_dst_mask_val) + + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent ! -------------------------------------------------------- ! set values of stream datatype independent of a reading in a stream text file @@ -471,34 +488,42 @@ subroutine shr_stream_init_from_inline(streamdat, & type(iosystem_desc_t) ,pointer, intent(in) :: pio_subsystem ! data structure required for pio operations integer ,intent(in) :: io_type ! data format integer ,intent(in) :: io_format ! netcdf format - character(*) ,intent(in) :: stream_meshFile ! full pathname to stream mesh file - character(*) ,intent(in) :: stream_lev_dimname ! name of vertical dimension in stream - character(*) ,intent(in) :: stream_mapalgo ! stream mesh -> model mesh mapping type + character(len=*) ,intent(in) :: stream_meshFile ! full pathname to stream mesh file + character(len=*) ,intent(in) :: stream_lev_dimname ! name of vertical dimension in stream + character(len=*) ,intent(in) :: stream_mapalgo ! stream mesh -> model mesh mapping type integer ,intent(in) :: stream_yearFirst ! first year to use integer ,intent(in) :: stream_yearLast ! last year to use integer ,intent(in) :: stream_yearAlign ! align yearFirst with this model year - character(*) ,intent(in) :: stream_tintalgo ! time interpolation algorithm + character(len=*) ,intent(in) :: stream_tintalgo ! time interpolation algorithm integer ,intent(in) :: stream_offset ! offset in seconds of stream data - character(*) ,intent(in) :: stream_taxMode ! time axis mode + character(len=*) ,intent(in) :: stream_taxMode ! time axis mode real(r8) ,intent(in) :: stream_dtlimit ! ratio of max/min stream delta times - character(*) ,intent(in) :: stream_fldListFile(:) ! file field names, colon delim list - character(*) ,intent(in) :: stream_fldListModel(:) ! model field names, colon delim list - character(*) ,intent(in) :: stream_filenames(:) ! stream data filenames (full pathnamesa) + character(len=*) ,intent(in) :: stream_fldListFile(:) ! file field names, colon delim list + character(len=*) ,intent(in) :: stream_fldListModel(:) ! model field names, colon delim list + character(len=*) ,intent(in) :: stream_filenames(:) ! stream data filenames (full pathnamesa) integer ,intent(in) :: logunit ! stdout unit character(len=*) ,intent(in) :: compname ! component name (e.g. ATM, OCN...) + logical ,intent(in) :: isroot_task ! mainproc integer ,optional, intent(in) :: stream_src_mask_val ! source mask value integer ,optional, intent(in) :: stream_dst_mask_val ! destination mask value ! local variables - integer :: n - integer :: nfiles - integer :: nvars - character(CS) :: calendar ! stream calendar - character(*),parameter :: subName = '(shr_stream_init_from_inline) ' + integer :: n + integer :: nfiles + integer :: nvars + integer :: istat + character(CS) :: calendar ! stream calendar + character(len=*),parameter :: subName = '(shr_stream_init_from_inline) ' ! -------------------------------------------------------- ! Assume only 1 stream - allocate(streamdat(1)) + allocate(streamdat(1), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error for streamdat(1) ') + end if + + streamdat(1)%logunit = logunit + streamdat(1)%mainproc = isroot_task ! overwrite default values streamdat(1)%meshFile = trim(stream_meshFile) @@ -519,7 +544,7 @@ subroutine shr_stream_init_from_inline(streamdat, & streamdat(1)%pio_iotype = shr_pio_getiotype(trim(compname)) streamdat(1)%pio_ioformat = shr_pio_getioformat(trim(compname)) ! This is to avoid an unused dummy argument warning - if(.false.) then + if (.false.) then if(associated(pio_subsystem)) print *, io_type, io_format endif #else @@ -534,7 +559,10 @@ subroutine shr_stream_init_from_inline(streamdat, & end if nfiles = size(stream_filenames) streamdat(1)%nfiles = nfiles - allocate(streamdat(1)%file(nfiles)) + allocate(streamdat(1)%file(nfiles), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error for streamdat(1)%file with size '//toString(nfiles)) + end if do n = 1, nfiles streamdat(1)%file(n)%name = trim(stream_filenames(n)) enddo @@ -542,15 +570,15 @@ subroutine shr_stream_init_from_inline(streamdat, & ! Determine name of stream variables in file and model nvars = size(stream_fldlistFile) streamdat(1)%nvars = nvars - allocate(streamdat(1)%varlist(nvars)) + allocate(streamdat(1)%varlist(nvars), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error for streamdat(1)%varlist with size '//toString(nvars)) + end if do n = 1, nvars streamdat(1)%varlist(n)%nameinfile = trim(stream_fldlistFile(n)) streamdat(1)%varlist(n)%nameinmodel = trim(stream_fldlistModel(n)) end do - ! Initialize logunit - streamdat(:)%logunit = logunit - ! Get stream calendar call shr_stream_getCalendar(streamdat(1), 1, calendar) streamdat(1)%calendar = trim(calendar) @@ -565,13 +593,13 @@ subroutine shr_stream_init_from_inline(streamdat, & end subroutine shr_stream_init_from_inline !=============================================================================== - subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, & + subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, & pio_subsystem, io_type, io_format, rc) - use esmf , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadCast - use esmf , only : ESMF_SUCCESS, ESMF_ConfigCreate, ESMF_ConfigLoadFile - use esmf , only : ESMF_ConfigGetLen, ESMF_ConfigGetAttribute - use esmf , only : ESMF_Config, ESMF_MAXSTR + use esmf , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadCast, ESMF_VMGet + use esmf , only : ESMF_SUCCESS, ESMF_ConfigCreate, ESMF_ConfigLoadFile + use esmf , only : ESMF_ConfigGetLen, ESMF_ConfigGetAttribute + use esmf , only : ESMF_Config, ESMF_MAXSTR !!--------------------------------------------------------------------- !! The configuration file is a text file that can have following entries @@ -609,20 +637,24 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, type(ESMF_VM) :: vm type(ESMF_Config) :: cf integer :: i, n, nstrms + integer :: myid character(2) :: mystrm - character(*),parameter :: subName = '(shr_stream_init_from_esmfconfig)' + integer :: istat character(len=ESMF_MAXSTR), allocatable :: strm_tmpstrings(:) - character(*) , parameter :: u_FILE_u = __FILE__ - + character(len=*), parameter :: u_FILE_u = __FILE__ + character(len=*), parameter :: subName = '(shr_stream_init_from_esmfconfig)' ! --------------------------------------------------------------------- rc = ESMF_SUCCESS - nstrms = 0 - - ! allocate streamdat instance on all tasks + ! Set module variable mainproc call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=myid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! allocate streamdat instance on all tasks + nstrms = 0 ! set ESMF config cf = ESMF_ConfigCreate(rc=RC) @@ -633,16 +665,24 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, nstrms = ESMF_ConfigGetLen(config=CF, label='stream_info:', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! allocate an array of shr_stream_streamtype objects on just isroot_task - if( nstrms > 0 ) then - allocate(streamdat(nstrms)) + ! allocate an array of shr_stream_streamtype objects + if (nstrms > 0) then + allocate(streamdat(nstrms), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//': allocation error for streamdat with size '//toString(nstrms),rc=rc) + return + end if else - call shr_log_error("no stream_info in config file "//trim(streamfilename), rc=rc) - return + call shr_log_error("no stream_info in config file "//trim(streamfilename), rc=rc) + return endif ! fill in non-default values for the streamdat attributes do i=1, nstrms + + streamdat(i)%logunit = logunit + streamdat(i)%mainproc = (myid == main_task) + write(mystrm,"(I2.2)") i call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%taxmode,label="taxmode"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -713,7 +753,13 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, ! Get a list of stream file names streamdat(i)%nfiles = ESMF_ConfigGetLen(config=CF, label="stream_data_files"//mystrm//':', rc=rc) if( streamdat(i)%nfiles > 0) then - allocate(streamdat(i)%file( streamdat(i)%nfiles)) + allocate(streamdat(i)%file( streamdat(i)%nfiles), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for streamdat('//toString(i)//')%file'//& + ' with size '//toString(streamdat(i)%nfiles), rc=rc) + return + end if allocate(strm_tmpstrings(streamdat(i)%nfiles)) call ESMF_ConfigGetAttribute(CF,valueList=strm_tmpstrings, label="stream_data_files"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -729,8 +775,20 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, ! Get name of stream variables in file and model streamdat(i)%nvars = ESMF_ConfigGetLen(config=CF, label="stream_data_variables"//mystrm//':', rc=rc) if( streamdat(i)%nvars > 0) then - allocate(streamdat(i)%varlist(streamdat(i)%nvars)) - allocate(strm_tmpstrings(streamdat(i)%nvars)) + allocate(streamdat(i)%varlist(streamdat(i)%nvars), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for streamdat('//toString(i)//')%varlist'//& + ' with size '//toString(streamdat(i)%nvars), rc=rc) + return + end if + allocate(strm_tmpstrings(streamdat(i)%nvars), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for strm_tmpstrings('//toString(i)//')%varlist'//& + ' with size '//toString(streamdat(i)%nvars), rc=rc) + return + end if call ESMF_ConfigGetAttribute(CF,valueList=strm_tmpstrings,label="stream_data_variables"//mystrm//':', rc=rc) do n=1, streamdat(i)%nvars streamdat(i)%varlist(n)%nameinfile = strm_tmpstrings(n)(1:index(trim(strm_tmpstrings(n)), " ")) @@ -746,8 +804,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, streamdat(i)%pio_subsystem => pio_subsystem streamdat(i)%pio_iotype = io_type streamdat(i)%pio_ioformat = io_format - ! Set logunit - streamdat(i)%logunit = logunit call shr_stream_getCalendar(streamdat(i), 1, streamdat(i)%calendar) @@ -760,7 +816,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, ! Error check if (trim(streamdat(i)%taxmode) == shr_stream_taxis_extend .and. streamdat(i)%dtlimit < 1.e10) then - call shr_log_error(trim(subName)//" ERROR: if taxmode value is extend set dtlimit to 1.e30", rc=rc) + call shr_log_error(subname//" ERROR: if taxmode value is extend set dtlimit to 1.e30", rc=rc) return end if @@ -770,8 +826,9 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, streamdat(:)%init = .true. end subroutine shr_stream_init_from_esmfconfig + !=============================================================================== - subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & + subroutine shr_stream_findBounds(strm, mDateIn, secIn, & mDateLB, dDateLB, secLB, n_lb, fileLB, mDateUB, dDateUB, secUB, n_ub, fileUB) !------------------------------------------------------------------------------- @@ -788,17 +845,16 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & type(shr_stream_streamType) ,intent(inout):: strm ! data stream to query integer ,intent(in) :: mDateIn ! model date (yyyymmdd) integer ,intent(in) :: secIn ! elapsed sec on model date - logical ,intent(in) :: isroot_task ! is mpi task root communicator task integer ,intent(out) :: mDateLB ! model date of LB integer ,intent(out) :: dDateLB ! data date of LB integer ,intent(out) :: secLB ! elap sec of LB integer ,intent(out) :: n_lb ! t-coord index of LB - character(*) ,intent(out) :: fileLB ! file containing LB + character(len=*) ,intent(out) :: fileLB ! file containing LB integer ,intent(out) :: mDateUB ! model date of UB integer ,intent(out) :: dDateUB ! data date of UB integer ,intent(out) :: secUB ! elap sec of UB integer ,intent(out) :: n_ub ! t-coord index of UB - character(*) ,intent(out) :: fileUB ! file containing UB + character(len=*) ,intent(out) :: fileUB ! file containing UB ! local variables integer :: dDateIn ! model date mapped onto a data date @@ -822,20 +878,15 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & real(R8) :: rDategvd ! gvd dDate + secs/(secs per day) logical :: cycle ! is cycling on or off logical :: limit ! is limiting on or off - character(*),parameter :: subName = '(shr_stream_findBounds) ' - character(*),parameter :: F00 = "('(shr_stream_findBounds) ',8a)" - character(*),parameter :: F01 = "('(shr_stream_findBounds) ',a,i9.8,a)" - character(*),parameter :: F02 = "('(shr_stream_findBounds) ',a,2i9.8,i6,i5,1x,a)" - character(*),parameter :: F03 = "('(shr_stream_findBounds) ',a,i4)" - character(*),parameter :: F04 = "('(shr_stream_findBounds) ',2a,i4)" + character(len=*),parameter :: subName = '(shr_stream_findBounds) ' !------------------------------------------------------------------------------- - if (debug>0 .and. isroot_task) then - write(strm%logunit,F02) "DEBUG: ---------- enter ------------------" + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(a,a)') subname,"DEBUG: ---------- enter ------------------" end if if ( .not. strm%init ) then - call shr_sys_abort(trim(subName)//" ERROR: trying to find bounds of uninitialized stream") + call shr_sys_abort(subname//" ERROR: trying to find bounds of uninitialized stream") end if if (trim(strm%taxMode) == trim(shr_stream_taxis_cycle)) then @@ -848,7 +899,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & cycle = .false. limit = .true. else - call shr_sys_abort(trim(subName)//' ERROR: illegal taxMode = '//trim(strm%taxMode)) + call shr_sys_abort(subname//' ERROR: illegal taxMode = '//trim(strm%taxMode)) endif !---------------------------------------------------------------------------- @@ -865,23 +916,29 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & n = 0 if (cycle) then dYear = yrFirst + modulo(mYear-yrAlign+(2*nYears),nYears) ! current data year - if(debug>0 .and. isroot_task) then - write(strm%logunit, *) trim(subname), ' dyear, yrfirst, myear, yralign, nyears =', dyear, yrfirst, myear, yralign, nyears + if(debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(2a,5(i0,2x))') subname, & + ' dyear, yrfirst, myear, yralign, nyears = ', & + dyear, yrfirst, myear, yralign, nyears endif else dYear = yrFirst + mYear - yrAlign endif if (dYear < 0) then - write(strm%logunit,*) trim(subName),' ERROR: dyear lt zero = ',dYear - call shr_sys_abort(trim(subName)//' ERROR: dyear lt zero') + if (strm%mainproc) then + write(strm%logunit,'(2a,i0)') subname,' ERROR: dyear lt zero = ',dYear + end if + call shr_sys_abort(subname//' ERROR: dyear lt zero') endif dDateIn = dYear*10000 + modulo(mDateIn,10000) ! mDateIn mapped to range of data years rDateIn = dDateIn + secIn/spd ! dDateIn + fraction of a day - if (debug>0 .and. isroot_task) then - write(strm%logunit,'(a,2(i8,2x),2(f20.4,2x))') 'mYear,dYear,dDateIn,rDateIn = ',mYear,dYear,dDateIn,rDateIn - write(strm%logunit,'(a,2(i8,2x),2(f20.4,2x))') 'yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(2a,3(i0,2x),f20.4)') subname, & + ' mYear,dYear,dDateIn,rDateIn = ',mYear,dYear,dDateIn,rDateIn + write(strm%logunit,'(2a,4(i0,2x))') subname, & + ' yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears endif !---------------------------------------------------------------------------- @@ -891,9 +948,9 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & if (.not. strm%found_lvd) then A: do k=1,strm%nFiles if (.not. strm%file(k)%haveData) then - call shr_stream_readtCoord(strm, k, isroot_task, rCode) + call shr_stream_readtCoord(strm, k, rCode) if ( rCode /= 0 )then - call shr_sys_abort(trim(subName)//" ERROR: readtCoord1") + call shr_sys_abort(subname//" ERROR: readtCoord1") end if end if do n=1,strm%file(k)%nt @@ -907,16 +964,18 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & end do end do A if (.not. strm%found_lvd) then - call shr_sys_abort(trim(subName)//" ERROR: LVD not found, all data is before yearFirst") + call shr_sys_abort(subname//" ERROR: LVD not found, all data is before yearFirst") else !--- LVD is in or beyond yearFirst, verify it is not beyond yearLast --- if ( dDateL <= strm%file(strm%k_lvd)%date(strm%n_lvd) ) then - write(strm%logunit,F00) "ERROR: LVD not found, all data is after yearLast" - call shr_sys_abort(trim(subName)//" ERROR: LVD not found, all data is after yearLast") + if (strm%mainproc) then + write(strm%logunit,'(2a)') subname," ERROR: LVD not found, all data is after yearLast" + end if + call shr_sys_abort(subname//" ERROR: LVD not found, all data is after yearLast") end if end if - if (debug>1 .and. isroot_task ) then - if (strm%found_lvd) write(strm%logunit,F01) " found LVD = ",strm%file(k)%date(n) + if (debug_level>1 .and. strm%mainproc) then + if (strm%found_lvd) write(strm%logunit,'(2a,i0)') subname," found LVD = ",strm%file(k)%date(n) end if end if @@ -925,8 +984,10 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & n = strm%n_lvd rDatelvd = strm%file(k)%date(n) + strm%file(k)%secs(n)/spd ! LVD date + frac day else - write(strm%logunit,F00) "ERROR: LVD not found yet" - call shr_sys_abort(trim(subName)//" ERROR: LVD not found yet") + if (strm%mainproc) then + write(strm%logunit,'(2a)') subname," ERROR: LVD not found yet" + end if + call shr_sys_abort(subname//" ERROR: LVD not found yet") endif if (strm%found_gvd) then @@ -936,8 +997,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & else rDategvd = 99991231.0 endif - if (debug>0 .and. isroot_task) then - write(strm%logunit,'(a,3(f20.4,2x))') 'rDateIn,rDatelvd,rDategvd = ',rDateIn,rDatelvd,rDategvd + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(2a,3(f20.4,2x))') subname,' rDateIn,rDatelvd,rDategvd = ',rDateIn,rDatelvd,rDategvd endif !----------------------------------------------------------- @@ -949,8 +1010,11 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & if (rDateIn < rDatelvd) then if (limit) then - write(strm%logunit,*) trim(subName)," ERROR: limit on and rDateIn lt rDatelvd",rDateIn,rDatelvd - call shr_sys_abort(trim(subName)//" ERROR: rDateIn lt rDatelvd limit true") + if (strm%mainproc) then + write(strm%logunit,'(2a,2(f20.4,2x))') subname,& + " ERROR: limit on and rDateIn lt rDatelvd ",rDateIn,rDatelvd + end if + call shr_sys_abort(subname//" ERROR: rDateIn lt rDatelvd limit true") endif if (.not.cycle) then @@ -979,9 +1043,9 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & B: do k=strm%nFiles,1,-1 !--- read data for file number k --- if (.not. strm%file(k)%haveData) then - call shr_stream_readtCoord(strm, k, isroot_task, rCode) + call shr_stream_readtCoord(strm, k, rCode) if ( rCode /= 0 )then - call shr_sys_abort(trim(subName)//" ERROR: readtCoord2") + call shr_sys_abort(subname//" ERROR: readtCoord2") end if end if !--- start search at greatest date & move toward least date --- @@ -991,8 +1055,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & strm%n_gvd = n strm%found_gvd = .true. rDategvd = strm%file(k)%date(n) + strm%file(k)%secs(n)/spd ! GVD date + frac day - if (debug>1 .and. isroot_task) then - write(strm%logunit,F01) " found GVD ",strm%file(k)%date(n) + if (debug_level>1 .and. strm%mainproc) then + write(strm%logunit,'(2a,i0)') subname," found GVD ",strm%file(k)%date(n) end if exit B end if @@ -1001,8 +1065,10 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & end if if (.not. strm%found_gvd) then - write(strm%logunit,F00) "ERROR: GVD not found1" - call shr_sys_abort(trim(subName)//" ERROR: GVD not found1") + if (strm%mainproc) then + write(strm%logunit,'(2a)') subname," ERROR: GVD not found1" + end if + call shr_sys_abort(subname//" ERROR: GVD not found1") endif k_lb = strm%k_gvd @@ -1035,8 +1101,11 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & else if (strm%found_gvd .and. rDateIn >= rDategvd) then if (limit) then - write(strm%logunit,*) trim(subName)," ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd - call shr_sys_abort(trim(subName)//" ERROR: rDateIn >= rDategvd limit true") + if (strm%mainproc) then + write(strm%logunit,'(2a,2(f13.5,2x))') subname,& + " ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd + end if + call shr_sys_abort(subname//" ERROR: rDateIn >= rDategvd limit true") endif if (.not.cycle) then @@ -1089,9 +1158,9 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & C: do k=strm%k_lvd,strm%nFiles !--- read data for file number k --- if (.not. strm%file(k)%haveData) then - call shr_stream_readtCoord(strm, k, isroot_task, rCode) + call shr_stream_readtCoord(strm, k, rCode) if ( rCode /= 0 )then - call shr_sys_abort(trim(subName)//" ERROR: readtCoord3") + call shr_sys_abort(subname//" ERROR: readtCoord3") end if end if !--- examine t-coords for file k --- @@ -1135,8 +1204,11 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & if (strm%found_gvd .and. rDateIn >= rDategvd) then if (limit) then - write(strm%logunit,*) trim(subName)," ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd - call shr_sys_abort(trim(subName)//" ERROR: rDateIn >= rDategvd limit true") + if (strm%mainproc) then + write(strm%logunit,'(2a,2(f13.5,2x))') subname,& + " ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd + end if + call shr_sys_abort(subname//" ERROR: rDateIn >= rDategvd limit true") endif if (.not.cycle) then @@ -1209,7 +1281,9 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & call shr_cal_date2ymd(dDateUB,yy,mm,dd) yy = yy + (mYear-dYear) if(mm == 2 .and. dd==29 .and. .not. shr_cal_leapyear(yy)) then - if(isroot_task) write(strm%logunit, *) 'Found leapyear mismatch', myear, dyear, yy + if (strm%mainproc) then + write(strm%logunit,'(2a,3(i0,2x))') subname,' Found leapyear mismatch', myear, dyear, yy + end if mm = 3 dd = 1 endif @@ -1223,19 +1297,18 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & end do C endif - call shr_sys_abort(trim(subName)//' ERROR: findBounds failed') + call shr_sys_abort(subname//' ERROR: findBounds failed') end subroutine shr_stream_findBounds !=============================================================================== - subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) + subroutine shr_stream_readTCoord(strm, k, rc) ! Read in time coordinates with possible offset (require that time coordinate is 'time') ! input/output parameters: type(shr_stream_streamType) ,intent(inout) :: strm ! data stream to query integer ,intent(in) :: k ! stream file index - logical ,intent(in) :: isroot_task integer,optional ,intent(out) :: rc ! return code ! local variables @@ -1256,7 +1329,8 @@ subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) real(R8) :: nsec ! elapsed secs on calendar date real(R8),allocatable :: tvar(:) character(CX) :: msg - character(*),parameter :: subname = '(shr_stream_readTCoord) ' + integer :: istat + character(len=*),parameter :: subname = '(shr_stream_readTCoord) ' !------------------------------------------------------------------------------- lrc = 0 @@ -1266,15 +1340,18 @@ subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) ! open file if needed if (.not. pio_file_is_open(strm%file(k)%fileid)) then - if (debug>1 .and. isroot_task) then - write(strm%logunit, '(a)') trim(subname)//' opening stream filename = '//trim(filename) + if (debug_level>1 .and. strm%mainproc) then + write(strm%logunit,'(3a)') subname,' opening stream filename = ',trim(filename) end if rcode = pio_openfile(strm%pio_subsystem, strm%file(k)%fileid, strm%pio_iotype, filename, pio_nowrite) endif rCode = pio_inq_varid(strm%file(k)%fileid, 'time', vid) rCode = pio_inquire_variable(strm%file(k)%fileid, vid, ndims=ndims) - allocate(dids(ndims)) + allocate(dids(ndims), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error dids with size '//toString(ndims)) + end if rCode = pio_inquire_variable(strm%file(k)%fileid, vid, dimids=dids) ! determine number of times in file @@ -1283,10 +1360,18 @@ subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) ! allocate memory for date and secs if (.not. allocated(strm%file(k)%date)) then - allocate(strm%file(k)%date(nt), strm%file(k)%secs(nt)) + allocate(strm%file(k)%date(nt), strm%file(k)%secs(nt), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//& + ': allocation error for strm%file('//toString(k)//')%date'//' with size '//toString(nt)) + end if else if(size(strm%file(k)%date) .ne. nt) then deallocate(strm%file(k)%date, strm%file(k)%secs) - allocate(strm%file(k)%date(nt), strm%file(k)%secs(nt)) + allocate(strm%file(k)%date(nt), strm%file(k)%secs(nt), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//& + ': allocation error for strm%file('//toString(k)//')%date'//' with size '//toString(nt)) + end if endif strm%file(k)%nt = nt @@ -1315,7 +1400,10 @@ subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) strm%calendar = trim(shr_cal_calendarName(trim(calendar))) ! read in time coordinate values - allocate(tvar(nt)) + allocate(tvar(nt), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error for tvar with size '//toString(nt)) + end if rcode = pio_get_var(strm%file(k)%fileid,vid,tvar) ! determine strm%file(k)%date(n) and strm%file(k)%secs(n) @@ -1327,15 +1415,15 @@ subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) deallocate(tvar) ! close file - if (debug>1 .and. isroot_task) then - write(strm%logunit, '(a)') trim(subname)//' closing stream filename = '//trim(filename) + if (debug_level>1 .and. strm%mainproc) then + write(strm%logunit,'(3a)') subname,' closing stream filename = ',trim(filename) end if call pio_closefile(strm%file(k)%fileid) ! if offset is not zero, adjust strm%file(k)%date(n) and strm%file(k)%secs(n) if (strm%offset /= 0) then if (size(strm%file(k)%date) /= size(strm%file(k)%secs)) then - write(msg ,'(a,2i7)') trim(subname)//" Incompatable date and secs sizes",& + write(msg ,'(a,2i7)') subname//" Incompatable date and secs sizes",& size(strm%file(k)%date), size(strm%file(k)%secs) call shr_sys_abort(trim(msg)) endif @@ -1344,10 +1432,19 @@ subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) do n = 1,num din = strm%file(k)%date(n) sin = strm%file(k)%secs(n) + if (debug_level > 5 .and. strm%mainproc) then + write(strm%logunit,'(2a,5(i0,2x))') subname,& + ' before shr_cal_advDateInt: offset,n,k,strm%file(k)%date(n),strm%file(k)%sec(n) = ',& + offin,n,k,strm%file(k)%date(n),strm%file(k)%secs(n) + end if call shr_cal_advDateInt(offin,'seconds',din,sin,dout,sout,calendar) strm%file(k)%date(n) = dout strm%file(k)%secs(n) = sout - ! write(strm%logunit,*) 'debug ',n,strm%offset,din,sin,dout,sout + if (debug_level > 5 .and. strm%mainproc) then + write(strm%logunit,'(2a,5(i0,2x))') subname,& + ' after shr_cal_advDateInt: offset,n,k,strm%file(k)%date(n),strm%file(k)%sec(n) = ',& + offin,n,k,strm%file(k)%date(n),strm%file(k)%secs(n) + end if enddo endif @@ -1375,10 +1472,8 @@ subroutine verifyTCoord(strm,k,rc) integer :: date1,secs1 ! date and seconds for a time coord integer :: date2,secs2 ! date and seconds for next time coord logical :: checkIt ! have data / do comparison - character(*),parameter :: subName = '(shr_stream_verifyTCoord) ' - character(*),parameter :: F00 = "('(shr_stream_verifyTCoord) ',8a)" - character(*),parameter :: F01 = "('(shr_stream_verifyTCoord) ',a,2i7)" - character(*),parameter :: F02 = "('(shr_stream_verifyTCoord) ',a,2i9.8)" + character(len=*),parameter :: subName = '(shr_stream_verifyTCoord) ' + !------------------------------------------------------------------------------- ! Notes: ! o checks that dates are increasing (must not decrease) @@ -1390,17 +1485,19 @@ subroutine verifyTCoord(strm,k,rc) !------------------------------------------------------------------------------- rc = 0 - if (debug>1 .and. isroot_task) then - write(strm%logunit,F01) "checking t-coordinate data for file k =",k + if (debug_level>1 .and. strm%mainproc) then + write(strm%logunit,'(2a,i0)') subname," checking t-coordinate data for file k =",k end if if ( .not. strm%file(k)%haveData) then rc = 1 - write(strm%logunit,F01) "Don't have data for file ",k + if (strm%mainproc) then + write(strm%logunit,'(2a,i0)') subname," ERROR: do not have data for file ",k + end if call shr_sys_abort(subName//"ERROR: can't check -- file not read.") end if - do n=1,strm%file(k)%nt+1 + stream_file_times:do n=1,strm%file(k)%nt+1 checkIt = .false. !--- do we have data for two consecutive dates? --- @@ -1414,7 +1511,9 @@ subroutine verifyTCoord(strm,k,rc) date2 = strm%file(k )%date(n) secs2 = strm%file(k )%secs(n) checkIt = .true. - if (debug>1 .and. isroot_task) write(strm%logunit,F01) "comparing with previous file for file k =",k + if (debug_level>1 .and. strm%mainproc) then + write(strm%logunit,'(2a,i0)') subname," comparing with previous file for file k =",k + end if end if end if else if (n==strm%file(k)%nt+1) then @@ -1427,7 +1526,9 @@ subroutine verifyTCoord(strm,k,rc) date2 = strm%file(k+1)%date(1) secs2 = strm%file(k+1)%secs(1) checkIt = .true. - if (debug>1 .and. isroot_task) write(strm%logunit,F01) "comparing with next file for file k =",k + if (debug_level>1 .and. strm%mainproc) then + write(strm%logunit,'(2a,i0)') subname," comparing with next file for file k =",k + end if end if end if else @@ -1443,28 +1544,35 @@ subroutine verifyTCoord(strm,k,rc) if (checkIt) then if ( date1 > date2 ) then rc = 1 - write(strm%logunit,F01) "ERROR: calendar dates must be increasing" - write(strm%logunit,F02) "date(n), date(n+1) = ",date1,date2 + if (strm%mainproc) then + write(strm%logunit,'(2a)') subname," ERROR: calendar dates must be increasing" + write(strm%logunit,'(2a,2(i0,2x))') subname," date(n), date(n+1) = ",date1,date2 + end if call shr_sys_abort(subName//"ERROR: calendar dates must be increasing") else if ( date1 == date2 ) then if ( secs1 >= secs2 ) then rc = 1 - write(strm%logunit,F01) "ERROR: elapsed seconds on a date must be strickly increasing" - write(strm%logunit,F02) "secs(n), secs(n+1) = ",secs1,secs2 + if (strm%mainproc) then + write(strm%logunit,'(2a)') subname, "ERROR: elapsed seconds on a date must be strictly increasing" + write(strm%logunit,'(2a,2(i0,2x))') subname," secs(n), secs(n+1) = ",secs1,secs2 + end if call shr_sys_abort(subName//"ERROR: elapsed seconds must be increasing") end if end if if ( secs1 < 0 .or. spd < secs1 ) then rc = 1 - write(strm%logunit,F01) "ERROR: elapsed seconds out of valid range [0,spd]" - write(strm%logunit,F02) "secs(n) = ",secs1 + if (strm%mainproc) then + write(strm%logunit,'(2a)') subname," ERROR: elapsed seconds out of valid range [0,spd]" + write(strm%logunit,'(2a,i0)') subname, " secs(n) = ",secs1 + end if call shr_sys_abort(subName//"ERROR: elapsed seconds out of range") end if end if - end do - - if (debug>0 .and. isroot_task) write(strm%logunit,F01) "data is OK (non-decreasing) for file k =",k + end do stream_file_times + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(2a,i0)') subname," data is OK (non-decreasing) for file k =",k + end if end subroutine verifyTCoord end subroutine shr_stream_readTCoord @@ -1490,7 +1598,7 @@ subroutine shr_stream_getModelFieldList(stream, list) !input/output parameters: type(shr_stream_streamType) ,intent(in) :: stream ! stream in question - character(*) ,intent(out) :: list(:) ! field list + character(len=*) ,intent(out) :: list(:) ! field list ! local variables integer :: i @@ -1509,7 +1617,7 @@ subroutine shr_stream_getStreamFieldList(stream, list) !input/output parameters: type(shr_stream_streamType) ,intent(in) :: stream ! stream in question - character(*) ,intent(out) :: list(:) ! field list + character(len=*) ,intent(out) :: list(:) ! field list !------------------------------------------------------------------------------- integer :: i @@ -1521,49 +1629,46 @@ end subroutine shr_stream_getStreamFieldList !=============================================================================== subroutine shr_stream_getCalendar(strm, k, calendar) + use pio, only : PIO_set_log_level, PIO_OFFSET_KIND use ESMF, only: ESMF_VM, ESMF_VMGet, ESMF_VMGetCurrent + ! Returns calendar name ! input/output parameters: type(shr_stream_streamType) ,intent(inout) :: strm ! data stream integer ,intent(in) :: k ! file to query - character(*) ,intent(out) :: calendar ! calendar name + character(len=*) ,intent(out) :: calendar ! calendar name ! local - type(ESMF_VM) :: vm - integer :: myid integer :: vid, n character(CX) :: fileName character(CL) :: lcal integer(PIO_OFFSET_KIND) :: attlen integer :: old_handle integer :: rCode - integer :: rc - character(*),parameter :: subName = '(shr_stream_getCalendar) ' + character(len=*),parameter :: subName = '(shr_stream_getCalendar) ' !------------------------------------------------------------------------------- lcal = ' ' calendar = ' ' if (k > strm%nfiles) call shr_sys_abort(subname//' ERROR: k gt nfiles') - call ESMF_VMGetCurrent(vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=myid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fileName = strm%file(k)%name if (.not. pio_file_is_open(strm%file(k)%fileid)) then - if(myid == 0) write(strm%logunit, '(a)') trim(subname)//' opening stream filename = '//trim(filename) + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(3a)') subname,' opening stream filename = ',trim(filename) + end if rcode = pio_openfile(strm%pio_subsystem, strm%file(k)%fileid, strm%pio_iotype, trim(filename)) - else if(myid == 0) then - write(strm%logunit, '(a)') trim(subname)//' reading stream filename = '//trim(filename) + else + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(3a)') subname,' reading stream filename = ',trim(filename) + end if endif rCode = pio_inq_varid(strm%file(k)%fileid, 'time', vid) - if(vid .lt. 0) then + if (vid < 0) then call shr_sys_abort(subName//"ERROR: time variable id incorrect") endif call pio_seterrorhandling(strm%file(k)%fileid, PIO_BCAST_ERROR, old_handle) @@ -1579,15 +1684,19 @@ subroutine shr_stream_getCalendar(strm, k, calendar) if(n>0) then if (ichar(lcal(n:n)) == 0 ) lcal(n:n) = ' ' else - write(strm%logunit,*) 'calendar attribute to time variable not found in file, using default noleap' + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(2a)') subname,& + 'calendar attribute to time variable not found in file, using default noleap' + end if call shr_sys_abort(subName//"ERROR: calendar attribute not found in file "//trim(filename)) lcal = trim(shr_cal_noleap) endif call shr_string_leftalign_and_convert_tabs(lcal) calendar = trim(shr_cal_calendarName(trim(lcal))) - - if(myid == 0) write(strm%logunit, '(a)') trim(subname)//' closing stream filename = '//trim(filename) + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit, '(3a)') subname,' closing stream filename = ',trim(filename) + end if call pio_closefile(strm%file(k)%fileid) end subroutine shr_stream_getCalendar @@ -1600,7 +1709,7 @@ subroutine shr_stream_getCurrFile(strm, fileopen, currfile, currpioid) ! input/output parameters: type(shr_stream_streamType),intent(inout) :: strm ! data stream logical ,optional,intent(out) :: fileopen ! file open flag - character(*) ,optional,intent(out) :: currfile ! current filename + character(len=*) ,optional,intent(out) :: currfile ! current filename type(file_desc_t) ,optional,intent(out) :: currpioid ! current pioid !------------------------------------------------------------------------------- @@ -1618,7 +1727,7 @@ subroutine shr_stream_setCurrFile(strm, fileopen, currfile, currpioid) ! input/output parameters: type(shr_stream_streamType),intent(inout) :: strm ! data stream logical ,optional,intent(in) :: fileopen ! file open flag - character(*) ,optional,intent(in) :: currfile ! current filename + character(len=*) ,optional,intent(in) :: currfile ! current filename type(file_desc_t) ,optional,intent(in) :: currpioid ! current pioid !------------------------------------------------------------------------------- @@ -1637,16 +1746,15 @@ subroutine shr_stream_getNextFileName(strm, fn, fnNext,rc) ! !input/output parameters: type(shr_stream_streamType) ,intent(in) :: strm ! data stream - character(*) ,intent(in) :: fn ! file name - character(*) ,intent(out) :: fnNext ! next file name + character(len=*) ,intent(in) :: fn ! file name + character(len=*) ,intent(out) :: fnNext ! next file name integer ,optional ,intent(out) :: rc ! return code ! local variables integer :: rCode ! return code integer :: n ! loop index logical :: found ! file name found? - character(*),parameter :: subName = '(shr_stream_getNextFileName) ' - character(*),parameter :: F00 = "('(shr_stream_getNextFileName) ',8a)" + character(len=*),parameter :: subName = '(shr_stream_getNextFileName) ' !------------------------------------------------------------------------------- rCode = 0 @@ -1661,7 +1769,9 @@ subroutine shr_stream_getNextFileName(strm, fn, fnNext,rc) end do if (.not. found) then rCode = 1 - write(strm%logunit,F00) "ERROR: input file name is not in stream: ",trim(fn) + if (strm%mainproc) then + write(strm%logunit,'(3a)') subname," ERROR: input file name is not in stream file: ",trim(fn) + end if call shr_sys_abort(subName//"ERROR: file name not in stream: "//trim(fn)) end if @@ -1687,16 +1797,16 @@ subroutine shr_stream_getPrevFileName(strm, fn, fnPrev,rc) ! !input/output parameters: type(shr_stream_streamType) ,intent(in) :: strm ! data stream - character(*) ,intent(in) :: fn ! file name - character(*) ,intent(out) :: fnPrev ! preciding file name + character(len=*) ,intent(in) :: fn ! file name + character(len=*) ,intent(out) :: fnPrev ! preciding file name integer ,optional ,intent(out) :: rc ! return code !--- local --- integer :: rCode ! return code integer :: n ! loop index logical :: found ! file name found? - character(*),parameter :: subName = '(shr_stream_getPrevFileName) ' - character(*),parameter :: F00 = "('(shr_stream_getPrevFileName) ',8a)" + character(len=*),parameter :: subName = '(shr_stream_getPrevFileName) ' + !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Note: will wrap-around data loop if lvd & gvd are known @@ -1715,7 +1825,9 @@ subroutine shr_stream_getPrevFileName(strm, fn, fnPrev,rc) end do if (.not. found) then rCode = 1 - write(strm%logunit,F00) "ERROR: input file name is not in stream: ",trim(fn) + if (strm%mainproc) then + write(strm%logunit,'(3a)') subname," ERROR: input file name is not in stream: ",trim(fn) + end if call shr_sys_abort(subName//"ERROR: file name not in stream: "//trim(fn)) end if @@ -1749,6 +1861,7 @@ end subroutine shr_stream_getNFiles !=============================================================================== subroutine shr_stream_restIO(pioid, streams, mode) + use shr_file_mod, only : shr_file_get_real_path use pio, only : pio_def_dim, pio_def_var, pio_put_var, pio_get_var, file_desc_t, var_desc_t use pio, only : pio_int, pio_char @@ -1765,9 +1878,9 @@ subroutine shr_stream_restIO(pioid, streams, mode) integer :: n, k, maxnfiles=0 integer :: maxnt = 0 integer, allocatable :: tmp(:) - integer :: logunit character(len=CX) :: fname, rfname, rsfname - + integer :: istat + character(len=*),parameter :: subName = '(shr_stream_restIO) ' !------------------------------------------------------------------------------- if (mode .eq. 'define') then @@ -1775,7 +1888,6 @@ subroutine shr_stream_restIO(pioid, streams, mode) rcode = pio_def_dim(pioid, 'strlen', CX, dimid_str) do k=1,size(streams) ! maxnfiles is the maximum number of files across all streams - logunit = streams(k)%logunit if (streams(k)%nfiles > maxnfiles) then maxnfiles = streams(k)%nfiles endif @@ -1810,7 +1922,10 @@ subroutine shr_stream_restIO(pioid, streams, mode) ! write out nfiles rcode = pio_inq_varid(pioid, 'nfiles', varid) - allocate(tmp(size(streams))) + allocate(tmp(size(streams)), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error for tmp with size '//toString(size(streams))) + end if do k=1,size(streams) tmp(k) = streams(k)%nFiles enddo @@ -1904,7 +2019,10 @@ subroutine shr_stream_restIO(pioid, streams, mode) ! Read in nfiles rcode = pio_inq_varid(pioid, 'nfiles', varid) - allocate(tmp(size(streams))) + allocate(tmp(size(streams)), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error for tmp with size '//toString(size(streams))) + end if rcode = pio_get_var(pioid, varid, tmp) do k=1,size(streams) if (streams(k)%nFiles /= tmp(k)) then @@ -1963,31 +2081,44 @@ subroutine shr_stream_restIO(pioid, streams, mode) rcode = pio_inq_varid(pioid, 'date' , dvarid) rcode = pio_inq_varid(pioid, 'timeofday', tvarid) rcode = pio_inq_varid(pioid, 'haveData' , hdvarid) - do k=1,size(streams) - logunit = streams(k)%logunit - do n=1,streams(k)%nfiles + + stream_loop: do k=1,size(streams) + file_loop: do n=1,streams(k)%nfiles ! read in filename rcode = pio_get_var(pioid, varid, (/1,n,k/), fname) - + if(trim(fname) /= trim(streams(k)%file(n)%name)) then - write(logunit,*) 'Filename does not match restart record, checking realpath' + if (streams(k)%mainproc) then + write(streams(k)%logunit,'(6a)') subname,' filename ',trim(streams(k)%file(n)%name), & + ' does not match restart record ',trim(fname),' checking realpath' + end if call shr_file_get_real_path(fname, rfname) call shr_file_get_real_path(trim(streams(k)%file(n)%name), rsfname) if (trim(rfname) /= trim(rsfname)) then - write(logunit,*) 'Filename path does not match restartfile, checking filename' + if (streams(k)%mainproc) then + write(streams(k)%logunit,'(6a)') subname,'Filename path ',trim(rfname),& + ' does not match restartfile ',trim(rsfname),' checking filename' + end if rfname = fname(index(fname,'/',.true.):) rsfname = streams(k)%file(n)%name(index(streams(k)%file(n)%name, '/',.true.):) if (trim(rfname) /= trim(rsfname)) then - write(logunit,*) trim(rfname), '<>', trim(rsfname) - write(logunit,'(a)')' fname = '//trim(fname) - write(logunit,'(a,i8,2x,i8,2x,a)')' k,n,streams(k)%file(n)%name = ',k,n,trim(streams(k)%file(n)%name) + if (streams(k)%mainproc) then + write(streams(k)%logunit,'(4a)') subname,trim(rfname), '<>', trim(rsfname) + write(streams(k)%logunit,'(3a)') subname,' fname = ',trim(fname) + write(streams(k)%logunit,'(2a,i0,2x,i0,2x,a)') subname,' k,n,streams(k)%file(n)%name = ',& + k,n,trim(streams(k)%file(n)%name) + end if call shr_sys_abort('ERROR reading in filename') endif endif endif + ! read in nt - allocate(tmp(1)) + allocate(tmp(1), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//': allocation error for tmp(1)') + end if rcode = pio_get_var(pioid, ntvarid, (/n,k/), tmp(1)) streams(k)%file(n)%nt = tmp(1) if(tmp(1) /= streams(k)%file(n)%nt) then @@ -1998,7 +2129,11 @@ subroutine shr_stream_restIO(pioid, streams, mode) if (streams(k)%file(n)%nt > 0) then ! Allocate memory - allocate(tmp(streams(k)%file(n)%nt)) + allocate(tmp(streams(k)%file(n)%nt), stat=istat) + if ( istat /= 0 ) then + call shr_sys_abort(subName//& + ': allocation error for tmp with size '//toSTring(streams(k)%file(n)%nt)) + end if ! Read in date rcode = pio_get_var(pioid, dvarid, (/1,n,k/), (/streams(k)%file(n)%nt,1,1/),tmp) @@ -2026,8 +2161,8 @@ subroutine shr_stream_restIO(pioid, streams, mode) deallocate(tmp) endif - enddo - enddo + enddo file_loop + enddo stream_loop endif end subroutine shr_stream_restIO @@ -2040,35 +2175,31 @@ subroutine shr_stream_dataDump(strm) ! input/output parameters: type(shr_stream_streamType),intent(in) :: strm ! data stream - !----- local ----- - integer :: k ! generic loop index - integer :: logunit - character(*),parameter :: F00 = "('(shr_stream_dataDump) ',8a)" - character(*),parameter :: F01 = "('(shr_stream_dataDump) ',a,3i5)" - character(*),parameter :: F02 = "('(shr_stream_dataDump) ',a,365i9.8)" - character(*),parameter :: F03 = "('(shr_stream_dataDump) ',a,365i6)" + ! local variables + integer :: nf,nt ! generic loop indices + character(len=*),parameter :: subName = '(shr_stream_dataDump) ' !------------------------------------------------------------------------------- - logunit = strm%logunit - - if (debug > 0) then - write(logunit,F00) "dump internal data for debugging..." - write(logunit,F01) "nFiles = ", strm%nFiles - do k=1,strm%nFiles - write(logunit,F01) "data for file k = ",k - write(logunit,F00) "* file(k)%name = ", trim(strm%file(k)%name) - if ( strm%file(k)%haveData ) then - write(logunit,F01) "* file(k)%nt = ", strm%file(k)%nt - write(logunit,F02) "* file(k)%date(:) = ", strm%file(k)%date(:) - write(logunit,F03) "* file(k)%Secs(:) = ", strm%file(k)%secs(:) + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(2a)') subname,"dump internal data for debugging..." + write(strm%logunit,'(2a,i0)') subname," nFiles = ", strm%nFiles + do nf = 1,strm%nFiles + write(strm%logunit,'(2a,i0)') subname," data for file nf = ",nf + write(strm%logunit,'(2a)') subname," file(nf)%name = ", trim(strm%file(nf)%name) + if ( strm%file(nf)%haveData ) then + write(strm%logunit,'(2a,i0)') subname," file(nf)%nt = ", strm%file(nf)%nt + do nt = 1, size(strm%file(nf)%date) + write(strm%logunit,'(2a,2(i0,2x))') subname," file(nf)%date(nt) = ",nt,strm%file(nf)%date(nt) + write(strm%logunit,'(2a,2(i0,2x))') subname," file(nf)%secs(nt) = ",nt,strm%file(nf)%secs(nt) + end do else - write(logunit,F00) "* time coord data not read in yet for this file" + write(strm%logunit,'(2a)') subname,' time coord data not read in yet for this file' end if end do - write(logunit,F01) "yearF/L/A = ", strm%yearFirst,strm%yearLast,strm%yearAlign - write(logunit,F01) "offset = ", strm%offset - write(logunit,F00) "taxMode = ", trim(strm%taxMode) - write(logunit,F00) "meshfile = ", trim(strm%meshfile) + write(strm%logunit,'(2a,3(2x,i0))') subname,"yearF/L/A = ",strm%yearFirst,strm%yearLast,strm%yearAlign + write(strm%logunit,'(2a,i0)') subname,"offset = ",strm%offset + write(strm%logunit,'(3a)') subname,"taxMode = ",trim(strm%taxMode) + write(strm%logunit,'(3a)') subname,"meshfile = ",trim(strm%meshfile) end if end subroutine shr_stream_dataDump diff --git a/streams/dshr_tinterp_mod.F90 b/streams/dshr_tinterp_mod.F90 index 104bea65e..3aa42f1ce 100644 --- a/streams/dshr_tinterp_mod.F90 +++ b/streams/dshr_tinterp_mod.F90 @@ -13,8 +13,9 @@ module dshr_tInterp_mod use shr_const_mod , only : SHR_CONST_PI use dshr_methods_mod , only : chkerr use shr_sys_mod , only : shr_sys_abort + implicit none - private ! except + private public :: shr_tInterp_getFactors ! get time-interp factors public :: shr_tInterp_getAvgCosz ! get cosz, time avg of @@ -26,7 +27,7 @@ module dshr_tInterp_mod real(r8) ,parameter :: c0 = 0.0_r8 real(r8) ,parameter :: c1 = 1.0_r8 real(r8) ,parameter :: eps = 1.0E-12_r8 - character(*) ,parameter :: u_FILE_u = & + character(len=*) ,parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -51,9 +52,9 @@ subroutine shr_tInterp_getFactors(D1,S1,D2,S2,Din,Sin,f1,f2,calendar,logunit,alg integer ,intent(in) :: Din,Sin ! desired/model date & sec real(r8) ,intent(out) :: f1 ! wgt for 1 real(r8) ,intent(out) :: f2 ! wgt for 2 - character(*) ,intent(in) :: calendar!calendar type + character(len=*) ,intent(in) :: calendar!calendar type integer ,intent(in) :: logunit - character(*) ,intent(in) ,optional :: algo ! algorithm + character(len=*) ,intent(in) ,optional :: algo ! algorithm integer ,intent(out) :: rc ! return code ! local variables @@ -64,11 +65,11 @@ subroutine shr_tInterp_getFactors(D1,S1,D2,S2,Din,Sin,f1,f2,calendar,logunit,alg integer(i8) :: snum, sden ! delta times in seconds integer(i8) :: sint1,sint2 ! delta times in seconds character(cs) :: lalgo ! local algo variable - character(*),parameter :: subName = "(shr_tInterp_getFactors) " - character(*),parameter :: F00 = "('(shr_tInterp_getFactors) ',8a)" - character(*),parameter :: F01 = "('(shr_tInterp_getFactors) ',a,2f17.8)" - character(*),parameter :: F02 = "('(shr_tInterp_getFactors) ',a,3i9)" - character(*),parameter :: F03 = "('(shr_tInterp_getFactors) ',2a,3(i9.8,i6))" + character(len=*),parameter :: subName = "(shr_tInterp_getFactors) " + character(len=*),parameter :: F00 = "('(shr_tInterp_getFactors) ',8a)" + character(len=*),parameter :: F01 = "('(shr_tInterp_getFactors) ',a,2f17.8)" + character(len=*),parameter :: F02 = "('(shr_tInterp_getFactors) ',a,3i9)" + character(len=*),parameter :: F03 = "('(shr_tInterp_getFactors) ',2a,3(i9.8,i6))" !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -182,7 +183,7 @@ subroutine shr_tInterp_getAvgCosz(tavCosz, lon, lat, & real(r8) ,intent(in) :: lambm0 ! orb param real(r8) ,intent(in) :: obliqr ! orb param integer ,intent(in) :: modeldt ! model time step in secs - character(*) ,intent(in) :: calendar ! calendar type + character(len=*) ,intent(in) :: calendar ! calendar type logical , intent(in) :: isroot integer , intent(in) :: logunit integer ,intent(out) :: rc ! error status @@ -198,8 +199,8 @@ subroutine shr_tInterp_getAvgCosz(tavCosz, lon, lat, & integer :: ldt ! local dt as needed integer(i8) :: ldt8 ! local dt as needed in i8 integer(i8) :: dtsec ! delta time from timeint - character(*),parameter :: subName = "(shr_tInterp_getAvgCosz) " - character(*),parameter :: F00 = "('(shr_tInterp_getAvgCosz) ',8a)" + character(len=*),parameter :: subName = "(shr_tInterp_getAvgCosz) " + character(len=*),parameter :: F00 = "('(shr_tInterp_getAvgCosz) ',8a)" !--------------------------------------------------------------- rc = ESMF_SUCCESS @@ -247,7 +248,7 @@ subroutine shr_tInterp_getAvgCosz(tavCosz, lon, lat, & allocate(cosz(lsize)) if (debug>0 .and. isroot) then - write(logunit,'(a,4(i8,2x))') trim(subname)//' calculating time average over interval ymd1,tod1,ymd2,tod2 = ', & + write(logunit,'(a,4(i8,2x))') subname//' calculating time average over interval ymd1,tod1,ymd2,tod2 = ', & ymd1,tod1,ymd2,tod2 end if @@ -289,7 +290,7 @@ subroutine shr_tInterp_getCosz(cosz, lon, lat, ymd, tod, & real(r8) , intent(in) :: mvelpp ! orb param real(r8) , intent(in) :: lambm0 ! orb param real(r8) , intent(in) :: obliqr ! orb param - character(*) , intent(in) :: calendar ! calendar type + character(len=*) , intent(in) :: calendar ! calendar type logical , intent(in) :: isroot integer , intent(in) :: logunit @@ -300,7 +301,7 @@ subroutine shr_tInterp_getCosz(cosz, lon, lat, ymd, tod, & real(r8) :: calday ! julian days real(r8) :: declin,eccf ! orb params real(r8) ,parameter :: solZenMin = 0.001_r8 ! min solar zenith angle - character(*) ,parameter :: subName = "(shr_tInterp_getCosz) " + character(len=*) ,parameter :: subName = "(shr_tInterp_getCosz) " !--------------------------------------------------------------- lsize = size(lon) @@ -312,9 +313,9 @@ subroutine shr_tInterp_getCosz(cosz, lon, lat, ymd, tod, & call shr_cal_date2julian(ymd, tod, calday, calendar) call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr, declin, eccf ) if (debug > 0 .and. isroot) then - write(logunit,'(a,2(i8,2x),d20.10,2x,a)') trim(subname)//' ymd, tod, calday, calendar = ',ymd,tod,calday,calendar - write(logunit,'(a,4(d20.10,2x))') trim(subname)//' eccen, mvelpp, lambm0, obliqr = ',eccen, mvelpp, lambm0, obliqr - write(logunit,'(a,2(d20.10,2x))') trim(subname)//' declin,eccf= ',declin,eccf + write(logunit,'(a,2(i8,2x),d20.10,2x,a)') subname//' ymd, tod, calday, calendar = ',ymd,tod,calday,calendar + write(logunit,'(a,4(d20.10,2x))') subname//' eccen, mvelpp, lambm0, obliqr = ',eccen, mvelpp, lambm0, obliqr + write(logunit,'(a,2(d20.10,2x))') subname//' declin,eccf= ',declin,eccf end if do n = 1,lsize lonr = lon(n) * deg2rad