diff --git a/cime_config/stream_cdeps.py b/cime_config/stream_cdeps.py index 17fbf6c1..f80586e8 100644 --- a/cime_config/stream_cdeps.py +++ b/cime_config/stream_cdeps.py @@ -716,11 +716,11 @@ def _sub_paths( date_string = (year_format + "-{:02d}-{:02d}").format( adjusted_year, adjusted_month, adjusted_day ) - new_file = line.replace(match.group(0), date_string) - if os.path.exists(new_file): - new_lines.append(new_file) + new_line = line.replace(match.group(0), date_string) + if os.path.exists(new_line): + new_lines.append(new_line) else: - print(f" WARNING:not adding missing file {new_file}") + print(f" WARNING:not adding missing file {new_line}") elif match.group("month"): for month in range(1, 13): date_string = (year_format + "-{:02d}").format(year, month) diff --git a/datm/CMakeLists.txt b/datm/CMakeLists.txt index 892bed23..8225f5c1 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 ff96448f..225b2ae4 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -68,6 +68,22 @@ 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 @@ -139,9 +155,9 @@ module cdeps_datm_comp logical :: diagnose_data = .true. integer , parameter :: main_task = 0 ! task number of main task #ifdef CESMCOUPLED - character(*) , parameter :: modName = "(atm_comp_nuopc)" + character(*) , parameter :: modName = "(atm_comp_nuopc)" #else - character(*) , parameter :: modName = "(cdeps_datm_comp)" + character(*) , parameter :: modName = "(cdeps_datm_comp)" #endif character(*), parameter :: u_FILE_u = & @@ -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 @@ -212,10 +228,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: bcasttmp(10) 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)" + character(len=*),parameter :: subname = modName // ':(InitializeAdvertise) ' + character(*) ,parameter :: F00 = "('(" // modName // ") ',8a)" + character(*) ,parameter :: F01 = "('(" // modName // ") ',a,2x,i8)" + character(*) ,parameter :: F02 = "('(" // modName // ") ',a,l6)" !------------------------------------------------------------------------------- namelist / datm_nml / & @@ -370,23 +386,33 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return endif - ! 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 +455,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 +555,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 @@ -603,7 +629,7 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod ! local variables logical :: first_time = .true. - character(len=CL) :: rpfile + character(len=CL) :: rpfile character(*), parameter :: subName = '(datm_comp_run) ' !------------------------------------------------------------------------------- @@ -616,11 +642,35 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod !-------------------- if (first_time) 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 dfields call datm_init_dfields(rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! 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) @@ -650,7 +700,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 @@ -676,6 +729,24 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TraceRegionExit('datm_strdata_advance') + ! 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 + ! 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') @@ -718,9 +789,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) @@ -754,13 +828,10 @@ subroutine datm_init_dfields(rc) 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 + integer :: n + integer :: rank + integer :: fieldcount + type(ESMF_Field) :: lfield character(ESMF_MAXSTR) ,pointer :: lfieldnames(:) character(*), parameter :: subName = "(datm_init_dfields) " !------------------------------------------------------------------------------- @@ -773,63 +844,18 @@ subroutine datm_init_dfields(rc) 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_LogWrite(subname//': field name = '//trim(lfieldnames(n)), ESMF_LOGMSG_INFO) call ESMF_StateGet(exportState, itemName=trim(lfieldnames(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, rank=rank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (rank == 1) then + ! Currently rank==2 fields are handled in datm_pres_aero_mod.F90, datm_pres_co2_mod.F90 + ! and datm_pres_ndep_mod.F90 + ! The rank one Sa_o3 field is handled in datm_pres_o3_mod.F90 + if (rank == 1 .and. trim(lfieldnames(n)) /= 'Sa_o3') then call dshr_dfield_add( dfields, sdat, trim(lfieldnames(n)), trim(lfieldnames(n)), & exportState, logunit, mainproc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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 diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index c3b5269e..35bf01b6 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 8ca888bb..146a20d0 100644 --- a/datm/cime_config/namelist_definition_datm.xml +++ b/datm/cime_config/namelist_definition_datm.xml @@ -1,7 +1,5 @@ - - diff --git a/datm/cime_config/stream_definition_datm.xml b/datm/cime_config/stream_definition_datm.xml index 8f838aa2..5ec085c1 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 e0da7928..0001a90b 100644 --- a/datm/datm_datamode_clmncep_mod.F90 +++ b/datm/datm_datamode_clmncep_mod.F90 @@ -14,11 +14,12 @@ module datm_datamode_clmncep_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add 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 @@ -28,12 +29,9 @@ module datm_datamode_clmncep_mod 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() @@ -44,7 +42,6 @@ module datm_datamode_clmncep_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_z(:) => null() @@ -62,14 +59,6 @@ module datm_datamode_clmncep_mod 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() @@ -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)) @@ -226,20 +185,6 @@ subroutine datm_datamode_clmncep_init_pointers(importState, exportState, sdat, r 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) @@ -303,23 +248,9 @@ subroutine datm_datamode_clmncep_init_pointers(importState, exportState, sdat, r 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 - - call ESMF_StateGet(exportstate, 'Sa_o3', itemFlag, 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) + call shr_log_error(subname//' ERROR: wind and tbot must be in streams for CLMNCEP', rc=rc) return endif @@ -379,7 +310,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,7 +325,7 @@ 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 @@ -402,7 +333,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 tdewmax = rtmp(2) - if (mainproc) write(logunit,*) trim(subname),' tdewmax = ',tdewmax + if (mainproc) write(logunit,*) subname,' tdewmax = ',tdewmax endif ! reset first_time @@ -446,12 +377,6 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) e = strm_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) @@ -584,11 +509,6 @@ subroutine datm_datamode_clmncep_advance(mainproc, logunit, mpicom, rc) 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 b874dcf9..67e0b392 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 @@ -55,7 +55,6 @@ 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() @@ -82,25 +81,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 +127,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,7 +154,6 @@ 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): ' !------------------------------------------------------------------------------- @@ -254,21 +226,14 @@ subroutine datm_datamode_core2_init_pointers(exportState, sdat, datamode, factor 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 - 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_log_error(subname//'ERROR: prec and swdn must be in streams for CORE2', 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) + call shr_log_error(subname//'tarcf must be in an input stream for CORE2_IAF', rc=rc) return endif endif @@ -400,11 +365,6 @@ subroutine datm_datamode_core2_advance(datamode, target_ymd, target_tod, target_ 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 +372,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 +398,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 a260182e..de46522d 100644 --- a/datm/datm_datamode_cplhist_mod.F90 +++ b/datm/datm_datamode_cplhist_mod.F90 @@ -11,7 +11,7 @@ module datm_datamode_cplhist_mod 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 @@ -24,8 +24,6 @@ module datm_datamode_cplhist_mod 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() @@ -38,27 +36,20 @@ module datm_datamode_cplhist_mod 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 = & + character(len=*), parameter :: nullstr = '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 @@ -87,29 +78,8 @@ subroutine datm_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_ 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_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 +101,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): ' !------------------------------------------------------------------------------- @@ -172,18 +141,9 @@ 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) - 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) - 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 !=============================================================================== @@ -201,11 +161,6 @@ 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 - end subroutine datm_datamode_cplhist_advance end module datm_datamode_cplhist_mod diff --git a/datm/datm_datamode_era5_mod.F90 b/datm/datm_datamode_era5_mod.F90 index dad08baf..d962152d 100644 --- a/datm/datm_datamode_era5_mod.F90 +++ b/datm/datm_datamode_era5_mod.F90 @@ -11,11 +11,12 @@ module datm_datamode_era5_mod 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,8 +45,6 @@ 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() @@ -57,8 +56,8 @@ 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__ !=============================================================================== @@ -189,7 +188,7 @@ subroutine datm_datamode_era5_init_pointers(exportState, sdat, rc) end subroutine datm_datamode_era5_init_pointers - !=============================================================================== + !=============================================================================== subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, target_ymd, target_tod, model_calendar, rc) use ESMF, only: ESMF_VMGetCurrent, ESMF_VMAllReduce, ESMF_REDUCE_MAX, ESMF_VM @@ -225,7 +224,7 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta 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) @@ -233,7 +232,7 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta 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. @@ -312,7 +311,7 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta 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 80d5716d..54a32309 100644 --- a/datm/datm_datamode_gefs_mod.F90 +++ b/datm/datm_datamode_gefs_mod.F90 @@ -11,7 +11,7 @@ module datm_datamode_gefs_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: datm_datamode_gefs_advertise public :: datm_datamode_gefs_init_pointers @@ -47,8 +47,8 @@ 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 = & + character(len=*), parameter :: nullstr = 'undefined' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -193,14 +193,14 @@ 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. diff --git a/datm/datm_datamode_jra_mod.F90 b/datm/datm_datamode_jra_mod.F90 index 13ef64eb..d0bcf2e8 100644 --- a/datm/datm_datamode_jra_mod.F90 +++ b/datm/datm_datamode_jra_mod.F90 @@ -14,7 +14,7 @@ module datm_datamode_jra_mod 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,7 +41,6 @@ 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() @@ -57,25 +56,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 +102,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) @@ -153,7 +126,6 @@ subroutine datm_datamode_jra_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): ' !------------------------------------------------------------------------------- @@ -217,16 +189,9 @@ subroutine datm_datamode_jra_init_pointers(exportState, sdat, rc) 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) - 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) + call shr_log_error(subname//'ERROR: prec and swdn must be in streams for CORE_IAF_JRA', rc=rc) return endif @@ -293,11 +258,6 @@ subroutine datm_datamode_jra_advance(exportstate, target_ymd, target_tod, model_ Faxa_swnet(n) = strm_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 e9db9111..b754b620 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__ !=============================================================================== @@ -191,7 +190,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 +249,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 +310,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 +323,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 00000000..dc3401c2 --- /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 00000000..0a792a22 --- /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 00000000..2b1548e1 --- /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 00000000..d6cfa3c0 --- /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 2de7f714..d860e6d8 100644 --- a/dglc/cime_config/namelist_definition_dglc.xml +++ b/dglc/cime_config/namelist_definition_dglc.xml @@ -1,7 +1,5 @@ - - + + + + + + + + + diff --git a/dice/cime_config/namelist_definition_dice.xml b/dice/cime_config/namelist_definition_dice.xml index 64f68881..ebb4683f 100644 --- a/dice/cime_config/namelist_definition_dice.xml +++ b/dice/cime_config/namelist_definition_dice.xml @@ -1,7 +1,5 @@ - - diff --git a/docn/cime_config/stream_definition_docn.xml b/docn/cime_config/stream_definition_docn.xml index ea873875..fc20d8b3 100644 --- a/docn/cime_config/stream_definition_docn.xml +++ b/docn/cime_config/stream_definition_docn.xml @@ -1,7 +1,5 @@ - - diff --git a/drof/cime_config/namelist_definition_drof.xml b/drof/cime_config/namelist_definition_drof.xml index 694c9c40..56f8646c 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 d43883ec..b9f7ddab 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/rof_comp_nuopc.F90 b/drof/rof_comp_nuopc.F90 index 1a1cc666..4b5852c8 100644 --- a/drof/rof_comp_nuopc.F90 +++ b/drof/rof_comp_nuopc.F90 @@ -4,7 +4,6 @@ module rof_comp_nuopc module cdeps_drof_comp #endif - !---------------------------------------------------------------------------- ! This is the NUOPC cap for DROF !---------------------------------------------------------------------------- @@ -29,8 +28,8 @@ module cdeps_drof_comp 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_strdata_mod , only : shr_strdata_type, shr_strdata_advance + use dshr_strdata_mod , only : shr_strdata_init_from_config, shr_strdata_get_stream_pointer use dshr_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 @@ -95,10 +94,14 @@ module cdeps_drof_comp real(r8), pointer :: model_frac(:) => null() integer , pointer :: model_mask(:) => null() - ! module pointer arrays + ! export state pointer arrays real(r8), pointer :: Forr_rofl(:) => null() real(r8), pointer :: Forr_rofi(:) => null() + ! stream pointer arrays + real(r8), pointer :: strm_Forr_rofl(:) => null() ! always required + real(r8), pointer :: strm_Forr_rofi(:) => null() ! sometimes present in stream + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -413,6 +416,16 @@ subroutine drof_comp_run(gcomp, exportState, target_ymd, target_tod, restart_wri call dshr_state_getfldptr(exportState, 'Forr_rofi' , fldptr1=Forr_rofi , rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Initialize module pointers + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofl', strm_Forr_rofl, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: strm_Forr_rofl must be associated for drof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Forr_rofi', strm_Forr_rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. associated(strm_Forr_rofi)) then + Forr_rofi(:) = 0._r8 + end if + ! Read restart if needed if (restart_read .and. .not. skip_restart_read) then call shr_get_rpointer_name(gcomp, 'rof', target_ymd, target_tod, rpfile, 'read', rc) diff --git a/dshr/dshr_dfield_mod.F90 b/dshr/dshr_dfield_mod.F90 index eba63087..b10ca316 100644 --- a/dshr/dshr_dfield_mod.F90 +++ b/dshr/dshr_dfield_mod.F90 @@ -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)') trim(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)') trim(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)') trim(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)') trim(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)') trim(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)') trim(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)') trim(subname),' setting pointer for export state ',trim(state_fld) end if state_ptr => dfield_new%state_data2d diff --git a/dwav/cime_config/namelist_definition_dwav.xml b/dwav/cime_config/namelist_definition_dwav.xml index 16517984..9cfbd3d9 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 9bd1ecaa..46d1b4fe 100644 --- a/dwav/cime_config/stream_definition_dwav.xml +++ b/dwav/cime_config/stream_definition_dwav.xml @@ -1,7 +1,5 @@ - - diff --git a/streams/dshr_methods_mod.F90 b/streams/dshr_methods_mod.F90 index 59500d11..0da81255 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 @@ -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(trim(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(trim(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 !=============================================================================== diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 5c1ba395..94109d45 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 0b502616..ba81d4f6 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