From a717ad64781571833a0f60275f4b3aa49a046479 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 18 Dec 2025 11:12:38 +0100 Subject: [PATCH 01/44] bugfix for handling unstructured input data with multiple levels --- streams/dshr_strdata_mod.F90 | 58 ++++++++++++++++++++++++++++-------- 1 file changed, 45 insertions(+), 13 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 5c1ba395c..219038a0f 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -2017,7 +2017,35 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) if (stream_nlev > 1) then allocate(compdof3d(stream_nlev*lsize)) ! Assume that first 2 dimensions correspond to the compdof - gsize2d = dimlens(1)*dimlens(2) + if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then + if (ndims == 3) then + ! second dimension is lev and third dimension is time + gsize2d = dimlens(1) + else if (ndims == 4) then + ! third dimension is lev and fourth dimension is time + gsize2d = dimlens(1)*dimlens(2) + else + write(6,*)'ERROR: dimlens= ',dimlens + call shr_log_error(trim(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 + write(6,*)'ERROR: dimlens= ',dimlens + call shr_log_error(trim(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) @@ -2036,7 +2064,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) 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 ' + ' with dimlens(1) = ',dimlens(1),& + ' and the variable has a time dimension '//trim(dimname) end if call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1)/), compdof, & per_stream%stream_pio_iodesc) @@ -2044,7 +2073,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) 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 ' + ' and the variable has no time dimension ' end if call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof, & per_stream%stream_pio_iodesc) @@ -2052,20 +2081,23 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) 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 (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) + ' and the variable has a time dimension '//trim(dimname) end if call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof, & per_stream%stream_pio_iodesc) + else + if (sdat%mainproc) 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), & + ' and the variable has no time dimension ' + end if + call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2),dimlens(3)/), compdof3d, & + per_stream%stream_pio_iodesc) + end if else if (ndims == 4) then @@ -2074,13 +2106,13 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) 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 ' + ' and the variable has a time dimension '//trim(dimname) 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(trim(subname)//' dimlens = 4 assumes a time dimension and vertical levels', rc=rc) return end if From ab0c659611b72c46044800d04de9b7c0ace72fb7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 19 Dec 2025 17:25:34 +0100 Subject: [PATCH 02/44] addition of new optional streams for ndep, aero, co2 and o3 --- datm/atm_comp_nuopc.F90 | 135 +++++++------ datm/cime_config/stream_definition_datm.xml | 79 ++++++++ datm/datm_datamode_clmncep_mod.F90 | 69 +------ datm/datm_datamode_core2_mod.F90 | 41 +--- datm/datm_datamode_cplhist_mod.F90 | 42 +--- datm/datm_datamode_era5_mod.F90 | 6 +- datm/datm_datamode_jra_mod.F90 | 41 +--- datm/datm_datamode_simple_mod.F90 | 17 +- datm/datm_pres_aero_mod.F90 | 204 ++++++++++++++++++++ datm/datm_pres_co2_mod.F90 | 109 +++++++++++ datm/datm_pres_ndep_mod.F90 | 113 +++++++++++ datm/datm_pres_o3_mod.F90 | 78 ++++++++ 12 files changed, 664 insertions(+), 270 deletions(-) create mode 100644 datm/datm_pres_aero_mod.F90 create mode 100644 datm/datm_pres_co2_mod.F90 create mode 100644 datm/datm_pres_ndep_mod.F90 create mode 100644 datm/datm_pres_o3_mod.F90 diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index ff96448fb..6f698fa71 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 @@ -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 not 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) @@ -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 @@ -718,9 +771,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) @@ -783,53 +839,8 @@ subroutine datm_init_dfields(rc) 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 + call shr_log_error(subName//'rank == 2 pointers no longer supported in datm_init_dfields') + return end if end do end subroutine datm_init_dfields diff --git a/datm/cime_config/stream_definition_datm.xml b/datm/cime_config/stream_definition_datm.xml index 8f838aa20..6ddd48343 100644 --- a/datm/cime_config/stream_definition_datm.xml +++ b/datm/cime_config/stream_definition_datm.xml @@ -190,9 +190,11 @@ optional stream nitrogen deposition - DATM_NDEP is set by the 4 character time prefix in config_component.xml ======================== + presndep.clim_1850_cmip7 presndep.clim_1850 presndep.clim_2000 presndep.clim_2010 + presndep.hist_cmip7 presndep.hist presndep.SSP1-2.6 presndep.SSP2-4.5 @@ -4861,6 +4863,76 @@ + + + $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.nc + + + + drynhx Faxandep_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.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 +4941,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 @@ -4901,6 +4974,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 @@ -4965,6 +5039,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 +5072,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 +5105,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 +5138,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 +5172,7 @@ $DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc + NDEP_NHx_month Faxa_ndep_nhx NDEP_NOy_month Faxa_ndep_noy diff --git a/datm/datm_datamode_clmncep_mod.F90 b/datm/datm_datamode_clmncep_mod.F90 index e0da79283..51b5a2870 100644 --- a/datm/datm_datamode_clmncep_mod.F90 +++ b/datm/datm_datamode_clmncep_mod.F90 @@ -28,12 +28,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 +41,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 +58,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,7 +88,6 @@ 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 = & __FILE__ @@ -109,17 +96,11 @@ module datm_datamode_clmncep_mod 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 +132,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)) @@ -303,20 +261,6 @@ 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) @@ -446,12 +390,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 +522,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 b874dcf98..34131a467 100644 --- a/datm/datm_datamode_core2_mod.F90 +++ b/datm/datm_datamode_core2_mod.F90 @@ -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() @@ -90,17 +89,12 @@ module datm_datamode_core2_mod 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) @@ -254,13 +227,6 @@ 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) return @@ -400,11 +366,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 !=============================================================================== diff --git a/datm/datm_datamode_cplhist_mod.F90 b/datm/datm_datamode_cplhist_mod.F90 index a260182e9..cc5999d77 100644 --- a/datm/datm_datamode_cplhist_mod.F90 +++ b/datm/datm_datamode_cplhist_mod.F90 @@ -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() @@ -39,7 +37,6 @@ module datm_datamode_cplhist_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() character(*), parameter :: nullstr = 'null' character(*), parameter :: u_FILE_u = & @@ -49,16 +46,11 @@ module datm_datamode_cplhist_mod 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 @@ -90,26 +82,6 @@ subroutine datm_datamode_cplhist_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_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)) @@ -177,13 +149,6 @@ subroutine datm_datamode_cplhist_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 - end subroutine datm_datamode_cplhist_init_pointers !=============================================================================== @@ -201,11 +166,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 dad08baf9..a03f28f6a 100644 --- a/datm/datm_datamode_era5_mod.F90 +++ b/datm/datm_datamode_era5_mod.F90 @@ -44,8 +44,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() @@ -189,7 +187,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 @@ -312,7 +310,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_jra_mod.F90 b/datm/datm_datamode_jra_mod.F90 index 13ef64ebf..f3aa011b3 100644 --- a/datm/datm_datamode_jra_mod.F90 +++ b/datm/datm_datamode_jra_mod.F90 @@ -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() @@ -65,17 +64,12 @@ module datm_datamode_jra_mod 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) @@ -217,13 +190,6 @@ 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) @@ -293,11 +259,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 e9db91118..f253e7ba1 100644 --- a/datm/datm_datamode_simple_mod.F90 +++ b/datm/datm_datamode_simple_mod.F90 @@ -25,7 +25,7 @@ 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 @@ -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 @@ -251,13 +250,6 @@ subroutine datm_datamode_simple_init_pointers(exportState, sdat, rc) call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(exportstate, 'Faxa_ndep', itemFlag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end subroutine datm_datamode_simple_init_pointers !=============================================================================== @@ -319,7 +311,7 @@ subroutine datm_datamode_simple_advance(target_ymd, target_tod, target_mon, & ! long wave solar_decl = (epsilon_deg * degtorad) * sin( 2.0_R8 * shr_const_pi * (int(rday) + 284.0_R8) / 365.0_R8) zenith_angle = acos(sin(yc(n) * degtorad ) * sin(solar_decl) + cos(yc(n) * degtorad) * cos(solar_decl) ) - Faxa_lwdn(n) = max(0.0_R8, peak_lwdn * cos(zenith_angle)) + Faxa_lwdn(n) = max(0.0_R8, peak_lwdn * cos(zenith_angle)) ! short wave hour_angle = (15.0_R8 * (target_tod/3600.0_R8 - 12.0_R8) + xc(n) ) * degtorad @@ -332,11 +324,6 @@ subroutine datm_datamode_simple_advance(target_ymd, target_tod, target_mon, & enddo ! lsize - if (associated(Faxa_ndep)) then - ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) - Faxa_ndep(:,:) = Faxa_ndep(:,:) / 1000._r8 - end if - end subroutine datm_datamode_simple_advance end module datm_datamode_simple_mod diff --git a/datm/datm_pres_aero_mod.F90 b/datm/datm_pres_aero_mod.F90 new file mode 100644 index 000000000..a420af37f --- /dev/null +++ b/datm/datm_pres_aero_mod.F90 @@ -0,0 +1,204 @@ +module datm_pres_aero_mod + + use ESMF , only : ESMF_SUCCESS, ESMF_State + 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 ! except + + 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_bcphidry(:) => null() + real(r8), pointer :: strm_bcphodry(:) => null() + real(r8), pointer :: strm_bcphiwet(:) => null() + + real(r8), pointer :: strm_ocphidry(:) => null() + real(r8), pointer :: strm_ocphodry(:) => null() + real(r8), pointer :: strm_ocphiwet(:) => null() + + real(r8), pointer :: strm_dstwet1(:) => null() + real(r8), pointer :: strm_dstwet2(:) => null() + real(r8), pointer :: strm_dstwet3(:) => null() + real(r8), pointer :: strm_dstwet4(:) => null() + + real(r8), pointer :: strm_dstdry1(:) => null() + real(r8), pointer :: strm_dstdry2(:) => null() + real(r8), pointer :: strm_dstdry3(:) => null() + real(r8), pointer :: strm_dstdry4(:) => null() + + character(*), 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_bcphidry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphodry' , strm_bcphodry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphiwet' , strm_bcphiwet, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphidry' , strm_ocphidry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphodry' , strm_ocphodry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphiwet' , strm_ocphiwet, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry1' , strm_dstdry1 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry2' , strm_dstdry2 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry3' , strm_dstdry3 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry4' , strm_dstdry4 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet1' , strm_dstwet1 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet2' , strm_dstwet2 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet3' , strm_dstwet3 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet4' , strm_dstwet4 , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! error check for stream pointers + if (.not. associated(strm_bcphidry)) then + call shr_log_error(trim(subname)//'ERROR: strm_bcphidry must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_bcphodry)) then + call shr_log_error(trim(subname)//'ERROR: strm_bcphodry must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_bcphiwet)) then + call shr_log_error(trim(subname)//'ERROR: strm_bcphiwet must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_ocphidry)) then + call shr_log_error(trim(subname)//'ERROR: strm_ocphidry must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_ocphodry)) then + call shr_log_error(trim(subname)//'ERROR: strm_ocphodry must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_ocphiwet)) then + call shr_log_error(trim(subname)//'ERROR: strm_ocphiwet must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstdry1)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstdry1 must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstdry2)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstdry2 must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstdry3)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstdry3 must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstdry4)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstdry4 must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstwet1)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstwet1 must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstwet2)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstwet2 must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstwet3)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstwet3 must be associated if flds_presaero is .true.') + return + end if + if (.not. associated(strm_dstwet4)) then + call shr_log_error(trim(subname)//'ERROR: strm_dstwet4 must be associated if flds_presaero is .true.') + return + end if + + 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_bcphidry(:) + Faxa_bcph(2,:) = strm_bcphodry(:) + Faxa_bcph(3,:) = strm_bcphiwet(:) + + Faxa_ocph(1,:) = strm_ocphidry(:) + Faxa_ocph(2,:) = strm_ocphodry(:) + Faxa_ocph(3,:) = strm_ocphiwet(:) + + Faxa_dstdry(1,:) = strm_dstdry1(:) + Faxa_dstdry(2,:) = strm_dstdry2(:) + Faxa_dstdry(3,:) = strm_dstdry3(:) + Faxa_dstdry(4,:) = strm_dstdry4(:) + + Faxa_dstwet(1,:) = strm_dstwet1(:) + Faxa_dstwet(2,:) = strm_dstwet2(:) + Faxa_dstwet(3,:) = strm_dstwet3(:) + Faxa_dstwet(4,:) = strm_dstwet4(:) + + end subroutine datm_pres_aero_advance + +end module datm_pres_aero_mod diff --git a/datm/datm_pres_co2_mod.F90 b/datm/datm_pres_co2_mod.F90 new file mode 100644 index 000000000..caa5301d2 --- /dev/null +++ b/datm/datm_pres_co2_mod.F90 @@ -0,0 +1,109 @@ +module datm_pres_co2_mod + + use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateItem_Flag + use ESMF , only : ESMF_STATEITEM_NOTFOUND + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl + 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 ! except + + 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(*), 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 + if (.not. associated(Sa_co2diag)) then + call shr_log_error(trim(subname)//'ERROR: Sa_co2diag must be associated if flds_co2 is .true.') + end if + call dshr_state_getfldptr(exportState, 'Sa_co2prog', fldptr1=Sa_co2prog, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. associated(Sa_co2prog)) then + call shr_log_error(trim(subname)//'ERROR: Sa_co2prog must be associated if flds_co2 is .true.') + return + end if + + ! 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 + call shr_strdata_get_stream_pointer(sdat, 'Sa_co2diag', strm_Sa_co2diag, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. associated(strm_Sa_co2diag)) then + call shr_log_error(trim(subname)//'ERROR: strm_Sa_co2diag must be associated if flds_co2 is .true.') + end if + if (datamode == 'CPLHIST') then + call shr_strdata_get_stream_pointer(sdat, 'Sa_co2prog', strm_Sa_co2prog, rc) + if (.not. associated(strm_Sa_co2prog)) then + call shr_log_error(trim(subname)//'ERROR: strm_Sa_co2prog must be associated if flds_co2 is .true.') + return + end if + 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 + ! This is intentional since we don't have any Sa_co2prog - but for now + ! will set Sa_co2prog equal to Sa_co2diag + Sa_co2diag(:) = strm_Sa_co2diag(:) + Sa_co2prog(:) = strm_Sa_co2diag(:) + end if + + end subroutine datm_pres_co2_advance + +end module datm_pres_co2_mod diff --git a/datm/datm_pres_ndep_mod.F90 b/datm/datm_pres_ndep_mod.F90 new file mode 100644 index 000000000..3e0361100 --- /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 ! except + + 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_ndep_nhx_dry(:) => null() ! stream cmip7 ndep data + real(r8), pointer :: strm_ndep_nhx_wet(:) => null() ! stream cmip7 ndep data + real(r8), pointer :: strm_ndep_noy_dry(:) => null() ! stream cmip7 ndep data + real(r8), pointer :: strm_ndep_noy_wet(:) => null() ! stream cmip7 ndep data + + real(r8), pointer :: strm_ndep_nhx(:) => null() ! pre-cmip7 ndep data + real(r8), pointer :: strm_ndep_noy(:) => null() ! pre-cmip7 ndep data + + logical :: use_cmip7_ndep + + character(*), 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 forcing + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_nhx_dry', strm_ndep_nhx_dry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_nhx_wet', strm_ndep_nhx_wet, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_noy_dry', strm_ndep_noy_dry, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_noy_wet', strm_ndep_noy_wet, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! older ndep forcing + call shr_strdata_get_stream_pointer( sdat, 'Faxa_ndep_nhx', strm_ndep_nhx, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer( sdat, 'Faxa_ndep_noy', strm_ndep_noy, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! error checks + if (associated(strm_ndep_nhx_dry) .and. associated(strm_ndep_nhx_wet) .and. & + associated(strm_ndep_noy_dry) .and. associated(strm_ndep_noy_wet)) then + use_cmip7_ndep = .true. + else if (associated(strm_ndep_nhx) .and. associated(strm_ndep_noy)) then + use_cmip7_ndep = .false. + else + call shr_log_error('datm_ndep_advance: ERROR: no associated stream pointers for ndep forcing') + 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_ndep_nhx_dry(:) + strm_ndep_nhx_wet(:) + Faxa_ndep(2,:) = strm_ndep_noy_dry(:) + strm_ndep_noy_wet(:) + else + ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) + Faxa_ndep(1,:) = strm_ndep_nhx(:) / 1000._r8 + Faxa_ndep(2,:) = strm_ndep_noy(:) / 1000._r8 + end if + + end subroutine datm_pres_ndep_advance + +end module datm_pres_ndep_mod diff --git a/datm/datm_pres_o3_mod.F90 b/datm/datm_pres_o3_mod.F90 new file mode 100644 index 000000000..41ced32b9 --- /dev/null +++ b/datm/datm_pres_o3_mod.F90 @@ -0,0 +1,78 @@ +module datm_pres_o3_mod + + use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateItem_Flag + use ESMF , only : ESMF_STATEITEM_NOTFOUND + 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 ! except + + 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(*), 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 - if the + ! following stream fields are not in any sdat streams, then a null value is returned + call shr_strdata_get_stream_pointer(sdat, 'Sa_o3', strm_Sa_o3, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Error checks + if (.not. associated(strm_Sa_o3)) then + call shr_log_error(trim(subname)//'ERROR: strm_Sa_o3 must be associated if flds_pres_o3 is .true.') + return + end if + + 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 From ceea1a506fb876762a7ed26bca008e48beba6890 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 19 Dec 2025 20:58:15 +0100 Subject: [PATCH 03/44] fixed compiler issues --- datm/CMakeLists.txt | 6 +- datm/atm_comp_nuopc.F90 | 43 ++++++--- datm/datm_datamode_clmncep_mod.F90 | 14 --- datm/datm_datamode_core2_mod.F90 | 1 - datm/datm_datamode_cplhist_mod.F90 | 1 - datm/datm_datamode_jra_mod.F90 | 1 - datm/datm_datamode_simple_mod.F90 | 1 - datm/datm_pres_aero_mod.F90 | 140 ++++++++++++++--------------- 8 files changed, 107 insertions(+), 100 deletions(-) diff --git a/datm/CMakeLists.txt b/datm/CMakeLists.txt index 892bed23d..8225f5c1f 100644 --- a/datm/CMakeLists.txt +++ b/datm/CMakeLists.txt @@ -6,7 +6,11 @@ set(SRCFILES atm_comp_nuopc.F90 datm_datamode_jra_mod.F90 datm_datamode_gefs_mod.F90 datm_datamode_era5_mod.F90 - datm_datamode_simple_mod.F90) + datm_datamode_simple_mod.F90 + datm_pres_aero_mod.F90 + datm_pres_co2_mod.F90 + datm_pres_ndep_mod.F90 + datm_pres_o3_mod.F90) foreach(FILE ${SRCFILES}) diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index 6f698fa71..8a702bdaf 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -729,6 +729,30 @@ 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 co2 if appropriate + if (flds_co2) then + call datm_pres_co2_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! update export state o3 if appropriate + if (flds_preso3) then + call datm_pres_o3_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! ungridded dimension output - update export state nitrogen deposition if appropriate + if (flds_presndep) then + call datm_pres_ndep_advance() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! ungridded dimension output - upate prescribed aerosol if appropriate + 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') @@ -810,13 +834,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) " !------------------------------------------------------------------------------- @@ -834,13 +855,13 @@ subroutine datm_init_dfields(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 - call shr_log_error(subName//'rank == 2 pointers no longer supported in datm_init_dfields') - return end if end do end subroutine datm_init_dfields diff --git a/datm/datm_datamode_clmncep_mod.F90 b/datm/datm_datamode_clmncep_mod.F90 index 51b5a2870..4e03255b0 100644 --- a/datm/datm_datamode_clmncep_mod.F90 +++ b/datm/datm_datamode_clmncep_mod.F90 @@ -184,20 +184,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) diff --git a/datm/datm_datamode_core2_mod.F90 b/datm/datm_datamode_core2_mod.F90 index 34131a467..e386605f0 100644 --- a/datm/datm_datamode_core2_mod.F90 +++ b/datm/datm_datamode_core2_mod.F90 @@ -154,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): ' !------------------------------------------------------------------------------- diff --git a/datm/datm_datamode_cplhist_mod.F90 b/datm/datm_datamode_cplhist_mod.F90 index cc5999d77..201fecbfa 100644 --- a/datm/datm_datamode_cplhist_mod.F90 +++ b/datm/datm_datamode_cplhist_mod.F90 @@ -103,7 +103,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): ' !------------------------------------------------------------------------------- diff --git a/datm/datm_datamode_jra_mod.F90 b/datm/datm_datamode_jra_mod.F90 index f3aa011b3..e522e07ba 100644 --- a/datm/datm_datamode_jra_mod.F90 +++ b/datm/datm_datamode_jra_mod.F90 @@ -126,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): ' !------------------------------------------------------------------------------- diff --git a/datm/datm_datamode_simple_mod.F90 b/datm/datm_datamode_simple_mod.F90 index f253e7ba1..da6ca7cd8 100644 --- a/datm/datm_datamode_simple_mod.F90 +++ b/datm/datm_datamode_simple_mod.F90 @@ -190,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): ' !------------------------------------------------------------------------------- diff --git a/datm/datm_pres_aero_mod.F90 b/datm/datm_pres_aero_mod.F90 index a420af37f..2d0eb8d96 100644 --- a/datm/datm_pres_aero_mod.F90 +++ b/datm/datm_pres_aero_mod.F90 @@ -21,23 +21,23 @@ module datm_pres_aero_mod real(r8), pointer :: Faxa_dstdry(:,:) => null() ! pointers to stream data - real(r8), pointer :: strm_bcphidry(:) => null() - real(r8), pointer :: strm_bcphodry(:) => null() - real(r8), pointer :: strm_bcphiwet(:) => null() + 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_ocphidry(:) => null() - real(r8), pointer :: strm_ocphodry(:) => null() - real(r8), pointer :: strm_ocphiwet(:) => 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_dstwet1(:) => null() - real(r8), pointer :: strm_dstwet2(:) => null() - real(r8), pointer :: strm_dstwet3(:) => null() - real(r8), pointer :: strm_dstwet4(:) => 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_dstdry1(:) => null() - real(r8), pointer :: strm_dstdry2(:) => null() - real(r8), pointer :: strm_dstdry3(:) => null() - real(r8), pointer :: strm_dstdry4(:) => 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(*), parameter :: u_FILE_u = & __FILE__ @@ -86,90 +86,90 @@ subroutine datm_pres_aero_init_pointers(exportState, sdat, rc) ! Set module pointers into streams and check that they are associated - call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphidry' , strm_bcphidry, rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphidry' , strm_Faxa_bcphidry, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphodry' , strm_bcphodry, rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphodry' , strm_Faxa_bcphodry, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphiwet' , strm_bcphiwet, rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphiwet' , strm_Faxa_bcphiwet, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphidry' , strm_ocphidry, rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphidry' , strm_Faxa_ocphidry, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphodry' , strm_ocphodry, rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphodry' , strm_Faxa_ocphodry, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphiwet' , strm_ocphiwet, rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphiwet' , strm_Faxa_ocphiwet, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry1' , strm_dstdry1 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry1' , strm_Faxa_dstdry1 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry2' , strm_dstdry2 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry2' , strm_Faxa_dstdry2 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry3' , strm_dstdry3 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry3' , strm_Faxa_dstdry3 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry4' , strm_dstdry4 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry4' , strm_Faxa_dstdry4 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet1' , strm_dstwet1 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet1' , strm_Faxa_dstwet1 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet2' , strm_dstwet2 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet2' , strm_Faxa_dstwet2 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet3' , strm_dstwet3 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet3' , strm_Faxa_dstwet3 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet4' , strm_dstwet4 , rc) + call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet4' , strm_Faxa_dstwet4 , rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! error check for stream pointers - if (.not. associated(strm_bcphidry)) then - call shr_log_error(trim(subname)//'ERROR: strm_bcphidry must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_bcphidry)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_bcphidry must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_bcphodry)) then - call shr_log_error(trim(subname)//'ERROR: strm_bcphodry must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_bcphodry)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_bcphodry must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_bcphiwet)) then - call shr_log_error(trim(subname)//'ERROR: strm_bcphiwet must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_bcphiwet)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_bcphiwet must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_ocphidry)) then - call shr_log_error(trim(subname)//'ERROR: strm_ocphidry must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_ocphidry)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_ocphidry must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_ocphodry)) then - call shr_log_error(trim(subname)//'ERROR: strm_ocphodry must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_ocphodry)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_ocphodry must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_ocphiwet)) then - call shr_log_error(trim(subname)//'ERROR: strm_ocphiwet must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_ocphiwet)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_ocphiwet must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstdry1)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstdry1 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstdry1)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry1 must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstdry2)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstdry2 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstdry2)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry2 must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstdry3)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstdry3 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstdry3)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry3 must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstdry4)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstdry4 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstdry4)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry4 must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstwet1)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstwet1 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstwet1)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet1 must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstwet2)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstwet2 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstwet2)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet2 must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstwet3)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstwet3 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstwet3)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet3 must be associated if flds_presaero is .true.') return end if - if (.not. associated(strm_dstwet4)) then - call shr_log_error(trim(subname)//'ERROR: strm_dstwet4 must be associated if flds_presaero is .true.') + if (.not. associated(strm_Faxa_dstwet4)) then + call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet4 must be associated if flds_presaero is .true.') return end if @@ -181,23 +181,23 @@ subroutine datm_pres_aero_advance() ! The following maps stream input fields to export fields that ! have an ungridded dimension - Faxa_bcph(1,:) = strm_bcphidry(:) - Faxa_bcph(2,:) = strm_bcphodry(:) - Faxa_bcph(3,:) = strm_bcphiwet(:) + Faxa_bcph(1,:) = strm_Faxa_bcphidry(:) + Faxa_bcph(2,:) = strm_Faxa_bcphodry(:) + Faxa_bcph(3,:) = strm_Faxa_bcphiwet(:) - Faxa_ocph(1,:) = strm_ocphidry(:) - Faxa_ocph(2,:) = strm_ocphodry(:) - Faxa_ocph(3,:) = strm_ocphiwet(:) + Faxa_ocph(1,:) = strm_Faxa_ocphidry(:) + Faxa_ocph(2,:) = strm_Faxa_ocphodry(:) + Faxa_ocph(3,:) = strm_Faxa_ocphiwet(:) - Faxa_dstdry(1,:) = strm_dstdry1(:) - Faxa_dstdry(2,:) = strm_dstdry2(:) - Faxa_dstdry(3,:) = strm_dstdry3(:) - Faxa_dstdry(4,:) = strm_dstdry4(:) + 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_dstwet1(:) - Faxa_dstwet(2,:) = strm_dstwet2(:) - Faxa_dstwet(3,:) = strm_dstwet3(:) - Faxa_dstwet(4,:) = strm_dstwet4(:) + 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 From 7d93a2ef3243e054e07151b81a67829385bcc82c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 20 Dec 2025 11:20:57 +0100 Subject: [PATCH 04/44] added new streams clim_1850_cmip7 and hist_cmip7 --- datm/cime_config/config_component.xml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index c3b5269e7..33ce68a20 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -102,18 +102,18 @@ 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,clim_1850_cmpi7,clim_2000,clim_2010,hist,hist_cmip7,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 + clim_2000 + clim_2010 + SSP1-2.6 + SSP2-4.5 + SSP3-7.0 + SSP5-8.5 + hist + hist cplhist none From 44b36c06e90fa1e0d5de34be5354edc63f73cac6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 20 Dec 2025 11:45:19 +0100 Subject: [PATCH 05/44] fixed cmip7 ndep configurations --- datm/cime_config/buildnml | 5 +++-- datm/cime_config/stream_definition_datm.xml | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/datm/cime_config/buildnml b/datm/cime_config/buildnml index 3653c81c9..a798614a8 100755 --- a/datm/cime_config/buildnml +++ b/datm/cime_config/buildnml @@ -213,9 +213,10 @@ def _create_namelists(case, confdir, inst_string, infile, nmlgen, data_list_path if clm_usrdat_name == 'NEON.PRISM': streamlist.append(clm_usrdat_name+"_PRECIP."+neonsite) if clm_usrdat_name == 'NEON': - streamlist.append(clm_usrdat_name+".NEON_PRECIP."+neonsite) + streamlist.append(clm_usrdat_name+".NEON_PRECIP."+neonsite) if clm_usrdat_name == 'PLUMBER2': streamlist.append(clm_usrdat_name+"."+plumber2site) + print (f"DEBUG: streamlist is {streamlist}") bias_correct = nmlgen.get_value("bias_correct") if bias_correct is not None: @@ -243,7 +244,7 @@ def _create_drv_flds_in(case, confdir): # for now we are hard-coding this file name and values because we only need it for ozone if datm_preso3 != "none": - + # Generate drv_flds_in file outfile = os.path.join(confdir, "drv_flds_in") ozone_nl_name = "&ozone_coupling_nl" diff --git a/datm/cime_config/stream_definition_datm.xml b/datm/cime_config/stream_definition_datm.xml index 6ddd48343..b709b6b50 100644 --- a/datm/cime_config/stream_definition_datm.xml +++ b/datm/cime_config/stream_definition_datm.xml @@ -4872,7 +4872,7 @@ - drynhx Faxandep_nhx_dry + drynhx Faxa_ndep_nhx_dry wetnhx Faxa_ndep_nhx_wet drynoy Faxa_ndep_noy_dry wetnoy Faxa_ndep_noy_wet From 80cb97b2e2706b8dbd3c674ec793efbb2af0fc4b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 20 Dec 2025 11:49:52 +0100 Subject: [PATCH 06/44] fixed typo for ndep --- datm/cime_config/config_component.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index 33ce68a20..275335fec 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -102,7 +102,7 @@ char - none,clim_1850,clim_1850_cmpi7,clim_2000,clim_2010,hist,hist_cmip7,SSP1-2.6,SSP2-4.5,SSP3-7.0,SSP5-3.4,SSP5-8.5,cplhist + none,clim_1850,clim_1850_cmip7,clim_2000,clim_2010,hist,hist_cmip7,SSP1-2.6,SSP2-4.5,SSP3-7.0,SSP5-3.4,SSP5-8.5,cplhist clim_2000 clim_1850 From 6a9cf9d0e105cf59f820f3b5b2cf5c3968ecb1ab Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 20 Dec 2025 11:57:08 +0100 Subject: [PATCH 07/44] removed DEBUG print statement --- datm/cime_config/buildnml | 1 - 1 file changed, 1 deletion(-) diff --git a/datm/cime_config/buildnml b/datm/cime_config/buildnml index a798614a8..788a9e1fa 100755 --- a/datm/cime_config/buildnml +++ b/datm/cime_config/buildnml @@ -216,7 +216,6 @@ def _create_namelists(case, confdir, inst_string, infile, nmlgen, data_list_path streamlist.append(clm_usrdat_name+".NEON_PRECIP."+neonsite) if clm_usrdat_name == 'PLUMBER2': streamlist.append(clm_usrdat_name+"."+plumber2site) - print (f"DEBUG: streamlist is {streamlist}") bias_correct = nmlgen.get_value("bias_correct") if bias_correct is not None: From bb392dd02edee8a8f67d50de529215869205e918 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 20 Dec 2025 23:10:31 +0100 Subject: [PATCH 08/44] fixed additional problem in creating an iodesc for unstructured data with a vertical dimension --- streams/dshr_strdata_mod.F90 | 105 +++++++++++++++++++++++++---------- 1 file changed, 75 insertions(+), 30 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 219038a0f..7ae00e6e9 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -1975,6 +1975,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) integer, allocatable :: dimlens(:) type(ESMF_DistGrid) :: distGrid integer :: lsize + integer :: logunit + logical :: mainproc integer, pointer :: compdof(:) integer, pointer :: compdof3d(:) integer :: rCode ! pio return code (only used when pio error handling is PIO_BCAST_ERROR) @@ -1991,6 +1993,10 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) nullify(compdof) nullify(compdof3d) + ! set logunit and mainproc + logunit = sdat%stream(1)%logunit + mainproc = sdat%mainproc + ! set the number of vertical levels to a local variable stream_nlev = per_stream%stream_nlev @@ -2059,66 +2065,95 @@ 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 (sdat%mainproc) then - write(sdat%stream(1)%logunit,F03) 'setting iodesc for : '//trim(fldname)// & + if ((trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then + if (mainproc) then + write(logunit,F03) 'setting iodesc for 2d: '//trim(fldname)// & ' with dimlens(1) = ',dimlens(1),& - ' and the variable has a time dimension '//trim(dimname) + ' 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 (mainproc) then + write(logunit,F01) '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),& - ' and the variable has no time dimension ' + if (mainproc) then + write(logunit,F01) '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 (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),& - ' and the variable has a time dimension '//trim(dimname) + if (stream_nlev > 1) then + if (mainproc) then + write(logunit,F01) '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 (mainproc) then + write(logunit,F01) '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 - call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof, & - per_stream%stream_pio_iodesc) else - if (sdat%mainproc) 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), & - ' and the variable has no time dimension ' + if (stream_nlev > 1) then + if (mainproc) then + write(logunit,F01) '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 + write(6,*)'ERROR: dimlens= ',dimlens + call shr_log_error(trim(subname)//' the third dimension of a 3d field must be either time or a vertical level') + return end if - call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2),dimlens(3)/), compdof3d, & - 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)// & + if (mainproc) then + write(logunit,F02) 'setting iodesc for 4d: '//trim(fldname)// & ' with dimlens(1), dimlens(2),dimlens(3) = ',dimlens(1),dimlens(2),dimlens(3),& - ' and the variable has a time dimension '//trim(dimname) + ' 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 and vertical levels', rc=rc) + call shr_log_error(trim(subname)//' dimlens = 4 assumes a time dimension and a vertical dimension') 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(trim(subname)//' only ndims of 2 and 3 and 4 are currently supported') return end if @@ -2144,12 +2179,17 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, rc) ! local variables integer :: ns, nf logical :: found + integer :: logunit + logical :: mainproc character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d)' character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_1d) ',8a)" ! ---------------------------------------------- rc = ESMF_SUCCESS + logunit = sdat%stream(1)%logunit + mainproc = sdat%mainproc + ! 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. @@ -2159,8 +2199,8 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, rc) 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) + if (mainproc) then + write(logunit,F00)' strm_ptr is allocated for stream field strm_'//trim(strm_fld) end if found = .true. exit @@ -2184,12 +2224,17 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, rc) ! local variables integer :: ns, nf logical :: found + integer :: logunit + logical :: mainproc character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d)' character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_2d) ',8a)" ! ---------------------------------------------- rc = ESMF_SUCCESS + logunit = sdat%stream(1)%logunit + mainproc = sdat%mainproc + ! 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. @@ -2199,8 +2244,8 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, rc) 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) + if (mainproc) then + write(logunit,F00)' strm_ptr is allocated for stream field strm_'//trim(strm_fld) end if found = .true. exit From 7467e6c2e52c1998f64a62f23ca2152d46522dc6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 21 Dec 2025 20:08:27 +0100 Subject: [PATCH 09/44] determine if stream pointers are required and preset values if they are --- datm/datm_pres_aero_mod.F90 | 142 ++++++++++++++--------------------- datm/datm_pres_co2_mod.F90 | 28 +++---- datm/datm_pres_ndep_mod.F90 | 4 +- datm/datm_pres_o3_mod.F90 | 16 +--- streams/dshr_methods_mod.F90 | 20 ++++- streams/dshr_strdata_mod.F90 | 125 +++++++++++++++++++++--------- 6 files changed, 178 insertions(+), 157 deletions(-) diff --git a/datm/datm_pres_aero_mod.F90 b/datm/datm_pres_aero_mod.F90 index 2d0eb8d96..151052e39 100644 --- a/datm/datm_pres_aero_mod.F90 +++ b/datm/datm_pres_aero_mod.F90 @@ -2,7 +2,6 @@ module datm_pres_aero_mod use ESMF , only : ESMF_SUCCESS, ESMF_State 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 @@ -86,92 +85,61 @@ subroutine datm_pres_aero_init_pointers(exportState, sdat, rc) ! Set module pointers into streams and check that they are associated - call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphidry' , strm_Faxa_bcphidry, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphodry' , strm_Faxa_bcphodry, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphiwet' , strm_Faxa_bcphiwet, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphidry' , strm_Faxa_ocphidry, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphodry' , strm_Faxa_ocphodry, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_ocphiwet' , strm_Faxa_ocphiwet, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry1' , strm_Faxa_dstdry1 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry2' , strm_Faxa_dstdry2 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry3' , strm_Faxa_dstdry3 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstdry4' , strm_Faxa_dstdry4 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet1' , strm_Faxa_dstwet1 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet2' , strm_Faxa_dstwet2 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet3' , strm_Faxa_dstwet3 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_strdata_get_stream_pointer(sdat, 'Faxa_dstwet4' , strm_Faxa_dstwet4 , rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! error check for stream pointers - if (.not. associated(strm_Faxa_bcphidry)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_bcphidry must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_bcphodry)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_bcphodry must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_bcphiwet)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_bcphiwet must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_ocphidry)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_ocphidry must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_ocphodry)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_ocphodry must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_ocphiwet)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_ocphiwet must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstdry1)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry1 must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstdry2)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry2 must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstdry3)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry3 must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstdry4)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstdry4 must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstwet1)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet1 must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstwet2)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet2 must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstwet3)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet3 must be associated if flds_presaero is .true.') - return - end if - if (.not. associated(strm_Faxa_dstwet4)) then - call shr_log_error(trim(subname)//'ERROR: strm_Faxa_dstwet4 must be associated if flds_presaero is .true.') - return - end if + call shr_strdata_get_stream_pointer(sdat, 'Faxa_bcphidry' , strm_Faxa_bcphidry, requirePointer=.true., & + errmsg=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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=trim(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 diff --git a/datm/datm_pres_co2_mod.F90 b/datm/datm_pres_co2_mod.F90 index caa5301d2..1234512c1 100644 --- a/datm/datm_pres_co2_mod.F90 +++ b/datm/datm_pres_co2_mod.F90 @@ -1,9 +1,7 @@ module datm_pres_co2_mod - use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateItem_Flag - use ESMF , only : ESMF_STATEITEM_NOTFOUND + use ESMF , only : ESMF_SUCCESS, ESMF_State use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl - 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 @@ -64,29 +62,21 @@ subroutine datm_pres_co2_init_pointers(exportState, sdat, rc) ! 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 - if (.not. associated(Sa_co2diag)) then - call shr_log_error(trim(subname)//'ERROR: Sa_co2diag must be associated if flds_co2 is .true.') - end if + call dshr_state_getfldptr(exportState, 'Sa_co2prog', fldptr1=Sa_co2prog, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. associated(Sa_co2prog)) then - call shr_log_error(trim(subname)//'ERROR: Sa_co2prog must be associated if flds_co2 is .true.') - return - end if ! 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 - call shr_strdata_get_stream_pointer(sdat, 'Sa_co2diag', strm_Sa_co2diag, rc) + call shr_strdata_get_stream_pointer(sdat, 'Sa_co2diag', strm_Sa_co2diag, requirePointer=.true., & + errmsg=trim(subname)//'strm_Sa_co2diag must be associated if flds_co2 is .true.', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. associated(strm_Sa_co2diag)) then - call shr_log_error(trim(subname)//'ERROR: strm_Sa_co2diag must be associated if flds_co2 is .true.') - end if + if (datamode == 'CPLHIST') then - call shr_strdata_get_stream_pointer(sdat, 'Sa_co2prog', strm_Sa_co2prog, rc) - if (.not. associated(strm_Sa_co2prog)) then - call shr_log_error(trim(subname)//'ERROR: strm_Sa_co2prog must be associated if flds_co2 is .true.') - return - end if + call shr_strdata_get_stream_pointer(sdat, 'Sa_co2prog', strm_Sa_co2prog, requirePointer=.true., & + errmsg=trim(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 diff --git a/datm/datm_pres_ndep_mod.F90 b/datm/datm_pres_ndep_mod.F90 index 3e0361100..1ac262d65 100644 --- a/datm/datm_pres_ndep_mod.F90 +++ b/datm/datm_pres_ndep_mod.F90 @@ -82,14 +82,14 @@ subroutine datm_pres_ndep_init_pointers(exportState, sdat, rc) call shr_strdata_get_stream_pointer( sdat, 'Faxa_ndep_noy', strm_ndep_noy, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! error checks + ! determine use_cmip_ndep module variable if (associated(strm_ndep_nhx_dry) .and. associated(strm_ndep_nhx_wet) .and. & associated(strm_ndep_noy_dry) .and. associated(strm_ndep_noy_wet)) then use_cmip7_ndep = .true. else if (associated(strm_ndep_nhx) .and. associated(strm_ndep_noy)) then use_cmip7_ndep = .false. else - call shr_log_error('datm_ndep_advance: ERROR: no associated stream pointers for ndep forcing') + call shr_log_error('datm_ndep_advance: ERROR: no associated stream pointers for ndep forcing', rc=rc) return end if diff --git a/datm/datm_pres_o3_mod.F90 b/datm/datm_pres_o3_mod.F90 index 41ced32b9..c05962777 100644 --- a/datm/datm_pres_o3_mod.F90 +++ b/datm/datm_pres_o3_mod.F90 @@ -1,9 +1,7 @@ module datm_pres_o3_mod - use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateItem_Flag - use ESMF , only : ESMF_STATEITEM_NOTFOUND + use ESMF , only : ESMF_SUCCESS, ESMF_State 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 @@ -55,17 +53,11 @@ subroutine datm_pres_o3_init_pointers(exportState, sdat, rc) 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 - if the - ! following stream fields are not in any sdat streams, then a null value is returned - call shr_strdata_get_stream_pointer(sdat, 'Sa_o3', strm_Sa_o3, rc) + ! 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=trim(subname)//'ERROR: strm_Sa_o3 must be associated if flds_pres_o3 is .true.', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Error checks - if (.not. associated(strm_Sa_o3)) then - call shr_log_error(trim(subname)//'ERROR: strm_Sa_o3 must be associated if flds_pres_o3 is .true.') - return - end if - end subroutine datm_pres_o3_init_pointers !=============================================================================== diff --git a/streams/dshr_methods_mod.F90 b/streams/dshr_methods_mod.F90 index 59500d11d..6cd4c2b01 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 @@ -54,6 +54,7 @@ subroutine dshr_state_getfldptr(State, fldname, fldptr1, fldptr2, allowNullRetur integer , intent(out) :: rc ! local variables + integer :: ni, nj type(ESMF_Field) :: lfield integer :: itemCount character(len=*), parameter :: subname='(dshr_state_getfldptr)' @@ -74,7 +75,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 +87,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) = huge(1._r8) + end do + else if (present(fldptr2)) then + do nj = 1,size(fldptr2, dim=2) + do ni = 1,size(fldptr2, dim=1) + fldptr2(ni,nj) = huge(1._r8) + 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 5c1ba395c..952f167bc 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -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 @@ -2099,83 +2098,139 @@ 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) ! 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 + integer :: logunit + logical :: mainproc logical :: found - character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d)' + character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d) ' character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_1d) ',8a)" ! ---------------------------------------------- rc = ESMF_SUCCESS + logunit = sdat%stream(1)%logunit + mainproc = sdat%mainproc + 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 (mainproc) then + write(logunit,F00)' strm_ptr is allocated and preset to huge for stream field strm_'//trim(strm_fld) + end if + do ni = 1,size(strm_ptr) + strm_ptr(ni) = huge(1._r8) 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) write(sdat%stream(1)%logunit,F00) trim(errmsg) + 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) ! 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 + integer :: logunit + logical :: mainproc logical :: found - character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d)' + character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d) ' character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_2d) ',8a)" ! ---------------------------------------------- rc = ESMF_SUCCESS + logunit = sdat%stream(1)%logunit + mainproc = sdat%mainproc + 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 (mainproc) then + write(logunit,F00)' strm_ptr is allocated and preset to huge 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) = huge(1._r8) + 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 (mainproc) then + write(logunit,F00) 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 From d6a74c252db5e0cee1d00bfc091d26023bb9832a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 21 Dec 2025 20:17:35 +0100 Subject: [PATCH 10/44] add error code to shr_log_error where missing --- streams/dshr_strdata_mod.F90 | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 825bd067c..4ad32d7e8 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -2127,7 +2127,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) per_stream%stream_pio_iodesc) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' the third dimension of a 3d field must be either time or a vertical level') + call shr_log_error(trim(subname)//& + ' the third dimension of a 3d field must be either time or a vertical level', rc-rc) return end if end if @@ -2146,13 +2147,13 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) per_stream%stream_pio_iodesc) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' dimlens = 4 assumes a time dimension and a vertical dimension') + call shr_log_error(trim(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') + call shr_log_error(trim(subname)//' only ndims of 2 and 3 and 4 are currently supported', rc=rc) return end if @@ -2183,9 +2184,7 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, & integer :: logunit logical :: mainproc logical :: found - integer :: logunit - logical :: mainproc - character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d)' + character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d) ' character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_1d) ',8a)" ! ---------------------------------------------- @@ -2251,9 +2250,7 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & integer :: logunit logical :: mainproc logical :: found - integer :: logunit - logical :: mainproc - character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d)' + character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d) ' character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_2d) ',8a)" ! ---------------------------------------------- From 80e1f8d95d90e8d1bf3ae75e8b9ab360e8efe17d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 21 Dec 2025 22:35:30 +0100 Subject: [PATCH 11/44] added rc return code to all shr_log_error calls --- streams/dshr_strdata_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 7ae00e6e9..e42cdf47f 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -2128,7 +2128,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) per_stream%stream_pio_iodesc) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' the third dimension of a 3d field must be either time or a vertical level') + call shr_log_error(trim(subname)//' the third dimension of a 3d field must be either time or a vertical level', rc=rc) return end if end if @@ -2147,13 +2147,13 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) per_stream%stream_pio_iodesc) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' dimlens = 4 assumes a time dimension and a vertical dimension') + call shr_log_error(trim(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') + call shr_log_error(trim(subname)//' only ndims of 2 and 3 and 4 are currently supported', rc=rc) return end if From dce9ee7452e9e873d9852d4ea9bd850e2bb49924 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 21 Dec 2025 23:08:08 +0100 Subject: [PATCH 12/44] fixed compiler bug --- streams/dshr_strdata_mod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 4ad32d7e8..68110b821 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -2031,9 +2031,9 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) gsize2d = dimlens(1)*dimlens(2) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' only ndims of 3 and 4 & - total dimensions are currently supported for multiple level fields & - with a time dimension', rc=rc) + call shr_log_error(trim(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 @@ -2045,9 +2045,9 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) gsize2d = dimlens(1)*dimlens(2) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' only ndims of 2 and 3 & - total dimensions are currently supported for multiple level fields & - without a time dimension', rc=rc) + call shr_log_error(trim(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 @@ -2087,7 +2087,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) else if (mainproc) then write(logunit,F01) 'setting iodesc for 2d: '//trim(fldname)// & - ' with dimlens(1),dimlens(2) = ',dimlens(1),dimlens(2),& + ' 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, & @@ -2128,7 +2128,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) else write(6,*)'ERROR: dimlens= ',dimlens call shr_log_error(trim(subname)//& - ' the third dimension of a 3d field must be either time or a vertical level', rc-rc) + ' the third dimension of a 3d field must be either time or a vertical level', rc=rc) return end if end if From a2406b330db180add56706d194dcb37805bb2dad Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 22 Dec 2025 11:30:25 +0100 Subject: [PATCH 13/44] replaced the cmip7 ndep files with those that remove the prefix string for attributes --- datm/cime_config/stream_definition_datm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/datm/cime_config/stream_definition_datm.xml b/datm/cime_config/stream_definition_datm.xml index b709b6b50..74da7589c 100644 --- a/datm/cime_config/stream_definition_datm.xml +++ b/datm/cime_config/stream_definition_datm.xml @@ -4868,7 +4868,7 @@ $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.nc + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_CMIP_FZJ-CMIP-nitrogen-1-2_gn_185001-185012-clim_c20251222.nc @@ -4903,7 +4903,7 @@ $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.nc + $DIN_LOC_ROOT/atm/ndep/cmip7/ndep_input4MIPs_surfaceFluxes_CMIP_FZJ-CMIP-nitrogen-1-2_gn_185001-202212_c20251222.nc From d476c0338e5d050434c1b7044962efe9daf13cc5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 22 Dec 2025 14:07:20 +0100 Subject: [PATCH 14/44] fix compiler problem --- streams/dshr_strdata_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index e42cdf47f..61308acde 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -2032,9 +2032,9 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) gsize2d = dimlens(1)*dimlens(2) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' only ndims of 3 and 4 & - total dimensions are currently supported for multiple level fields & - with a time dimension', rc=rc) + call shr_log_error(trim(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 @@ -2046,9 +2046,9 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) gsize2d = dimlens(1)*dimlens(2) else write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' only ndims of 2 and 3 & - total dimensions are currently supported for multiple level fields & - without a time dimension', rc=rc) + call shr_log_error(trim(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 From ccca77f128b592f9c689997d4ab1740a74921936 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 22 Dec 2025 20:39:20 +0100 Subject: [PATCH 15/44] cleaned up logunit and mainproc references --- streams/dshr_strdata_mod.F90 | 247 +++++++++++++-------------- streams/dshr_stream_mod.F90 | 317 ++++++++++++++++++++--------------- 2 files changed, 304 insertions(+), 260 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 61308acde..e890a2ac9 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -58,7 +58,10 @@ module dshr_strdata_mod 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,16 +72,17 @@ 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: + ! Private routines + private :: shr_strdata_init_model_domain + private :: shr_strdata_get_stream_nlev + private :: shr_strdata_readLBUB + + ! Public data members: integer :: debug = 0 ! local debug flag character(len=*) ,parameter, public :: shr_strdata_nullstr = 'null' character(len=*) ,parameter :: shr_strdata_unset = 'NOT_SET' @@ -141,6 +145,8 @@ module dshr_strdata_mod type(ESMF_Field) :: field_vector_dst ! needed for vector fields + integer :: logout ! log unit for mainproc output + real(r8) ,parameter :: deg2rad = SHR_CONST_PI/180.0_r8 character(*) ,parameter :: u_FILE_u = & __FILE__ @@ -200,8 +206,12 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, character(len=*), parameter :: subname='(shr_strdata_init_from_config)' ! ---------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! Set module variable logout + logout = logunit + #ifdef CESMCOUPLED ! Initialize sdat pio sdat%pio_subsystem => shr_pio_getiosys(trim(compname)) @@ -218,10 +228,10 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, sdat%mainproc = (localPet == main_task) #ifdef DISABLE_FoX - call shr_stream_init_from_esmfconfig(streamfilename, sdat%stream, logunit, & + call shr_stream_init_from_esmfconfig(streamfilename, sdat%stream, logout, & sdat%pio_subsystem, sdat%io_type, sdat%io_format, rc=rc) #else - call shr_stream_init_from_xml(streamfilename, sdat%stream, sdat%mainproc, logunit, & + call shr_stream_init_from_xml(streamfilename, sdat%stream, sdat%mainproc, logout, & sdat%pio_subsystem, sdat%io_type, sdat%io_format, trim(compname), rc=rc) #endif @@ -279,8 +289,12 @@ subroutine shr_strdata_init_from_inline(sdat, my_task, logunit, compname, & rc = ESMF_SUCCESS - ! Initialize sdat%logunit and sdat%mainproc + ! Set module variable logout + logout = logunit + + ! Initialize sdat%mainproc sdat%mainproc = (my_task == main_task) + #ifdef CESMCOUPLED ! Initialize sdat pio sdat%pio_subsystem => shr_pio_getiosys(trim(compname)) @@ -307,7 +321,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) + logout, trim(compname), sdat%mainproc, src_mask, dst_mask) ! Now finish initializing sdat call shr_strdata_init(sdat, model_clock, stream_name, rc) @@ -428,7 +442,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) if (filename /= 'none' .and. 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(trim(subname)//"ERROR: file does not exist: "//trim(fileName), rc=rc) return end if endif @@ -460,8 +474,8 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) 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 + write(logout,'(2a,i0)') trim(subname), & + " Creating field bundle array fldbun_data of size 2 for stream ",ns end if else if(sdat%stream(ns)%readmode=='full_file') then ! TODO: add this in @@ -487,7 +501,8 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mainproc) then if (i == 1) then - write(sdat%stream(1)%logunit,'(a,i8)') " adding field "//trim(sdat%pstrm(ns)%fldlist_model(nfld))//& + write(logout,'(2a,i8)') trim(subname),& + " adding field "//trim(sdat%pstrm(ns)%fldlist_model(nfld))//& " to fldbun_data for stream ",ns end if end if @@ -638,7 +653,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) 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" //& + write(logout,'(2a,i8)') trim(subname)," creating ESMF stream vector field with names" //& trim(stream_vector_names)//" for stream ",ns end if end if @@ -664,7 +679,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) else call shr_strdata_print(sdat, 'stream_data') end if - write(sdat%stream(1)%logunit,*) ' successfully initialized sdat' + write(logout,'(2a)') trim(subname),' successfully initialized sdat' endif end subroutine shr_strdata_init @@ -724,9 +739,9 @@ 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(logout,'(2a,2x,i0)') trim(subname),' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then - write(sdat%stream(1)%logunit,*)' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs + write(logout,'(3a)') trim(subname),' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs end if end if @@ -901,12 +916,13 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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))" !------------------------------------------------------------------------------- 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,7 +943,7 @@ 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(logout,'(2a)') trim(subname),'optional variable timers present but unused' endif call ESMF_TraceRegionEnter(trim(lstr)//trim(timname)//'_total') @@ -972,15 +988,15 @@ 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) + write(logout,'(2a)') "ERROR: Unsupported readmode : ", trim(sdat%stream(ns)%readmode) 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 + write(logout,'(2a,2x,i0,2x,l4)') trim(subname),' newData flag = ',ns,newData(ns) + write(logout,'(2a,2x,2(i0,2x))') trim(subname),' LB ymd,tod = ',ns,sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB + write(logout,'(2a,2x,2(i0,2x))') trim(subname),' UB ymd,tod = ',ns,sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB endif ! --------------------------------------------------------- @@ -999,7 +1015,7 @@ 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 ', & + write(logout,'(3a)') 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) return @@ -1037,7 +1053,8 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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' + write(logout,'(2a,2x,i0,a)') trim(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,18 +1064,14 @@ 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(logout,'(2a,i0)') trim(subname),' ERROR: for stream ',ns + write(logout,'(3a)') trim(subname),' ERROR: calendar = ',trim(calendar) + write(logout,'(2a,i0)') trim(subname),' ERROR: dday = ',dday + write(logout,'(2a,4(f15.5,2x))') trim(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(logout,'(a,4(i0,2x))') trim(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) return endif @@ -1091,11 +1104,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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, logout) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenC') if (debug > 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= ',& + write(logout,'(a,i4,2x,2(i18,2x),i8,d20.10)')' stream,ymdmod,todmod,n,coszen= ',& ns, ymd, tod, n, coszen(n) end do end if @@ -1110,11 +1123,12 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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, logout, rc=rc) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenN') if (debug > 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(logout,'(2a,i4,2x,4(i18,2x),i8,d20.10)') trim(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,11 +1180,11 @@ 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=logout, & 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))') & + write(logout,'(a,i4,2(f10.5,2x))') & trim(subname)//' non-cosz-interp stream, flb, fub= ',ns,flb,fub endif do nf = 1,size(sdat%pstrm(ns)%fldlist_model) @@ -1271,39 +1285,32 @@ 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('-'))" !------------------------------------------------------------------------------- - 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(logout,*) + write(logout,'(a)') '------------------------------------------------------' + write(logout,'(2a)') trim(subname),"name = ",trim(name) + write(logout,'(3a)') trim(subname),"calendar = ",trim(sdat%model_calendar) + write(logout,'(2a,2x,es13.6)') trim(subname),"eccen = ",sdat%eccen + write(logout,'(2a,2x,es13.6)') trim(subname),"mvelpp = ",sdat%mvelpp + write(logout,'(2a,2x,es13.6)') trim(subname),"lambm0 = ",sdat%lambm0 + write(logout,'(2a,2x,es13.6)') trim(subname),"obliqr = ",sdat%obliqr + write(logout,'(3a)') trim(subname),"pio_iotype = ",sdat%io_type + write(logout,'(2a,2x,i0)') trim(subname),"nstreams = ",shr_strdata_get_stream_count(sdat) + write(logout,'(2a)') trim(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(logout,'(3a)') trim(subname)," taxMode (",ns,") = ",trim(sdat%stream(ns)%taxmode) + write(logout,'(2a,i0,a,es13.6)') trim(subname)," dtlimit (",ns,") = ",sdat%stream(ns)%dtlimit + write(logout,'(2a,i0,2a)') trim(subname)," tintalgo(",ns,") = ",trim(sdat%stream(ns)%tinterpalgo) + write(logout,'(2a,i0,2a)') trim(subname)," mapalgo (",ns,") = ",trim(sdat%stream(ns)%mapalgo) + write(logout,'(2a,i0,2a)') trim(subname)," readmode(",ns,") = ",trim(sdat%stream(ns)%readmode) + write(logout,'(2a,i0,2a)') trim(subname)," vectors (",ns,") = ",trim(sdat%stream(ns)%stream_vectors) + write(logout,'(2a,i0,a,i0)') trim(subname)," src_mask(",ns,") = ",sdat%stream(ns)%src_mask_val + write(logout,'(2a,i0,a,i0)') trim(subname)," dst_mask(",ns,") = ",sdat%stream(ns)%dst_mask_val + write(logout,'(2a)') trim(subname)," " end do - write(sdat%stream(1)%logunit,F90) + write(logout,'(a)') '------------------------------------------------------' + write(logout,*) end subroutine shr_strdata_print @@ -1339,8 +1346,6 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) 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)" !------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1374,25 +1379,29 @@ 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,& + write(logout,'(a,i4,2x,6(i18,2x),l7)') trim(subname),& + ' 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= ',& + write(logout,'(a,i4,2x,3(f20.3,2x),l7)') trim(subname), & + ' 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,& + write(logout,'(a,i4,2x,6(i18,2x),l7)') trim(subname), & + ' 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= ',& + write(logout,'(a,i4,2x,3(f20.3,2x),l7)') trim(subname), & + ' stream,rdateLB,rdateM,rdateUB,newdata= ',& ns,rdateLB,rdateM,rdateUB,find_bounds end if endif @@ -1495,10 +1504,8 @@ 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 + character(*), parameter :: subname = '(shr_strdata_readstrm) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1530,10 +1537,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(logout,'(3a)') trim(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(logout,'(3a)') trim(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 +1557,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 (sdat%mainproc) then + write(logout,'(3a)') trim(subname),' setting pio descriptor : ',trim(filename) + 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 +1590,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(logout,'(3a,i0)') trim(subname),'reading file ' // trim(boundstr) //': ',trim(filename),nt endif if (ESMF_FieldIsCreated(per_stream%field_stream_vector)) then @@ -1640,8 +1653,9 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & 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)),& + write(logout,'(3a,2x,i0)') trim(subname),& + ' reading '//trim(per_stream%fldlist_stream(nf))//& + ' into '//trim(per_stream%fldlist_model(nf)), & ' at time index: ',nt end if @@ -1666,7 +1680,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_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) + if(sdat%mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) call shr_log_error(errmsg, rc=rc) return endif @@ -1701,7 +1715,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_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) + if(sdat%mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) call shr_log_error(errmsg, rc=rc) return endif @@ -1771,7 +1785,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(trim(subname)//trim(errmsg), rc=rc) return endif do n = 1,size(dataptr1d) @@ -1975,16 +1989,11 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) integer, allocatable :: dimlens(:) type(ESMF_DistGrid) :: distGrid integer :: lsize - integer :: logunit logical :: mainproc 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)" !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1993,8 +2002,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) nullify(compdof) nullify(compdof3d) - ! set logunit and mainproc - logunit = sdat%stream(1)%logunit + ! set mainproc mainproc = sdat%mainproc ! set the number of vertical levels to a local variable @@ -2031,7 +2039,6 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) ! third dimension is lev and fourth dimension is time gsize2d = dimlens(1)*dimlens(2) else - write(6,*)'ERROR: dimlens= ',dimlens call shr_log_error(trim(subname)//' only ndims of 3 and 4 '//& ' total dimensions are currently supported for multiple level fields '// & ' with a time dimension', rc=rc) @@ -2045,7 +2052,6 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) ! third dimension is lev gsize2d = dimlens(1)*dimlens(2) else - write(6,*)'ERROR: dimlens= ',dimlens call shr_log_error(trim(subname)//' only ndims of 2 and 3 '// & ' total dimensions are currently supported for multiple level fields '// & ' without a time dimension', rc=rc) @@ -2071,15 +2077,14 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if ((trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then if (mainproc) then - write(logunit,F03) 'setting iodesc for 2d: '//trim(fldname)// & - ' with dimlens(1) = ',dimlens(1),& - ' and dimlens(2) is a time dimension ' + write(logout,'(2a,2(i0,2x),a)') trim(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 (mainproc) then - write(logunit,F01) 'setting iodesc for 2d: '//trim(fldname)// & + write(logout,'(2a,2x,i0,2x,i0,a)') trim(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 @@ -2087,7 +2092,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) per_stream%stream_pio_iodesc) else if (mainproc) then - write(logunit,F01) 'setting iodesc for 2d: '//trim(fldname)// & + write(logout,'(2a,2x,2(i0,2x),a)') trim(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 @@ -2102,16 +2107,18 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then if (stream_nlev > 1) then if (mainproc) then - write(logunit,F01) 'setting iodesc for 3d: '//trim(fldname)// & - ' with dimlens(1),dimlens(2) = ',dimlens(1),dimlens(2),& + write(logout,'(2a,2x,2(i0,2x),a)') trim(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 (mainproc) then - write(logunit,F01) 'setting iodesc for 3d: '//trim(fldname)// & - ' with dimlens(1),dimlens(2) = ',dimlens(1),dimlens(2),& + write(logout,'(2a,2x,2(i0,2x),a)') trim(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, & @@ -2120,15 +2127,16 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) else if (stream_nlev > 1) then if (mainproc) then - write(logunit,F01) 'setting iodesc for 3d: '//trim(fldname)// & - ' with dimlens(1), dimlens(2), dimlens(3) = ',dimlens(1),dimlens(2), dimlens(3), & + write(logout,'(2a,2x,3(i0,2x),a)') trim(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 - write(6,*)'ERROR: dimlens= ',dimlens - call shr_log_error(trim(subname)//' the third dimension of a 3d field must be either time or a vertical level', rc=rc) + call shr_log_error(trim(subname)//& + ' the third dimension of a 3d field must be either time or a vertical level', rc=rc) return end if end if @@ -2139,20 +2147,19 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if (stream_nlev > 1 .and. (trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then if (mainproc) then - write(logunit,F02) 'setting iodesc for 4d: '//trim(fldname)// & - ' with dimlens(1), dimlens(2),dimlens(3) = ',dimlens(1),dimlens(2),dimlens(3),& + write(logout,'(2a,2s,3(i0,2x),a)') trim(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 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) return end if @@ -2179,15 +2186,12 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, rc) ! local variables integer :: ns, nf logical :: found - integer :: logunit logical :: mainproc character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d)' - character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_1d) ',8a)" ! ---------------------------------------------- rc = ESMF_SUCCESS - logunit = sdat%stream(1)%logunit mainproc = sdat%mainproc ! loop over all input streams and determine if the strm_fld is in the field bundle of the target stream @@ -2200,7 +2204,7 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, rc) fldptr1=strm_ptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mainproc) then - write(logunit,F00)' strm_ptr is allocated for stream field strm_'//trim(strm_fld) + write(logout,'(2a)') trim(subname),' strm_ptr is allocated for stream field strm_'//trim(strm_fld) end if found = .true. exit @@ -2224,15 +2228,12 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, rc) ! local variables integer :: ns, nf logical :: found - integer :: logunit logical :: mainproc character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d)' - character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_2d) ',8a)" ! ---------------------------------------------- rc = ESMF_SUCCESS - logunit = sdat%stream(1)%logunit mainproc = sdat%mainproc ! loop over all input streams and determine if the strm_fld is in the field bundle of the target stream @@ -2245,7 +2246,7 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, rc) fldptr2=strm_ptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mainproc) then - write(logunit,F00)' strm_ptr is allocated for stream field strm_'//trim(strm_fld) + write(logout,'(2a)') trim(subname),' strm_ptr is allocated for stream field strm_'//trim(strm_fld) end if found = .true. exit diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index 0b5026169..66d775063 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -103,7 +103,6 @@ module dshr_stream_mod type(iosystem_desc_t), pointer :: pio_subsystem 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) @@ -138,6 +137,10 @@ module dshr_stream_mod !----- parameters ----- integer :: debug = 0 ! edit/turn-on for debug write statements real(R8) , parameter :: spd = shr_const_cday ! seconds per day + + integer :: logout + logical :: mainproc + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -148,9 +151,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 @@ -206,7 +210,11 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu nstrms = 0 - if (isroot_task) then + ! Set module variables logout and mainproc + logout = logunit + mainproc = isroot_task + + if (mainproc) then Sdoc => parseFile(streamfilename, iostat=status) if (status /= 0) then @@ -216,7 +224,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 @@ -365,7 +373,7 @@ 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 + if (.not. mainproc) then allocate(streamdat(nstrms)) endif @@ -385,7 +393,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%yearLast = tmp(4) streamdat(i)%yearAlign = tmp(5) streamdat(i)%offset = tmp(6) - if(.not. isroot_task) then + if(.not. mainproc) then allocate(streamdat(i)%file(streamdat(i)%nfiles)) allocate(streamdat(i)%varlist(streamdat(i)%nvars)) endif @@ -432,9 +440,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%pio_iotype = io_type streamdat(i)%pio_ioformat = io_format #endif - ! Set logunit - streamdat(i)%logunit = logunit - call shr_stream_getCalendar(streamdat(i), 1, streamdat(i)%calendar) ! Error check @@ -446,7 +451,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%init = .true. enddo - end subroutine shr_stream_init_from_xml #endif @@ -459,7 +463,7 @@ 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) ! -------------------------------------------------------- ! set values of stream datatype independent of a reading in a stream text file @@ -486,6 +490,7 @@ subroutine shr_stream_init_from_inline(streamdat, & character(*) ,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 @@ -497,6 +502,12 @@ subroutine shr_stream_init_from_inline(streamdat, & character(*),parameter :: subName = '(shr_stream_init_from_inline) ' ! -------------------------------------------------------- + ! Set module variagble logout + logout = logunit + + ! Set module variable mainproc + mainproc = isroot_task + ! Assume only 1 stream allocate(streamdat(1)) @@ -548,9 +559,6 @@ subroutine shr_stream_init_from_inline(streamdat, & 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 +573,14 @@ 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 +618,27 @@ 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)' character(len=ESMF_MAXSTR), allocatable :: strm_tmpstrings(:) - character(*) , parameter :: u_FILE_u = __FILE__ - + character(*), parameter :: u_FILE_u = __FILE__ + character(*), parameter :: subName = '(shr_stream_init_from_esmfconfig)' ! --------------------------------------------------------------------- rc = ESMF_SUCCESS - nstrms = 0 + ! Set module variable logout + logout = logunit - ! 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 + mainproc = (myid == 0) + + ! allocate streamdat instance on all tasks + nstrms = 0 ! set ESMF config cf = ESMF_ConfigCreate(rc=RC) @@ -633,7 +649,7 @@ 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 + ! allocate an array of shr_stream_streamtype objects on just mainproc if( nstrms > 0 ) then allocate(streamdat(nstrms)) else @@ -746,8 +762,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) @@ -770,8 +784,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,7 +803,6 @@ 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 @@ -823,15 +837,10 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & 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)" !------------------------------------------------------------------------------- - if (debug>0 .and. isroot_task) then - write(strm%logunit,F02) "DEBUG: ---------- enter ------------------" + if (debug>0 .and. mainproc) then + write(logout,'(a,a)') trim(subname),"DEBUG: ---------- enter ------------------" end if if ( .not. strm%init ) then @@ -865,23 +874,26 @@ 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>0 .and. mainproc) then + write(logout,'(2a,4(2x,i0))') trim(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 + if (mainproc) then + write(logout,'(2a,2x,i0)') trim(subName),' ERROR: dyear lt zero = ',dYear + end if call shr_sys_abort(trim(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>0 .and. mainproc) then + write(logout,'(a,2(i8,2x),2(f20.4,2x))') 'mYear,dYear,dDateIn,rDateIn = ',mYear,dYear,dDateIn,rDateIn + write(logout,'(a,2(i8,2x),2(f20.4,2x))') 'yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears endif !---------------------------------------------------------------------------- @@ -891,7 +903,7 @@ 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") end if @@ -911,12 +923,14 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & 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" + if (mainproc) then + write(logout,'(2a)') trim(subname)," ERROR: LVD not found, all data is after yearLast" + end if call shr_sys_abort(trim(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>1 .and. mainproc) then + if (strm%found_lvd) write(logout,'(2a,2x,i0)') trim(subname)," found LVD = ",strm%file(k)%date(n) end if end if @@ -925,7 +939,9 @@ 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" + if (mainproc) then + write(logout,'(2a)') trim(subname)," ERROR: LVD not found yet" + end if call shr_sys_abort(trim(subName)//" ERROR: LVD not found yet") endif @@ -936,8 +952,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>0 .and. mainproc) then + write(logout,'(2a,3(f20.4,2x))') trim(subname),' rDateIn,rDatelvd,rDategvd = ',rDateIn,rDatelvd,rDategvd endif !----------------------------------------------------------- @@ -949,7 +965,9 @@ 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 + if (mainproc) then + write(logout,'(2a,2(i0,2x))') trim(subName)," ERROR: limit on and rDateIn lt rDatelvd",rDateIn,rDatelvd + end if call shr_sys_abort(trim(subName)//" ERROR: rDateIn lt rDatelvd limit true") endif @@ -979,7 +997,7 @@ 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") end if @@ -991,8 +1009,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>1 .and. mainproc) then + write(logout,'(2a,i0)') trim(subname)," found GVD ",strm%file(k)%date(n) end if exit B end if @@ -1001,7 +1019,9 @@ 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" + if (mainproc) then + write(logout,'(2a)') trim(subname)," ERROR: GVD not found1" + end if call shr_sys_abort(trim(subName)//" ERROR: GVD not found1") endif @@ -1035,7 +1055,9 @@ 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 + if (mainproc) then + write(logout,'(2a,2(d13.5,2x))') trim(subName)," ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd + end if call shr_sys_abort(trim(subName)//" ERROR: rDateIn >= rDategvd limit true") endif @@ -1089,7 +1111,7 @@ 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") end if @@ -1135,7 +1157,9 @@ 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 + if (mainproc) then + write(logout,'(2a,2(d13.5,2x))') trim(subName)," ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd + end if call shr_sys_abort(trim(subName)//" ERROR: rDateIn >= rDategvd limit true") endif @@ -1209,7 +1233,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 (mainproc) then + write(logout,'(2a,3(i0,2x))') trim(subname),' Found leapyear mismatch', myear, dyear, yy + end if mm = 3 dd = 1 endif @@ -1228,14 +1254,13 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & 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 @@ -1266,8 +1291,8 @@ 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>1 .and. mainproc) then + write(logout, '(2a)') trim(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 @@ -1327,8 +1352,8 @@ 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>1 .and. mainproc) then + write(logout, '(2a)') trim(subname),' closing stream filename = '//trim(filename) end if call pio_closefile(strm%file(k)%fileid) @@ -1347,7 +1372,9 @@ subroutine shr_stream_readTCoord(strm, k, isroot_task, rc) 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 (mainproc) then + ! write(logout,'(2a,6(i0,2x))') 'debug ',n,strm%offset,din,sin,dout,sout + ! end if enddo endif @@ -1376,9 +1403,7 @@ subroutine verifyTCoord(strm,k,rc) 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)" + !------------------------------------------------------------------------------- ! Notes: ! o checks that dates are increasing (must not decrease) @@ -1390,17 +1415,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>1 .and. mainproc) then + write(logout,'(2a,i0)') trim(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 (mainproc) then + write(logout,'(2a,i0)') trim(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 +1441,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>1 .and. mainproc) then + write(logout,'(2a,i0)') trim(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 +1456,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>1 .and. mainproc) then + write(logout,'(2a,i0)') trim(subname)," comparing with next file for file k =",k + end if end if end if else @@ -1443,28 +1474,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 (mainproc) then + write(logout,'(2a)') trim(subname)," ERROR: calendar dates must be increasing" + write(logout,'(2a,2(i0,2x))') trim(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 (mainproc) then + write(logout,'(2a)') trim(subname), "ERROR: elapsed seconds on a date must be strickly increasing" + write(logout,'(2a,2(i0,2x))') trim(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 (mainproc) then + write(logout,'(2a)') trim(subname)," ERROR: elapsed seconds out of valid range [0,spd]" + write(logout,'(2a,i0)') trim(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>0 .and. mainproc) then + write(logout,'(2a,i0)') trim(subname)," data is OK (non-decreasing) for file k =",k + end if end subroutine verifyTCoord end subroutine shr_stream_readTCoord @@ -1521,8 +1559,10 @@ 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: @@ -1531,15 +1571,12 @@ subroutine shr_stream_getCalendar(strm, k, calendar) character(*) ,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) ' !------------------------------------------------------------------------------- @@ -1547,23 +1584,21 @@ subroutine shr_stream_getCalendar(strm, k, calendar) 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 (mainproc) then + write(logout,'(2a)') trim(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 (mainproc) then + write(logout,'(2a)') trim(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 .lt. 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 +1614,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 (mainproc) then + write(logout,'(2a)') trim(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 (mainproc) then + write(logout, '(2a)') trim(subname),' closing stream filename = '//trim(filename) + end if call pio_closefile(strm%file(k)%fileid) end subroutine shr_stream_getCalendar @@ -1646,7 +1685,6 @@ subroutine shr_stream_getNextFileName(strm, fn, fnNext,rc) integer :: n ! loop index logical :: found ! file name found? character(*),parameter :: subName = '(shr_stream_getNextFileName) ' - character(*),parameter :: F00 = "('(shr_stream_getNextFileName) ',8a)" !------------------------------------------------------------------------------- rCode = 0 @@ -1661,7 +1699,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 (mainproc) then + write(logout,'(3a)') trim(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 @@ -1696,7 +1736,7 @@ subroutine shr_stream_getPrevFileName(strm, fn, fnPrev,rc) integer :: n ! loop index logical :: found ! file name found? character(*),parameter :: subName = '(shr_stream_getPrevFileName) ' - character(*),parameter :: F00 = "('(shr_stream_getPrevFileName) ',8a)" + !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Note: will wrap-around data loop if lvd & gvd are known @@ -1715,7 +1755,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 (mainproc) then + write(logout,'(3a)') trim(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 @@ -1765,9 +1807,8 @@ 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 - + character(*),parameter :: subName = '(shr_stream_restIO) ' !------------------------------------------------------------------------------- if (mode .eq. 'define') then @@ -1775,7 +1816,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 @@ -1964,28 +2004,35 @@ subroutine shr_stream_restIO(pioid, streams, mode) 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 ! 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 (mainproc) then + write(logout,'(2a)') trim(subname),'Filename does not match restart record, 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 (mainproc) then + write(logout,'(2a)') trim(subname),'Filename path does not match restartfile, 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 (mainproc) then + write(logout,'(2a)') trim(subname),trim(rfname), '<>', trim(rsfname) + write(logout,'(2a)') trim(subname),' fname = '//trim(fname) + write(logout,'(2a,i8,2x,i8,2x,a)') trim(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)) rcode = pio_get_var(pioid, ntvarid, (/n,k/), tmp(1)) @@ -2040,35 +2087,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(*),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 > 0 .and. mainproc) then + write(logout,'(2a)') trim(subname),"dump internal data for debugging..." + write(logout,'(2a,i0)') trim(subname)," nFiles = ", strm%nFiles + do nf = 1,strm%nFiles + write(logout,'(2a,i0)') trim(subname)," data for file nf = ",nf + write(logout,'(2a)') trim(subname)," file(nf)%name = ", trim(strm%file(nf)%name) + if ( strm%file(nf)%haveData ) then + write(logout,'(2a,i0)') trim(subname)," file(nf)%nt = ", strm%file(nf)%nt + do nt = 1, size(strm%file(nf)%date) + write(logout,'(2a,2(i0,2x))') trim(subname)," file(nf)%date(nt) = ",nt,strm%file(nf)%date(nt) + write(logout,'(2a,2(i0,2x))') trim(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(logout,'(2a)') trim(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(logout,'(2a,3(2x,i0))') trim(subname),"yearF/L/A = ",strm%yearFirst,strm%yearLast,strm%yearAlign + write(logout,'(2a,i0)') trim(subname),"offset = ",strm%offset + write(logout,'(3a)') trim(subname),"taxMode = ",trim(strm%taxMode) + write(logout,'(3a)') trim(subname),"meshfile = ",trim(strm%meshfile) end if end subroutine shr_stream_dataDump From f7d77f995c5ed28a485b549f011d5004902a8364 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 23 Dec 2025 20:20:00 +0100 Subject: [PATCH 16/44] refactored stdout formatting and calls --- dshr/dshr_dfield_mod.F90 | 22 ++-- streams/dshr_strdata_mod.F90 | 230 +++++++++++++++++++---------------- streams/dshr_stream_mod.F90 | 45 ++++--- 3 files changed, 163 insertions(+), 134 deletions(-) diff --git a/dshr/dshr_dfield_mod.F90 b/dshr/dshr_dfield_mod.F90 index eba63087e..476707a3b 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,'(2a)') 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,'(2a)') 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,'(2a,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,'(2a)') 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,'(2a)') 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,'(2a)') 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,'(2a)') trim(subname),' setting pointer for export state '//trim(state_fld) end if state_ptr => dfield_new%state_data2d diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index e890a2ac9..f430bed3a 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 @@ -119,7 +119,7 @@ module dshr_strdata_mod type shr_strdata_type type(shr_strdata_perstream), allocatable :: pstrm(:) ! stream info type(shr_stream_streamType), pointer :: stream(:)=> null() ! stream datatype - logical :: mainproc + logical :: mainproc ! not used, needed for cmeps backwards compatibility integer :: io_type ! pio info integer :: io_format ! pio info integer :: modeldt = 0 ! model dt in seconds @@ -145,7 +145,8 @@ module dshr_strdata_mod type(ESMF_Field) :: field_vector_dst ! needed for vector fields - integer :: logout ! log unit for mainproc output + logical :: mainproc ! root processor + integer :: logout ! log unit for mainproc output real(r8) ,parameter :: deg2rad = SHR_CONST_PI/180.0_r8 character(*) ,parameter :: u_FILE_u = & @@ -201,14 +202,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 character(len=*), parameter :: subname='(shr_strdata_init_from_config)' ! ---------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - ! Set module variable logout logout = logunit @@ -219,23 +219,27 @@ 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 + mainproc = (localPet == main_task) - ! Initialize sdat streams (read xml file for streams) - sdat%mainproc = (localPet == main_task) - + ! Initialize sdat streams #ifdef DISABLE_FoX + ! Read input ESMF config file call shr_stream_init_from_esmfconfig(streamfilename, sdat%stream, logout, & sdat%pio_subsystem, sdat%io_type, sdat%io_format, rc=rc) #else - call shr_stream_init_from_xml(streamfilename, sdat%stream, sdat%mainproc, logout, & + ! Read input xml file + call shr_stream_init_from_xml(streamfilename, sdat%stream, mainproc, logout, & 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)) ! Initialize sdat model domain sdat%model_mesh = model_mesh @@ -283,17 +287,34 @@ subroutine shr_strdata_init_from_inline(sdat, my_task, logunit, compname, & 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 + type(ESMF_VM) :: vm + integer :: localpet + character(len=*), parameter :: subname='(shr_strdata_init_from_inline)' ! ---------------------------------------------- rc = ESMF_SUCCESS + ! 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 + mainproc = (localPet == main_task) + ! Set module variable logout - logout = logunit + if (mainproc) then + logout = logunit + end if - ! Initialize sdat%mainproc - sdat%mainproc = (my_task == main_task) + if (mainproc) then + if (present(stream_name)) then + write(logout,'(3a)') trim(subname),' inline call for stream ',trim(stream_name) + else + write(logout,'(2a)') trim(subname),' inline call for generic stream stream_data' + end if + end if #ifdef CESMCOUPLED ! Initialize sdat pio @@ -321,7 +342,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, & - logout, trim(compname), sdat%mainproc, src_mask, dst_mask) + logout, trim(compname), mainproc, src_mask, dst_mask) ! Now finish initializing sdat call shr_strdata_init(sdat, model_clock, stream_name, rc) @@ -411,10 +432,8 @@ 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 character(CL) :: stream_vector_names @@ -423,34 +442,32 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) 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 inquire(file=trim(filename),exist=fileExists) if (.not. fileExists) then - call shr_log_error(trim(subname)//"ERROR: file does not exist: "//trim(fileName), rc=rc) + call shr_log_error(trim(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 @@ -501,7 +518,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mainproc) then if (i == 1) then - write(logout,'(2a,i8)') trim(subname),& + write(logout,'(2a,i0)') trim(subname),& " adding field "//trim(sdat%pstrm(ns)%fldlist_model(nfld))//& " to fldbun_data for stream ",ns end if @@ -621,10 +638,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) @@ -653,11 +671,11 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ungriddedLbound=(/1/), ungriddedUbound=(/2/), gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mainproc) then - write(logout,'(2a,i8)') trim(subname)," creating ESMF stream vector field with names" //& + write(logout,'(2a,i0)') trim(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 @@ -704,7 +722,7 @@ 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) ' + character(*), parameter :: subname = '(shr_strdata_get_stream_nlev) ' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -715,10 +733,11 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) else call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (sdat%mainproc) then + if (mainproc) then 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) @@ -738,7 +757,8 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) end if call pio_closefile(pioid) end if - if (sdat%mainproc) then + if (mainproc) then + write(logout,*) write(logout,'(2a,2x,i0)') trim(subname),' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then write(logout,'(3a)') trim(subname),' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs @@ -781,10 +801,11 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Determine the file to open - if (sdat%mainproc) then + if (mainproc) then 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) @@ -993,10 +1014,10 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) return end select - if (debug > 0 .and. sdat%mainproc) then - write(logout,'(2a,2x,i0,2x,l4)') trim(subname),' newData flag = ',ns,newData(ns) - write(logout,'(2a,2x,2(i0,2x))') trim(subname),' LB ymd,tod = ',ns,sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB - write(logout,'(2a,2x,2(i0,2x))') trim(subname),' UB ymd,tod = ',ns,sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB + if (debug>0 .and. mainproc) then + write(logout,'(2a,2x,i0,2x,a,2x,l4)') trim(subname),' newData flag for stream = ',ns,' is ',newData(ns) + write(logout,'(2a,2x,3(i0,2x))') trim(subname),' LB ymd,tod = ',ns,sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB + write(logout,'(2a,2x,3(i0,2x))') trim(subname),' UB ymd,tod = ',ns,sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB endif ! --------------------------------------------------------- @@ -1052,7 +1073,7 @@ 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 + if (mainproc) then write(logout,'(2a,2x,i0,a)') trim(subname),' WARNING: Stream ',& ns,' is not cycling on annual boundaries, and dtlimit check has been overridden' endif @@ -1063,11 +1084,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) sdat%pstrm(ns)%dtmax = max(sdat%pstrm(ns)%dtmax,dtime) if ((sdat%pstrm(ns)%dtmax/sdat%pstrm(ns)%dtmin) > sdat%stream(ns)%dtlimit) then - if (sdat%mainproc) then + if (mainproc) then write(logout,'(2a,i0)') trim(subname),' ERROR: for stream ',ns write(logout,'(3a)') trim(subname),' ERROR: calendar = ',trim(calendar) write(logout,'(2a,i0)') trim(subname),' ERROR: dday = ',dday - write(logout,'(2a,4(f15.5,2x))') trim(subName),' ERROR: dtime, dtmax, dtmin, dtlimit = ',& + write(logout,'(2a,4(es13.6,2x))') trim(subName),' ERROR: dtime, dtmax, dtmin, dtlimit = ',& dtime, sdat%pstrm(ns)%dtmax, sdat%pstrm(ns)%dtmin, sdat%stream(ns)%dtlimit write(logout,'(a,4(i0,2x))') trim(subName),' ERROR: ymdLB, todLB, ymdUB, todUB = ', & sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB @@ -1104,11 +1125,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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, logout) + mainproc, logout) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenC') - if (debug > 0 .and. sdat%mainproc) then + if (debug > 0 .and. mainproc) then do n = 1,size(coszen) - write(logout,'(a,i4,2x,2(i18,2x),i8,d20.10)')' stream,ymdmod,todmod,n,coszen= ',& + write(logout,'(a,i0,2x,2(i0,2x),i0,es13.6)')' stream,ymdmod,todmod,n,coszen= ',& ns, ymd, tod, n, coszen(n) end do end if @@ -1123,11 +1144,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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, logout, rc=rc) + sdat%stream(ns)%calendar, mainproc, logout, rc=rc) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenN') - if (debug > 0 .and. sdat%mainproc) then + if (debug > 0 .and. mainproc) then do n = 1,size(coszen) - write(logout,'(2a,i4,2x,4(i18,2x),i8,d20.10)') trim(subname), & + write(logout,'(2a,i0,2x,4(i0,2x),i0,es13.6)') trim(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) @@ -1183,9 +1204,10 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) ymdmod(ns), todmod, flb, fub, calendar=sdat%stream(ns)%calendar, logunit=logout, & algo=trim(sdat%stream(ns)%tinterpalgo), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (debug > 0 .and. sdat%mainproc) then + if (debug > 0 .and. mainproc) then write(logout,'(a,i4,2(f10.5,2x))') & trim(subname)//' non-cosz-interp stream, flb, fub= ',ns,flb,fub + write(logout,'(a)') '------------------------------------------------------' endif do nf = 1,size(sdat%pstrm(ns)%fldlist_model) if (sdat%pstrm(ns)%stream_nlev > 1) then @@ -1289,17 +1311,17 @@ subroutine shr_strdata_print(sdat, name) write(logout,*) write(logout,'(a)') '------------------------------------------------------' - write(logout,'(2a)') trim(subname),"name = ",trim(name) - write(logout,'(3a)') trim(subname),"calendar = ",trim(sdat%model_calendar) - write(logout,'(2a,2x,es13.6)') trim(subname),"eccen = ",sdat%eccen - write(logout,'(2a,2x,es13.6)') trim(subname),"mvelpp = ",sdat%mvelpp - write(logout,'(2a,2x,es13.6)') trim(subname),"lambm0 = ",sdat%lambm0 - write(logout,'(2a,2x,es13.6)') trim(subname),"obliqr = ",sdat%obliqr - write(logout,'(3a)') trim(subname),"pio_iotype = ",sdat%io_type - write(logout,'(2a,2x,i0)') trim(subname),"nstreams = ",shr_strdata_get_stream_count(sdat) - write(logout,'(2a)') trim(subname),"Per stream information " + write(logout,'(3a)') trim(subname)," name = ",trim(name) + write(logout,'(3a)') trim(subname)," calendar = ",trim(sdat%model_calendar) + write(logout,'(2a,2x,es13.6)') trim(subname)," eccen = ",sdat%eccen + write(logout,'(2a,2x,es13.6)') trim(subname)," mvelpp = ",sdat%mvelpp + write(logout,'(2a,2x,es13.6)') trim(subname)," lambm0 = ",sdat%lambm0 + write(logout,'(2a,2x,es13.6)') trim(subname)," obliqr = ",sdat%obliqr + write(logout,'(2a,i0)') trim(subname)," pio_iotype = ",sdat%io_type + write(logout,'(2a,2x,i0)') trim(subname)," nstreams = ",shr_strdata_get_stream_count(sdat) + write(logout,'(2a)') trim(subname)," Per stream information " do ns = 1, shr_strdata_get_stream_count(sdat) - write(logout,'(3a)') trim(subname)," taxMode (",ns,") = ",trim(sdat%stream(ns)%taxmode) + write(logout,'(2a,i0,2a)') trim(subname)," taxMode (",ns,") = ",trim(sdat%stream(ns)%taxmode) write(logout,'(2a,i0,a,es13.6)') trim(subname)," dtlimit (",ns,") = ",sdat%stream(ns)%dtlimit write(logout,'(2a,i0,2a)') trim(subname)," tintalgo(",ns,") = ",trim(sdat%stream(ns)%tinterpalgo) write(logout,'(2a,i0,2a)') trim(subname)," mapalgo (",ns,") = ",trim(sdat%stream(ns)%mapalgo) @@ -1333,7 +1355,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 @@ -1354,8 +1375,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 @@ -1378,43 +1397,49 @@ 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(logout,'(a,i4,2x,6(i18,2x),l7)') trim(subname),& - ' 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(logout,'(a,i4,2x,3(f20.3,2x),l7)') trim(subname), & - ' 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%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(logout,'(a,i4,2x,6(i18,2x),l7)') trim(subname), & - ' 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(logout,'(a,i4,2x,3(f20.3,2x),l7)') trim(subname), & - ' 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 > 0 .and. mainproc) then + write(logout,'(2a,i0)') trim(subname),' stream number is: ',ns + write(logout,'(2a,l7,a,l7)') trim(subname), & + ' find_bounds = ',find_bounds,' newdata is = ',newdata + write(logout,'(2a,4(2x,i0))') trim(subname), & + ' oDateLB, OSecLb, oDateUB, OsecUB = ',& + oDateLB, OSecLb, oDateUB, OsecUB + write(logout,'(2a,2x,3(f13.6,2x),l4)') trim(subname), & + ' rdateLB,rdateM,rdateUB = ',& + rdateLB, rdateM, rdateUB + write(logout,'(2a,2x,6(i0,2x))') trim(subname), & + ' 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 > 0 .and. mainproc) then + write(logout,'(2a,i0)') trim(subname),' Copying upper bound bound of data to lower bound for stream ',ns + 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 > 0 .and. mainproc) then + write(logout,'(2a,i0)') trim(subname),' Reading in new lower bound of data for stream ',ns + 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), & @@ -1429,11 +1454,14 @@ 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 > 0 .and. mainproc) then + write(logout,'(2a,i0)') trim(subname),' Reading in new upper bound of data for stream ',ns + end if endif ! determine previous & next data files in list of files call ESMF_TraceRegionEnter(trim(istr)//'_filemgt') - if (sdat%mainproc .and. newdata) then + if (mainproc .and. newdata) then call shr_stream_getPrevFileName(stream, filename_lb, filename_prev) call shr_stream_getNextFileName(stream, filename_ub, filename_next) inquire(file=trim(filename_next),exist=fileExists) @@ -1521,7 +1549,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & nullify(data_v_dst) ! Set up file to read from - if (sdat%mainproc) then + if (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) @@ -1537,12 +1565,12 @@ 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) then + if (mainproc) then write(logout,'(3a)') trim(subname),' closing : ',trim(currfile) end if call pio_closefile(pioid) endif - if (sdat%mainproc) then + if (mainproc) then write(logout,'(3a)') trim(subname),' opening : ',trim(filename) end if rcode = pio_openfile(sdat%pio_subsystem, pioid, sdat%io_type, trim(filename), pio_nowrite) @@ -1557,7 +1585,7 @@ 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) then + if (mainproc) then write(logout,'(3a)') trim(subname),' setting pio descriptor : ',trim(filename) end if call shr_strdata_set_stream_iodesc(sdat, per_stream, trim(per_stream%fldlist_stream(1)), & @@ -1589,8 +1617,8 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & ! ****************************************************************************** call ESMF_TraceRegionEnter(trim(istr)//'_readpio') - if (sdat%mainproc) then - write(logout,'(3a,i0)') trim(subname),'reading file ' // trim(boundstr) //': ',trim(filename),nt + if (mainproc) then + write(logout,'(3a,2x)') trim(subname),' reading file ' // trim(boundstr) //': ',trim(filename) endif if (ESMF_FieldIsCreated(per_stream%field_stream_vector)) then @@ -1652,7 +1680,7 @@ 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 + if (debug>0 .and. mainproc) then write(logout,'(3a,2x,i0)') trim(subname),& ' reading '//trim(per_stream%fldlist_stream(nf))//& ' into '//trim(per_stream%fldlist_model(nf)), & @@ -1680,7 +1708,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_real2d == fillvalue_r4)) then write(errmsg,*) ' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - if(sdat%mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) + if(mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) call shr_log_error(errmsg, rc=rc) return endif @@ -1715,7 +1743,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_real1d == fillvalue_r4)) then write(errmsg,*) ' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - if(sdat%mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) + if(mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) call shr_log_error(errmsg, rc=rc) return endif @@ -1989,7 +2017,6 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) integer, allocatable :: dimlens(:) type(ESMF_DistGrid) :: distGrid integer :: lsize - logical :: mainproc integer, pointer :: compdof(:) integer, pointer :: compdof3d(:) integer :: rCode ! pio return code (only used when pio error handling is PIO_BCAST_ERROR) @@ -2002,9 +2029,6 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) nullify(compdof) nullify(compdof3d) - ! set mainproc - mainproc = sdat%mainproc - ! set the number of vertical levels to a local variable stream_nlev = per_stream%stream_nlev @@ -2186,14 +2210,11 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, rc) ! local variables integer :: ns, nf logical :: found - logical :: mainproc character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_1d)' ! ---------------------------------------------- rc = ESMF_SUCCESS - mainproc = sdat%mainproc - ! 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. @@ -2228,14 +2249,11 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, rc) ! local variables integer :: ns, nf logical :: found - logical :: mainproc character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d)' ! ---------------------------------------------- rc = ESMF_SUCCESS - mainproc = sdat%mainproc - ! 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. diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index 66d775063..72fd7109f 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -213,7 +213,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu ! Set module variables logout and mainproc logout = logunit mainproc = isroot_task - if (mainproc) then Sdoc => parseFile(streamfilename, iostat=status) @@ -378,7 +377,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu endif ! 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 @@ -440,7 +439,13 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%pio_iotype = io_type streamdat(i)%pio_ioformat = io_format #endif + if (mainproc) then + write(logout,'(2a,i0)') trim(subname),' getting calendar for stream ',i + end if call shr_stream_getCalendar(streamdat(i), 1, streamdat(i)%calendar) + if (mainproc) then + write(logout,'(2a,i0,2a)') trim(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 @@ -449,7 +454,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu 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 @@ -465,6 +470,8 @@ subroutine shr_stream_init_from_inline(streamdat, & stream_fldlistFile, stream_fldListModel, stream_fileNames, & 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 ! this is used to initialize a stream directly from fortran interface @@ -495,19 +502,25 @@ subroutine shr_stream_init_from_inline(streamdat, & integer ,optional, intent(in) :: stream_dst_mask_val ! destination mask value ! local variables - integer :: n - integer :: nfiles - integer :: nvars - character(CS) :: calendar ! stream calendar + integer :: n + integer :: nfiles + integer :: nvars + character(CS) :: calendar ! stream calendar character(*),parameter :: subName = '(shr_stream_init_from_inline) ' ! -------------------------------------------------------- ! Set module variagble logout logout = logunit - ! Set module variable mainproc + ! Initialize module variable mainproc mainproc = isroot_task + ! 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 + ! mainproc = (localPet == main_task) + ! Assume only 1 stream allocate(streamdat(1)) @@ -1587,13 +1600,13 @@ subroutine shr_stream_getCalendar(strm, k, calendar) fileName = strm%file(k)%name if (.not. pio_file_is_open(strm%file(k)%fileid)) then - if (mainproc) then - write(logout,'(2a)') trim(subname),' opening stream filename = '//trim(filename) + if (debug>0 .and. mainproc) then + write(logout,'(3x,2a)') trim(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 (mainproc) then - write(logout,'(2a)') trim(subname),' reading stream filename = '//trim(filename) + if (debug>0 .and. mainproc) then + write(logout,'(3x,2a)') trim(subname),' reading stream filename = '//trim(filename) end if endif @@ -1614,7 +1627,7 @@ subroutine shr_stream_getCalendar(strm, k, calendar) if(n>0) then if (ichar(lcal(n:n)) == 0 ) lcal(n:n) = ' ' else - if (mainproc) then + if (debug>0 .and. mainproc) then write(logout,'(2a)') trim(subname),& 'calendar attribute to time variable not found in file, using default noleap' end if @@ -1624,8 +1637,8 @@ subroutine shr_stream_getCalendar(strm, k, calendar) call shr_string_leftalign_and_convert_tabs(lcal) calendar = trim(shr_cal_calendarName(trim(lcal))) - if (mainproc) then - write(logout, '(2a)') trim(subname),' closing stream filename = '//trim(filename) + if (debug>0 .and. mainproc) then + write(logout, '(3x,2a)') trim(subname),' closing stream filename = '//trim(filename) end if call pio_closefile(strm%file(k)%fileid) @@ -2092,7 +2105,7 @@ subroutine shr_stream_dataDump(strm) character(*),parameter :: subName = '(shr_stream_dataDump) ' !------------------------------------------------------------------------------- - if (debug > 0 .and. mainproc) then + if (debug>0 .and. mainproc) then write(logout,'(2a)') trim(subname),"dump internal data for debugging..." write(logout,'(2a,i0)') trim(subname)," nFiles = ", strm%nFiles do nf = 1,strm%nFiles From 69ca579c28d82408511054ec9a0fcc53a29daa3f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 23 Dec 2025 20:42:48 +0100 Subject: [PATCH 17/44] refactored shr_strdata_get_stream_pointer_1d and shr_strdata_get_stream_pointer_2d to have optional arguments requirePointer and errmsg and set default values to nan --- streams/dshr_strdata_mod.F90 | 125 +++++++++++++++++++++++++---------- 1 file changed, 90 insertions(+), 35 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index f430bed3a..f5099eb21 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -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 @@ -2197,81 +2196,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(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 (mainproc) then - write(logout,'(2a)') trim(subname),' 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 (mainproc) then + write(logout,'(2a)') trim(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 (mainproc) then + write(logout,'(2a)') trim(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(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 (mainproc) then - write(logout,'(2a)') trim(subname),' 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 (mainproc) then + write(logout,'(2a)') trim(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 (mainproc) then + write(logout,'(2a)') trim(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 From bc34f04ee0bfb7d2a10327cf250c0e7640f50ac9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Dec 2025 10:29:46 +0100 Subject: [PATCH 18/44] fixed compiler issue --- streams/dshr_strdata_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index f5099eb21..4bea381ae 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -2170,7 +2170,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if (stream_nlev > 1 .and. (trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then if (mainproc) then - write(logout,'(2a,2s,3(i0,2x),a)') trim(subname), & + write(logout,'(2a,2x,3(i0,2x),a)') trim(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 ' From 36bce684ac41436f4a75d55771de41d7adca66e0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Dec 2025 11:28:08 +0100 Subject: [PATCH 19/44] preset state pointer fields to nans --- datm/datm_datamode_cplhist_mod.F90 | 6 ------ streams/dshr_methods_mod.F90 | 24 +++++++++++++++++++++--- 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/datm/datm_datamode_cplhist_mod.F90 b/datm/datm_datamode_cplhist_mod.F90 index a260182e9..9f7e5ce0f 100644 --- a/datm/datm_datamode_cplhist_mod.F90 +++ b/datm/datm_datamode_cplhist_mod.F90 @@ -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,7 +36,6 @@ 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' @@ -87,7 +84,6 @@ 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 @@ -172,8 +168,6 @@ 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 diff --git a/streams/dshr_methods_mod.F90 b/streams/dshr_methods_mod.F90 index 59500d11d..848df90c6 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)' @@ -74,7 +77,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 +89,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 !=============================================================================== From bdd4317b47c0fc27d7dac468212f8a6c34c53d8c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Dec 2025 22:55:50 +0100 Subject: [PATCH 20/44] fix for drof to account for present values of nans for stream and export field pointers --- drof/rof_comp_nuopc.F90 | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/drof/rof_comp_nuopc.F90 b/drof/rof_comp_nuopc.F90 index 1a1cc6669..4b5852c84 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) From 354b57c1083ae2dda38bd61a6936082cffab7258 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Dec 2025 19:45:26 +0100 Subject: [PATCH 21/44] refactor dlnd to fix aborts to due presence of NaN's with new default settings --- dlnd/dlnd_datamode_glc_forcing_mod.F90 | 156 +++++++++--------- dlnd/dlnd_datamode_rof_forcing_mod.F90 | 216 +++++++++++++++---------- dlnd/lnd_comp_nuopc.F90 | 58 +++---- 3 files changed, 228 insertions(+), 202 deletions(-) diff --git a/dlnd/dlnd_datamode_glc_forcing_mod.F90 b/dlnd/dlnd_datamode_glc_forcing_mod.F90 index 541827759..0865c7a96 100644 --- a/dlnd/dlnd_datamode_glc_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_glc_forcing_mod.F90 @@ -5,9 +5,8 @@ module dlnd_datamode_glc_forcing_mod use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use dshr_methods_mod , only : dshr_state_getfldptr, chkerr - use dshr_strdata_mod , only : shr_strdata_type + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add use glc_elevclass_mod, only : glc_elevclass_as_string, glc_elevclass_init implicit none @@ -17,8 +16,19 @@ module dlnd_datamode_glc_forcing_mod public :: dlnd_datamode_glc_forcing_init_pointers public :: dlnd_datamode_glc_forcing_advance - ! module pointer arrays + ! export state pointer real(r8), pointer :: lfrac(:) + real(r8), pointer :: Sl_tsrf_elev(:,:) + real(r8), pointer :: Sl_topo_elev(:,:) + real(r8), pointer :: Flgl_qice_elev(:,:) + + ! stream pointers (1d) + type, public :: stream_pointer_type + real(r8), pointer :: strm_ptr(:) + end type stream_pointer_type + type(stream_pointer_type), allocatable :: strm_Sl_tsrf_elev(:) + type(stream_pointer_type), allocatable :: strm_Sl_topo_elev(:) + type(stream_pointer_type), allocatable :: strm_Flgl_qice_elev(:) integer :: glc_nec @@ -30,7 +40,8 @@ module dlnd_datamode_glc_forcing_mod contains !=============================================================================== - subroutine dlnd_datamode_glc_forcing_advertise(gcomp, exportState, fldsExport, flds_scalar_name, logunit, mainproc, rc) + subroutine dlnd_datamode_glc_forcing_advertise(gcomp, exportState, fldsExport, flds_scalar_name, & + logunit, mainproc, rc) ! determine export state to advertise to mediator @@ -86,24 +97,19 @@ subroutine dlnd_datamode_glc_forcing_advertise(gcomp, exportState, fldsExport, f end subroutine dlnd_datamode_glc_forcing_advertise !=============================================================================== - subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, dfields, model_frac, datamode, logunit, mainproc, rc) + subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac, datamode, rc) ! input/output variables type(ESMF_State) , intent(inout) :: exportState type(shr_strdata_type), intent(in) :: sdat - type(dfield_type) , pointer :: dfields real(r8) , intent(in) :: model_frac(:) character(len=*) , intent(in) :: datamode - integer , intent(in) :: logunit - logical , intent(in) :: mainproc integer , intent(out) :: rc ! local variables - integer :: n - character(len=2) :: nec_str - character(CS), allocatable :: strm_flds_topo(:) - character(CS), allocatable :: strm_flds_tsrf(:) - character(CS), allocatable :: strm_flds_qice(:) + integer :: ng + character(len=2) :: nec_str + character(CS) :: strm_fld character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_init_pointers): ' !------------------------------------------------------------------------------- @@ -113,85 +119,79 @@ subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, dfields, m call dshr_state_getfldptr(exportState, fldname='Sl_lfrin', fldptr1=lfrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return lfrac(:) = model_frac(:) + call dshr_state_getfldptr(exportState, 'Sl_tsrf_elev', fldptr2=Sl_tsrf_elev, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sl_topo_elev', fldptr2=Sl_topo_elev, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Flgl_qice_elev', fldptr2=Flgl_qice_elev, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Create stream-> export state mapping - ! Note that strm_flds is the model name for the stream field - ! Note that state_fld is the model name for the export field - - if (trim(datamode) == 'glc_forcing_mct') then - allocate(strm_flds_tsrf(0:glc_nec)) - allocate(strm_flds_topo(0:glc_nec)) - allocate(strm_flds_qice(0:glc_nec)) - do n = 0,glc_nec - write(nec_str, '(i2.2)') n - strm_flds_tsrf(n) = 'Sl_tsrf_elev' // trim(nec_str) - strm_flds_topo(n) = 'Sl_topo_elev' // trim(nec_str) - strm_flds_qice(n) = 'Flgl_qice_elev' // trim(nec_str) - end do - - else if (trim(datamode) == 'glc_forcing' ) then - allocate(strm_flds_tsrf(1:glc_nec+1)) - allocate(strm_flds_topo(1:glc_nec+1)) - allocate(strm_flds_qice(1:glc_nec+1)) - do n = 1,glc_nec+1 - write(nec_str, '(i0)') n - strm_flds_tsrf(n) = 'Sl_tsrf_elev' // trim(nec_str) - strm_flds_topo(n) = 'Sl_topo_elev' // trim(nec_str) - strm_flds_qice(n) = 'Flgl_qice_elev' // trim(nec_str) - end do - - end if + ! Obtain pointers to stream fields + + allocate(strm_Sl_tsrf_elev(glc_nec+1)) + allocate(strm_Sl_topo_elev(glc_nec+1)) + allocate(strm_Flgl_qice_elev(glc_nec+1)) + + do ng = 1,glc_nec+1 + if (trim(datamode) == 'glc_forcing_mct') then + write(nec_str,'(i2.2)') ng-1 + else + write(nec_str,'(i0)') ng + end if + strm_fld = 'Sl_tsrf_elev'//trim(nec_str) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_tsrf_elev(ng)%strm_ptr, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! The following maps stream input fields to export fields that have an ungridded dimension - call dshr_dfield_add(dfields, sdat, state_fld='Sl_tsrf_elev', strm_flds=strm_flds_tsrf, state=exportState, & - logunit=logunit, mainproc=mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_dfield_add(dfields, sdat, state_fld='Sl_topo_elev', strm_flds=strm_flds_topo, state=exportState, & - logunit=logunit, mainproc=mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call dshr_dfield_add(dfields, sdat, state_fld='Flgl_qice_elev', strm_flds=strm_flds_qice, state=exportState, & - logunit=logunit, mainproc=mainproc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + strm_fld = 'Sl_topo_elev'//trim(nec_str) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_topo_elev(ng)%strm_ptr, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(strm_flds_tsrf) - deallocate(strm_flds_topo) - deallocate(strm_flds_qice) + strm_fld = 'Flgl_qice_elev'//trim(nec_str) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Flgl_qice_elev(ng)%strm_ptr, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do end subroutine dlnd_datamode_glc_forcing_init_pointers !=============================================================================== - subroutine dlnd_datamode_glc_forcing_advance(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer , intent(out) :: rc + subroutine dlnd_datamode_glc_forcing_advance() ! local variables - integer :: n - real(r8), pointer :: fldptr2(:,:) - character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_advance): ' + integer :: ni,ng + Character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_advance): ' !------------------------------------------------------------------------------- - rc = ESMF_SUCCESS - ! Set special value over masked points - call dshr_state_getfldptr(exportState, 'Sl_tsrf_elev', fldptr2=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fldptr2,dim=2) - if (lfrac(n) == 0._r8) fldptr2(:,n) = 1.e30_r8 - end do + ! Note that the inner dimension is the elevation class + + elev_class_loop: do ng = 1,glc_nec+1 + do ni = 1,size(Sl_tsrf_elev,dim=2) + if (lfrac(ni) == 0._r8) then + Sl_tsrf_elev(ng,ni) = 1.e30_r8 + else + Sl_tsrf_elev(ng,ni) = strm_Sl_tsrf_elev(ng)%strm_ptr(ni) + end if + end do - call dshr_state_getfldptr(exportState, 'Sl_topo_elev', fldptr2=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fldptr2,dim=2) - if (lfrac(n) == 0._r8) fldptr2(:,n) = 1.e30_r8 - end do + do ni = 1,size(Sl_topo_elev,dim=2) + if (lfrac(ni) == 0._r8) then + Sl_topo_elev(ng,ni) = 1.e30_r8 + else + Sl_topo_elev(ng,ni) = strm_Sl_topo_elev(ng)%strm_ptr(ni) + end if + end do - call dshr_state_getfldptr(exportState, 'Flgl_qice_elev', fldptr2=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fldptr2,dim=2) - if (lfrac(n) == 0._r8) fldptr2(:,n) = 1.e30_r8 - end do + do ni = 1,size(Flgl_qice_elev,dim=2) + if (lfrac(ni) == 0._r8) then + Flgl_qice_elev(ng,ni) = 1.e30_r8 + else + Flgl_qice_elev(ng,ni) = strm_Flgl_qice_elev(ng)%strm_ptr(ni) + end if + end do + end do elev_class_loop end subroutine dlnd_datamode_glc_forcing_advance diff --git a/dlnd/dlnd_datamode_rof_forcing_mod.F90 b/dlnd/dlnd_datamode_rof_forcing_mod.F90 index 2576e5ac5..c82f8a764 100644 --- a/dlnd/dlnd_datamode_rof_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_rof_forcing_mod.F90 @@ -6,9 +6,8 @@ module dlnd_datamode_rof_forcing_mod use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_string_mod , only : shr_string_listGetNum, shr_string_listGetName use dshr_methods_mod , only : dshr_state_getfldptr, chkerr - use dshr_strdata_mod , only : shr_strdata_type + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add use shr_lnd2rof_tracers_mod , only : shr_lnd2rof_tracers_readnl implicit none @@ -18,18 +17,27 @@ module dlnd_datamode_rof_forcing_mod public :: dlnd_datamode_rof_forcing_init_pointers public :: dlnd_datamode_rof_forcing_advance - ! module pointer arrays + ! export state pointers real(r8), pointer :: lfrac(:) - - character(*), parameter :: Flrl_rofsur_nonh2o = 'Flrl_rofsur_nonh2o' - character(*), parameter :: Flrl_rofsur = 'Flrl_rofsur' - character(*), parameter :: Flrl_rofsub = 'Flrl_rofsub' - character(*), parameter :: Flrl_rofgwl = 'Flrl_rofgwl' - character(*), parameter :: Flrl_rofi = 'Flrl_rofi' - character(*), parameter :: Flrl_irrig = 'Flrl_irrig' - - character(len=11) :: fldnames_h2o(5) = & - (/'Flrl_rofsur', 'Flrl_rofsub','Flrl_rofgwl','Flrl_rofi ','Flrl_irrig '/) + real(r8), pointer :: Flrl_rofsur_nonh2o_2d(:,:) + real(r8), pointer :: Flrl_rofsur_nonh2o_1d(:) + real(r8), pointer :: Flrl_rofsur(:) + real(r8), pointer :: Flrl_rofsub(:) + real(r8), pointer :: Flrl_rofgwl(:) + real(r8), pointer :: Flrl_rofi(:) + real(r8), pointer :: Flrl_irrig(:) + + ! stream field pointers + type, public :: stream_pointer_type + real(r8), pointer :: strm_ptr(:) + end type stream_pointer_type + type(stream_pointer_type), allocatable :: strm_Flrl_rofsur_nonh2o_2d(:) ! 2dple nonh2o tracers + real(r8), pointer :: strm_Flrl_rofsur_nonh2o_1d(:) ! onlyl 1 nonh2o tracer + real(r8), pointer :: strm_Flrl_rofsur(:) + real(r8), pointer :: strm_Flrl_rofsub(:) + real(r8), pointer :: strm_Flrl_rofgwl(:) + real(r8), pointer :: strm_Flrl_rofi(:) + real(r8), pointer :: strm_Flrl_irrig(:) integer :: ntracers_nonh2o @@ -82,15 +90,15 @@ subroutine dlnd_datamode_rof_forcing_advertise(exportState, fldsExport, flds_sca ! The following puts all non-water tracers as an undidstributed dimension in the export state field if (ntracers_nonh2o > 1) then - call dshr_fldList_add(fldsExport, Flrl_rofsur_nonh2o, ungridded_lbound=1, ungridded_ubound=ntracers_nonh2o) + call dshr_fldList_add(fldsExport, 'Flrl_rofsur_nonh2o', ungridded_lbound=1, ungridded_ubound=ntracers_nonh2o) else if (ntracers_nonh2o == 1) then - call dshr_fldList_add(fldsExport, Flrl_rofsur_nonh2o) + call dshr_fldList_add(fldsExport, 'Flrl_rofsur_nonh2o') end if - call dshr_fldlist_add(FldsExport, Flrl_rofsur) - call dshr_fldlist_add(FldsExport, Flrl_rofsub) - call dshr_fldlist_add(FldsExport, Flrl_rofgwl) - call dshr_fldlist_add(FldsExport, Flrl_rofi ) - call dshr_fldlist_add(FldsExport, Flrl_irrig ) + call dshr_fldlist_add(FldsExport, 'Flrl_rofsur') + call dshr_fldlist_add(FldsExport, 'Flrl_rofsub') + call dshr_fldlist_add(FldsExport, 'Flrl_rofgwl') + call dshr_fldlist_add(FldsExport, 'Flrl_rofi' ) + call dshr_fldlist_add(FldsExport, 'Flrl_irrig' ) fldlist => fldsExport ! the head of the linked list do while (associated(fldlist)) @@ -107,105 +115,139 @@ end subroutine dlnd_datamode_rof_forcing_advertise !=============================================================================== - subroutine dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, dfields, model_frac, logunit, mainproc, rc) + subroutine dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, model_frac, rc) ! input/output variables type(ESMF_State) , intent(inout) :: exportState type(shr_strdata_type), intent(in) :: sdat - type(dfield_type) , pointer :: dfields real(r8) , intent(in) :: model_frac(:) - integer , intent(in) :: logunit - logical , intent(in) :: mainproc integer , intent(out) :: rc ! local variables - integer :: n - character(len=2) :: nchar - character(CS), allocatable :: strm_flds(:) - character(CS) :: fieldname + integer :: nf + character(len=2) :: nchar + character(CS) :: strm_fld character(len=*), parameter :: subname='(dlnd_datamode_rof_forcing_init_pointers): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! Set fractional land pointer in export state + ! Set pointers to export state call dshr_state_getfldptr(exportState, fldname='Sl_lfrin', fldptr1=lfrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - lfrac(:) = model_frac(:) - - ! Create stream-> export state mapping for the case where the - ! stream field is 1d but the export state field is 2d - ! Note that strm_flds is the model name for the stream field (1d) - ! Note that state_fld is the model name for the export field (2d) - if (ntracers_nonh2o > 0) then - if (ntracers_nonh2o == 1) then - fieldname = trim(Flrl_rofsur_nonh2o) - call dshr_dfield_add( dfields, sdat, trim(fieldname), trim(fieldname), exportState, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - allocate(strm_flds(ntracers_nonh2o)) - do n = 1,ntracers_nonh2o - write(nchar,'(i2.2)') n - strm_flds(n) = trim(Flrl_rofsur_nonh2o) // trim(nchar) - end do - call dshr_dfield_add(dfields, sdat, state_fld=Flrl_rofsur_nonh2o, strm_flds=strm_flds, state=exportState, & - logunit=logunit, mainproc=mainproc, rc=rc) + lfrac(:) = model_frac(:) ! Set fractional land pointer in export state + if (ntracers_nonh2o > 1) then + call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur_nonh2o', fldptr2=Flrl_rofsur_nonh2o_2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur_nonh2o', fldptr1=Flrl_rofsur_nonh2o_1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur', fldptr1=Flrl_rofsur, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, fldname='Flrl_rofsub', fldptr1=Flrl_rofsub, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, fldname='Flrl_rofgwl', fldptr1=Flrl_rofgwl, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, fldname='Flrl_rofi', fldptr1=Flrl_rofi, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, fldname='Flrl_irrig', fldptr1=Flrl_irrig, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set pointers to required stream fields + + if (ntracers_nonh2o > 1) then + allocate(strm_Flrl_rofsur_nonh2o_2d(ntracers_nonh2o)) + do nf = 1,ntracers_nonh2o + write(nchar,'(i2.2)') nf + strm_fld = trim('Flrl_rofsur_nonh2o') // trim(nchar) + call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Flrl_rofsur_nonh2o_2d(nf)%strm_ptr, & + requirePointer=.true., & + errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//& + ' must be associated for dlnd rof_forcing datamode', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + end do + else if (ntracers_nonh2o == 1) then + call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofsur_nonh2o' , strm_Flrl_rofsur_nonh2o_1d, & + requirePointer=.true., & + errmsg=trim(subname)//'ERROR: strm_Flrl_rofsur_1d '// & + ' must be associated for dlnd rof_forcing mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Initialize dfields data type (to map streams to export state fields) - ! Create dfields linked list - used for copying stream fields to export state fields - do n = 1,size(fldnames_h2o) - fieldname = trim(fldnames_h2o(n)) - call dshr_dfield_add( dfields, sdat, trim(fieldname), trim(fieldname), exportState, logunit, mainproc, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do + call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofsur' , strm_Flrl_rofsur, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: strm_Flrl_rofsur be associated for dlnd rof_forcing mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofsub' , strm_Flrl_rofsub, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: strm_Flrl_rofsub be associated for dlnd rof_forcing mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofgwl' , strm_Flrl_rofgwl, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: strm_Flrl_rofgwl be associated for dlnd rof_forcing mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Flrl_rofi' , strm_Flrl_rofi, requirePointer=.true., & + errmsg=trim(subname)//'ERROR: strm_Flrl_rofi be associated for dlnd rof_forcing mode', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! optional stream field pointer + call shr_strdata_get_stream_pointer(sdat, 'Flrl_irrig' , strm_Flrl_irrig, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine dlnd_datamode_rof_forcing_init_pointers !=============================================================================== - subroutine dlnd_datamode_rof_forcing_advance(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer , intent(out) :: rc + subroutine dlnd_datamode_rof_forcing_advance() ! local variables - integer :: n,nfld - real(r8), pointer :: fldptr1(:) - real(r8), pointer :: fldptr2(:,:) - character(CS) :: fieldname + integer :: ni,nf character(len=*), parameter :: subname='(dlnd_datamode_rof_forcing_advance): ' !------------------------------------------------------------------------------- - rc = ESMF_SUCCESS - - if (ntracers_nonh2o > 0) then - ! Set special value over masked points - if (ntracers_nonh2o == 1) then - call dshr_state_getfldptr(exportState, Flrl_rofsur_nonh2o, fldptr1=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fldptr1) - if (lfrac(n) == 0._r8) fldptr1(n) = 1.e30_r8 + if (ntracers_nonh2o > 1) then + ! Note that the inner dimension is the field index + do nf = 1,ntracers_nonh2o + do ni = 1,size(Flrl_rofsur_nonh2o_2d,dim=2) + if (lfrac(ni) == 0._r8) then + Flrl_rofsur_nonh2o_2d(nf,ni) = 1.e30_r8 + else + Flrl_rofsur_nonh2o_2d(nf,ni) = strm_Flrl_rofsur_nonh2o_2d(nf)%strm_ptr(ni) + end if end do + end do + else if (ntracers_nonh2o == 1) then + do ni = 1,size(Flrl_rofsur_nonh2o_1d) + if (lfrac(ni) == 0._r8) then + Flrl_rofsur_nonh2o_1d(ni) = 1.e30_r8 + else + Flrl_rofsur_nonh2o_1d(ni) = strm_Flrl_rofsur_nonh2o_1d(ni) + end if + end do + end if + + do ni = 1,size(Flrl_rofsur) + if (lfrac(ni) == 0._r8) then + Flrl_rofsur(ni) = 1.e30_r8 + Flrl_rofsub(ni) = 1.e30_r8 + Flrl_rofgwl(ni) = 1.e30_r8 + Flrl_rofi(ni) = 1.e30_r8 else - call dshr_state_getfldptr(exportState, Flrl_rofsur_nonh2o, fldptr2=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fldptr2,dim=2) - if (lfrac(n) == 0._r8) fldptr2(:,n) = 1.e30_r8 - end do + Flrl_rofsur(ni) = strm_Flrl_rofsur(ni) + Flrl_rofsub(ni) = strm_Flrl_rofsub(ni) + Flrl_rofgwl(ni) = strm_Flrl_rofgwl(ni) + Flrl_rofi(ni) = strm_Flrl_rofi(ni) end if - end if + end do - do nfld = 1,size(fldnames_h2o) - fieldname = trim(fldnames_h2o(nfld)) - call dshr_state_getfldptr(exportState, fieldname, fldptr1=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(fldptr1) - if (lfrac(n) == 0._r8) fldptr1(n) = 1.e30_r8 + if (associated(strm_Flrl_irrig)) then + do ni = 1,size(Flrl_rofsur) + if (lfrac(ni) == 0._r8) then + Flrl_irrig(ni) = 1.e30_r8 + else + Flrl_irrig(ni) = strm_Flrl_irrig(ni) + end if end do - end do + else + Flrl_irrig(:) = 0._r8 + end if end subroutine dlnd_datamode_rof_forcing_advance diff --git a/dlnd/lnd_comp_nuopc.F90 b/dlnd/lnd_comp_nuopc.F90 index bc40bb32e..d77c85e2a 100644 --- a/dlnd/lnd_comp_nuopc.F90 +++ b/dlnd/lnd_comp_nuopc.F90 @@ -26,13 +26,11 @@ module cdeps_dlnd_comp use shr_kind_mod , only : cx=>shr_kind_cx use shr_cal_mod , only : shr_cal_ymd2date use shr_log_mod , only : shr_log_setLogUnit, shr_log_error - use dshr_methods_mod , only : dshr_state_getfldptr, dshr_state_diagnose, chkerr, memcheck - use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance, shr_strdata_get_stream_domain - use dshr_strdata_mod , only : shr_strdata_init_from_config + use dshr_methods_mod , only : dshr_state_diagnose, chkerr, memcheck + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance, shr_strdata_init_from_config use dshr_mod , only : dshr_model_initphase, dshr_init, dshr_check_restart_alarm use dshr_mod , only : dshr_state_setscalar, dshr_set_runclock, dshr_log_clock_advance use dshr_mod , only : dshr_restart_read, dshr_restart_write, dshr_mesh_init - use dshr_dfield_mod , only : dfield_type, dshr_dfield_add, dshr_dfield_copy use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add, dshr_fldlist_realize ! Datamode specialized modules @@ -91,7 +89,6 @@ module cdeps_dlnd_comp ! linked lists type(fldList_type) , pointer :: fldsExport => null() - type(dfield_type) , pointer :: dfields => null() ! model mask and model fraction real(r8), pointer :: model_frac(:) => null() @@ -172,9 +169,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: bcasttmp(4) integer :: ierr ! error code character(len=*) , parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - character(*) , parameter :: F00 = "('(" // trim(modName) // ") ',8a)" - character(*) , parameter :: F01 = "('(" // trim(modName) // ") ',a,2x,i8)" - character(*) , parameter :: F02 = "('(" // trim(modName) // ") ',a,l6)" !------------------------------------------------------------------------------- namelist / dlnd_nml / datamode, model_meshfile, model_maskfile, & @@ -235,14 +229,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! write namelist input to standard out if (my_task == main_task) then - write(logunit,F00)' model_meshfile = ',trim(model_meshfile) - write(logunit,F00)' model_maskfile = ',trim(model_maskfile) - write(logunit,F00)' datamode = ',datamode - write(logunit,F01)' nx_global = ',nx_global - write(logunit,F01)' ny_global = ',ny_global - write(logunit,F00)' restfilm = ',trim(restfilm) - write(logunit,F02)' skip_restart_read = ',skip_restart_read - write(logunit,F02)' export_all = ',export_all + write(logunit,'(3a)') trim(subname),' model_meshfile = ',trim(model_meshfile) + write(logunit,'(3a)') trim(subname),' model_maskfile = ',trim(model_maskfile) + write(logunit,'(3a)') trim(subname),' datamode = ',datamode + write(logunit,'(2a,i0)') trim(subname),' nx_global = ',nx_global + write(logunit,'(2a,i0)') trim(subname),' ny_global = ',ny_global + write(logunit,'(3a)') trim(subname),' restfilm = ',trim(restfilm) + write(logunit,'(2a,l6)') trim(subname),' skip_restart_read = ',skip_restart_read + write(logunit,'(2a,l6)') trim(subname),' export_all = ',export_all endif ! Validate sdat datamode @@ -458,16 +452,13 @@ subroutine dlnd_comp_run(importState, exportState, target_ymd, target_tod, rc) !-------------------- if (first_time) then - ! Initialize datamode module pointers AND dfields + ! Initialize datamode export state and stream pointers select case (trim(datamode)) - case('glc_forcing_mct') - call dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, dfields, model_frac, datamode, logunit, mainproc, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - case('glc_forcing') - call dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, dfields, model_frac, datamode, logunit, mainproc, rc) + case('glc_forcing_mct','glc_forcing') + call dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac, datamode, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case('rof_forcing') - call dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, dfields, model_frac, logunit, mainproc, rc) + call dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end select @@ -484,20 +475,13 @@ subroutine dlnd_comp_run(importState, exportState, target_ymd, target_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TraceRegionExit('dlnd_strdata_advance') - ! copy all fields from streams to export state as default - ! This automatically will update the fields in the export state - call ESMF_TraceRegionEnter('dlnd_dfield_copy') - call dshr_dfield_copy(dfields, sdat, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TraceRegionExit('dlnd_dfield_copy') - - if (trim(datamode) == 'glc_forcing_mct' .or. trim(datamode) == 'glc_forcing' ) then - call dlnd_datamode_glc_forcing_advance(exportState, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(datamode) == 'rof_forcing') then - call dlnd_datamode_rof_forcing_advance(exportState, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! determine data model behavior based on the mode + select case (trim(datamode)) + case('glc_forcing_mct','glc_forcing') + call dlnd_datamode_glc_forcing_advance() + case('rof_forcing') + call dlnd_datamode_rof_forcing_advance() + end select call ESMF_TraceRegionExit('DLND_RUN') From 2399934fe16ee9ff79e8fe02f5d330b6ef47ca10 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Dec 2025 21:44:14 +0100 Subject: [PATCH 22/44] more updates to the share code --- streams/dshr_methods_mod.F90 | 8 +++++--- streams/dshr_strdata_mod.F90 | 25 ------------------------- 2 files changed, 5 insertions(+), 28 deletions(-) diff --git a/streams/dshr_methods_mod.F90 b/streams/dshr_methods_mod.F90 index 6cd4c2b01..848df90c6 100644 --- a/streams/dshr_methods_mod.F90 +++ b/streams/dshr_methods_mod.F90 @@ -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,7 +52,7 @@ 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 @@ -90,12 +92,12 @@ subroutine dshr_state_getfldptr(State, fldname, fldptr1, fldptr2, allowNullRetur ! Initialize pointer value if (present(fldptr1)) then do ni = 1,size(fldptr1) - fldptr1(ni) = huge(1._r8) + 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) = huge(1._r8) + fldptr2(ni,nj) = nan end do end do end if diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 31fc07f57..4bea381ae 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -2279,25 +2279,12 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & ! local variables integer :: ns, nf, ni, nj -<<<<<<< HEAD - integer :: logunit - logical :: mainproc logical :: found character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d) ' - character(*) , parameter :: F00 = "('(shr_strdata_get_stream_pointer_2d) ',8a)" -======= - logical :: found - character(len=*), parameter :: subname='(shr_strdata_get_stream_pointer_2d) ' ->>>>>>> mvertens/feature/fix_unstructured_multilev_input ! ---------------------------------------------- rc = ESMF_SUCCESS -<<<<<<< HEAD - logunit = sdat%stream(1)%logunit - mainproc = sdat%mainproc -======= ->>>>>>> mvertens/feature/fix_unstructured_multilev_input found = .false. ! loop over all input streams and determine if the strm_fld is in the field bundle of the target stream @@ -2317,20 +2304,12 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & if (found) then ! If pointer found, preset value if (mainproc) then -<<<<<<< HEAD - write(logunit,F00)' strm_ptr is allocated and preset to huge 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) = huge(1._r8) -======= write(logout,'(2a)') trim(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 ->>>>>>> mvertens/feature/fix_unstructured_multilev_input end do end do else @@ -2339,11 +2318,7 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & if (requirePointer) then if (present(errmsg)) then if (mainproc) then -<<<<<<< HEAD - write(logunit,F00) trim(errmsg) -======= write(logout,'(2a)') trim(subname),trim(errmsg) ->>>>>>> mvertens/feature/fix_unstructured_multilev_input end if end if call shr_log_error(subName//"ERROR: pointer not found for "//trim(strm_fld), rc=rc) From 069321478b2c8733198f0c7e3383fad0a459a3b5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 29 Dec 2025 18:08:14 +0100 Subject: [PATCH 23/44] addressed issues in PR review --- dlnd/dlnd_datamode_glc_forcing_mod.F90 | 32 ++- dlnd/dlnd_datamode_rof_forcing_mod.F90 | 63 +++-- dshr/dshr_dfield_mod.F90 | 20 +- streams/dshr_methods_mod.F90 | 6 + streams/dshr_strdata_mod.F90 | 317 +++++++++++++++++----- streams/dshr_stream_mod.F90 | 351 +++++++++++++++++-------- 6 files changed, 576 insertions(+), 213 deletions(-) diff --git a/dlnd/dlnd_datamode_glc_forcing_mod.F90 b/dlnd/dlnd_datamode_glc_forcing_mod.F90 index 0865c7a96..06693cf45 100644 --- a/dlnd/dlnd_datamode_glc_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_glc_forcing_mod.F90 @@ -4,6 +4,8 @@ module dlnd_datamode_glc_forcing_mod use ESMF , only : ESMF_StateItem_Flag, ESMF_GridComp use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_log_mod , only : shr_log_error + use shr_const_mod , only : SHR_CONST_SPVAL 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 @@ -17,14 +19,14 @@ module dlnd_datamode_glc_forcing_mod public :: dlnd_datamode_glc_forcing_advance ! export state pointer - real(r8), pointer :: lfrac(:) - real(r8), pointer :: Sl_tsrf_elev(:,:) - real(r8), pointer :: Sl_topo_elev(:,:) - real(r8), pointer :: Flgl_qice_elev(:,:) + real(r8), pointer :: lfrac(:) => null() + real(r8), pointer :: Sl_tsrf_elev(:,:) => null() + real(r8), pointer :: Sl_topo_elev(:,:) => null() + real(r8), pointer :: Flgl_qice_elev(:,:) => null() ! stream pointers (1d) type, public :: stream_pointer_type - real(r8), pointer :: strm_ptr(:) + real(r8), pointer :: strm_ptr(:) => null() end type stream_pointer_type type(stream_pointer_type), allocatable :: strm_Sl_tsrf_elev(:) type(stream_pointer_type), allocatable :: strm_Sl_topo_elev(:) @@ -110,6 +112,7 @@ subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac integer :: ng character(len=2) :: nec_str character(CS) :: strm_fld + integer :: istat character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_init_pointers): ' !------------------------------------------------------------------------------- @@ -128,9 +131,14 @@ subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac ! Obtain pointers to stream fields - allocate(strm_Sl_tsrf_elev(glc_nec+1)) - allocate(strm_Sl_topo_elev(glc_nec+1)) - allocate(strm_Flgl_qice_elev(glc_nec+1)) + allocate(strm_Sl_tsrf_elev(glc_nec+1), & + strm_Sl_topo_elev(glc_nec+1), & + strm_Flgl_qice_elev(glc_nec+1), stat=istat) + if ( istat /= 0 ) then + call shr_log_error(subName//& + ': allocation error for strm_Sl_tsrf_elev, Strm_Sl_topo_elev and strm_Flgl_qice_elev',rc=rc) + return + end if do ng = 1,glc_nec+1 if (trim(datamode) == 'glc_forcing_mct') then @@ -161,7 +169,7 @@ subroutine dlnd_datamode_glc_forcing_advance() ! local variables integer :: ni,ng - Character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_advance): ' + character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_advance): ' !------------------------------------------------------------------------------- ! Set special value over masked points @@ -170,7 +178,7 @@ subroutine dlnd_datamode_glc_forcing_advance() elev_class_loop: do ng = 1,glc_nec+1 do ni = 1,size(Sl_tsrf_elev,dim=2) if (lfrac(ni) == 0._r8) then - Sl_tsrf_elev(ng,ni) = 1.e30_r8 + Sl_tsrf_elev(ng,ni) = SHR_CONST_SPVAL else Sl_tsrf_elev(ng,ni) = strm_Sl_tsrf_elev(ng)%strm_ptr(ni) end if @@ -178,7 +186,7 @@ subroutine dlnd_datamode_glc_forcing_advance() do ni = 1,size(Sl_topo_elev,dim=2) if (lfrac(ni) == 0._r8) then - Sl_topo_elev(ng,ni) = 1.e30_r8 + Sl_topo_elev(ng,ni) = SHR_CONST_SPVAL else Sl_topo_elev(ng,ni) = strm_Sl_topo_elev(ng)%strm_ptr(ni) end if @@ -186,7 +194,7 @@ subroutine dlnd_datamode_glc_forcing_advance() do ni = 1,size(Flgl_qice_elev,dim=2) if (lfrac(ni) == 0._r8) then - Flgl_qice_elev(ng,ni) = 1.e30_r8 + Flgl_qice_elev(ng,ni) = SHR_CONST_SPVAL else Flgl_qice_elev(ng,ni) = strm_Flgl_qice_elev(ng)%strm_ptr(ni) end if diff --git a/dlnd/dlnd_datamode_rof_forcing_mod.F90 b/dlnd/dlnd_datamode_rof_forcing_mod.F90 index c82f8a764..bb6b09427 100644 --- a/dlnd/dlnd_datamode_rof_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_rof_forcing_mod.F90 @@ -1,10 +1,12 @@ module dlnd_datamode_rof_forcing_mod - use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_State + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_State use ESMF , only : ESMF_StateItem_Flag use NUOPC , only : NUOPC_Advertise use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_string_mod , only : shr_string_listGetNum, shr_string_listGetName + use shr_log_mod , only : shr_log_error + use shr_const_mod , only : SHR_CONST_SPVAL 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 @@ -18,26 +20,27 @@ module dlnd_datamode_rof_forcing_mod public :: dlnd_datamode_rof_forcing_advance ! export state pointers - real(r8), pointer :: lfrac(:) - real(r8), pointer :: Flrl_rofsur_nonh2o_2d(:,:) - real(r8), pointer :: Flrl_rofsur_nonh2o_1d(:) - real(r8), pointer :: Flrl_rofsur(:) - real(r8), pointer :: Flrl_rofsub(:) - real(r8), pointer :: Flrl_rofgwl(:) - real(r8), pointer :: Flrl_rofi(:) - real(r8), pointer :: Flrl_irrig(:) + real(r8), pointer :: lfrac(:) => null() + real(r8), pointer :: Flrl_rofsur_nonh2o_2d(:,:) => null() + real(r8), pointer :: Flrl_rofsur_nonh2o_1d(:) => null() + real(r8), pointer :: Flrl_rofsur(:) => null() + real(r8), pointer :: Flrl_rofsub(:) => null() + real(r8), pointer :: Flrl_rofgwl(:) => null() + real(r8), pointer :: Flrl_rofi(:) => null() + real(r8), pointer :: Flrl_irrig(:) => null() ! stream field pointers type, public :: stream_pointer_type - real(r8), pointer :: strm_ptr(:) + real(r8), pointer :: strm_ptr(:) => null() end type stream_pointer_type type(stream_pointer_type), allocatable :: strm_Flrl_rofsur_nonh2o_2d(:) ! 2dple nonh2o tracers - real(r8), pointer :: strm_Flrl_rofsur_nonh2o_1d(:) ! onlyl 1 nonh2o tracer - real(r8), pointer :: strm_Flrl_rofsur(:) - real(r8), pointer :: strm_Flrl_rofsub(:) - real(r8), pointer :: strm_Flrl_rofgwl(:) - real(r8), pointer :: strm_Flrl_rofi(:) - real(r8), pointer :: strm_Flrl_irrig(:) + + real(r8), pointer :: strm_Flrl_rofsur_nonh2o_1d(:) => null() ! onlyl 1 nonh2o tracer + real(r8), pointer :: strm_Flrl_rofsur(:) => null() + real(r8), pointer :: strm_Flrl_rofsub(:) => null() + real(r8), pointer :: strm_Flrl_rofgwl(:) => null() + real(r8), pointer :: strm_Flrl_rofi(:) => null() + real(r8), pointer :: strm_Flrl_irrig(:) => null() integer :: ntracers_nonh2o @@ -64,6 +67,7 @@ subroutine dlnd_datamode_rof_forcing_advertise(exportState, fldsExport, flds_sca ! local variables character(len=CS) :: lnd2rof_tracers type(fldlist_type), pointer :: fldList + character(len=*), parameter :: subname='(dlnd_datamode_rof_forcing_init_pointers): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -77,6 +81,11 @@ subroutine dlnd_datamode_rof_forcing_advertise(exportState, fldsExport, flds_sca call shr_lnd2rof_tracers_readnl('drv_flds_in', lnd2rof_tracers) if (lnd2rof_tracers /= ' ') then ntracers_nonh2o = shr_string_listGetNum(lnd2rof_tracers) + if (ntracers_nonh2o > 99) then + rc = ESMF_FAILURE + call shr_log_error(subName//': ERROR: number of tracers must be less than 99', rc=rc) + return + end if else ntracers_nonh2o = 0 end if @@ -127,6 +136,7 @@ subroutine dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, model_frac integer :: nf character(len=2) :: nchar character(CS) :: strm_fld + integer :: istat character(len=*), parameter :: subname='(dlnd_datamode_rof_forcing_init_pointers): ' !------------------------------------------------------------------------------- @@ -157,7 +167,12 @@ subroutine dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, model_frac ! Set pointers to required stream fields if (ntracers_nonh2o > 1) then - allocate(strm_Flrl_rofsur_nonh2o_2d(ntracers_nonh2o)) + allocate(strm_Flrl_rofsur_nonh2o_2d(ntracers_nonh2o), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//': allocation error for strm_Flrl_rofsur_nonh2o_2d', rc=rc) + return + end if do nf = 1,ntracers_nonh2o write(nchar,'(i2.2)') nf strm_fld = trim('Flrl_rofsur_nonh2o') // trim(nchar) @@ -207,7 +222,7 @@ subroutine dlnd_datamode_rof_forcing_advance() do nf = 1,ntracers_nonh2o do ni = 1,size(Flrl_rofsur_nonh2o_2d,dim=2) if (lfrac(ni) == 0._r8) then - Flrl_rofsur_nonh2o_2d(nf,ni) = 1.e30_r8 + Flrl_rofsur_nonh2o_2d(nf,ni) = SHR_CONST_SPVAL else Flrl_rofsur_nonh2o_2d(nf,ni) = strm_Flrl_rofsur_nonh2o_2d(nf)%strm_ptr(ni) end if @@ -216,7 +231,7 @@ subroutine dlnd_datamode_rof_forcing_advance() else if (ntracers_nonh2o == 1) then do ni = 1,size(Flrl_rofsur_nonh2o_1d) if (lfrac(ni) == 0._r8) then - Flrl_rofsur_nonh2o_1d(ni) = 1.e30_r8 + Flrl_rofsur_nonh2o_1d(ni) = SHR_CONST_SPVAL else Flrl_rofsur_nonh2o_1d(ni) = strm_Flrl_rofsur_nonh2o_1d(ni) end if @@ -225,10 +240,10 @@ subroutine dlnd_datamode_rof_forcing_advance() do ni = 1,size(Flrl_rofsur) if (lfrac(ni) == 0._r8) then - Flrl_rofsur(ni) = 1.e30_r8 - Flrl_rofsub(ni) = 1.e30_r8 - Flrl_rofgwl(ni) = 1.e30_r8 - Flrl_rofi(ni) = 1.e30_r8 + Flrl_rofsur(ni) = SHR_CONST_SPVAL + Flrl_rofsub(ni) = SHR_CONST_SPVAL + Flrl_rofgwl(ni) = SHR_CONST_SPVAL + Flrl_rofi(ni) = SHR_CONST_SPVAL else Flrl_rofsur(ni) = strm_Flrl_rofsur(ni) Flrl_rofsub(ni) = strm_Flrl_rofsub(ni) @@ -240,7 +255,7 @@ subroutine dlnd_datamode_rof_forcing_advance() if (associated(strm_Flrl_irrig)) then do ni = 1,size(Flrl_rofsur) if (lfrac(ni) == 0._r8) then - Flrl_irrig(ni) = 1.e30_r8 + Flrl_irrig(ni) = SHR_CONST_SPVAL else Flrl_irrig(ni) = strm_Flrl_irrig(ni) end if diff --git a/dshr/dshr_dfield_mod.F90 b/dshr/dshr_dfield_mod.F90 index 476707a3b..b10ca3160 100644 --- a/dshr/dshr_dfield_mod.F90 +++ b/dshr/dshr_dfield_mod.F90 @@ -117,7 +117,7 @@ subroutine dshr_dfield_add_1d(dfields, sdat, state_fld, strm_fld, state, logunit if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data1d = 0.0_r8 if (mainproc) then - write(logunit,'(2a)') trim(subname),' 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_1d @@ -194,7 +194,7 @@ subroutine dshr_dfield_add_1d_stateptr(dfields, sdat, state_fld, strm_fld, state if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data1d = 0.0_r8 if (mainproc) then - write(logunit,'(2a)') trim(subname),' setting pointer for export state '//trim(state_fld) + write(logunit,'(3a)') trim(subname),' setting pointer for export state ',trim(state_fld) end if ! Return array pointer if argument is present @@ -203,8 +203,8 @@ subroutine dshr_dfield_add_1d_stateptr(dfields, sdat, state_fld, strm_fld, state ! write output if (mainproc) then if (found) then - write(logunit,'(2a,i0,a,i0)') trim(subname),& - ' setting 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 end if write(logunit,*) @@ -297,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,'(2a)') trim(subname),& - ' 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 @@ -314,7 +314,7 @@ subroutine dshr_dfield_add_2d(dfields, sdat, state_fld, strm_flds, state, & if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data2d(:,:) = 0._r8 if (mainproc) then - write(logunit,'(2a)') trim(subname),' 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 @@ -404,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,'(2a)') trim(subname), & - ' 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 @@ -421,7 +421,7 @@ subroutine dshr_dfield_add_2d_stateptr(dfields, sdat, state_fld, strm_flds, stat if (chkerr(rc,__LINE__,u_FILE_u)) return dfield_new%state_data2d(:,:) = 0._r8 if (mainproc) then - write(logunit,'(2a)') trim(subname),' 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/streams/dshr_methods_mod.F90 b/streams/dshr_methods_mod.F90 index 848df90c6..0da81255c 100644 --- a/streams/dshr_methods_mod.F90 +++ b/streams/dshr_methods_mod.F90 @@ -64,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 diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 4bea381ae..55135db14 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -5,7 +5,8 @@ module dshr_strdata_mod use ESMF , only : ESMF_Mesh, ESMF_RouteHandle, ESMF_Field, ESMF_FieldBundle use ESMF , only : ESMF_Clock, ESMF_VM, ESMF_VMGet, ESMF_VMGetCurrent - use ESMF , only : ESMF_DistGrid, ESMF_SUCCESS, ESMF_MeshGet, ESMF_DistGridGet + use ESMF , only : ESMF_DistGrid, ESMF_MeshGet, ESMF_DistGridGet + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_VMBroadCast, ESMF_MeshIsCreated, ESMF_MeshCreate use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use ESMF , only : ESMF_CalKind_Flag, ESMF_Time, ESMF_TimeInterval @@ -53,6 +54,7 @@ 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 @@ -204,6 +206,7 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, integer :: localPet type(ESMF_VM) :: vm integer :: stream_count + integer :: istat character(len=*), parameter :: subname='(shr_strdata_init_from_config)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -238,7 +241,13 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, ! Allocate pstrm array stream_count = shr_strdata_get_stream_count(sdat) - allocate(sdat%pstrm(stream_count)) + allocate(sdat%pstrm(stream_count), stat=istat) + if ( istat /= 0 ) then + rc = istat + 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 @@ -289,6 +298,7 @@ subroutine shr_strdata_init_from_inline(sdat, my_task, logunit, compname, & integer :: src_mask = 0 integer :: dst_mask = 0 type(ESMF_VM) :: vm + integer :: istat integer :: localpet character(len=*), parameter :: subname='(shr_strdata_init_from_inline)' ! ---------------------------------------------- @@ -327,7 +337,12 @@ 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 + rc = istat + 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 @@ -362,6 +377,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(:) @@ -380,14 +396,27 @@ 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 + rc = istat + 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 + rc = istat + 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 @@ -401,10 +430,34 @@ subroutine shr_strdata_init_model_domain( sdat, rc) numOwnedElements=numOwnedElements, elementdistGrid=distGrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) + if ( istat /= 0 ) then + rc = istat + 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)) + if ( istat /= 0 ) then + rc = istat + 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)) + if ( istat /= 0 ) then + rc = istat + 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) @@ -434,7 +487,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) logical :: fileExists type(ESMF_VM) :: vm 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)' ! ---------------------------------------------- @@ -460,6 +513,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) if (filename /= 'none' .and. mainproc) then inquire(file=trim(filename),exist=fileExists) if (.not. fileExists) then + rc = ESMF_FAILURE call shr_log_error(trim(subname)//"ERROR: stream mesh file does not exist: "//trim(fileName), rc=rc) return end if @@ -479,16 +533,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 + rc = istat + 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 + rc = istat + 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)) + allocate(sdat%pstrm(ns)%fldbun_data(2), stat=istat) + if (istat /= 0) then + rc = istat + call shr_log_error(subName//': allocation error for sdat%pstrm(ns)%fldbun_data(2) ',rc=rc) + return + end if if (mainproc) then write(logout,'(2a,i0)') trim(subname), & " Creating field bundle array fldbun_data of size 2 for stream ",ns @@ -517,8 +588,8 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mainproc) then if (i == 1) then - write(logout,'(2a,i0)') trim(subname),& - " adding field "//trim(sdat%pstrm(ns)%fldlist_model(nfld))//& + write(logout,'(4a,i0)') trim(subname),& + " adding field ",trim(sdat%pstrm(ns)%fldlist_model(nfld))//& " to fldbun_data for stream ",ns end if end if @@ -632,6 +703,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) else if (trim(sdat%stream(ns)%mapalgo) == 'none') then ! single point stream data, no action required. else + rc = ESMF_FAILURE call shr_log_error('ERROR: map algo '//trim(sdat%stream(ns)%mapalgo)//' is not supported', rc=rc) return end if @@ -651,16 +723,19 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ! check that for now u and v are only for single level fields if (stream_nlev > 1) then ! TODO: add support for u and v for multi level fields + rc = ESMF_FAILURE call shr_log_error(subname//': vector fields are not currently supported for multi-level fields', rc=rc) return end if ! check that stream vector names are valid if (.not. shr_string_listIsValid(stream_vector_names)) then + rc = ESMF_FAILURE call shr_log_error(subname//': vec fldlist invalid:'//trim(stream_vector_names), rc=rc) return endif ! check that only 2 fields are contained for any vector pairing if (shr_string_listGetNum(stream_vector_names) /= 2) then + rc = ESMF_FAILURE call shr_log_error(subname//': vec fldlist ne 2:'//trim(stream_vector_names), rc=rc) return endif @@ -670,8 +745,8 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ungriddedLbound=(/1/), ungriddedUbound=(/2/), gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mainproc) then - write(logout,'(2a,i0)') trim(subname)," creating ESMF stream vector field with names" //& - trim(stream_vector_names)//" for stream ",ns + write(logout,'(4a,i0)') trim(subname)," creating ESMF stream vector field with names", & + trim(stream_vector_names)," for stream ",ns end if end if enddo loop_over_stream2 @@ -685,6 +760,7 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then sdat%model_calendar = trim(shr_cal_gregorian) else + rc = ESMF_FAILURE call shr_log_error(subname//" ERROR bad ESMF calendar name "//trim(calendar), rc=rc) return end if @@ -721,6 +797,7 @@ 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 + integer :: istat character(*), parameter :: subname = '(shr_strdata_get_stream_nlev) ' ! ---------------------------------------------- @@ -740,7 +817,15 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) 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 + rc = istat + 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) @@ -758,7 +843,7 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) end if if (mainproc) then write(logout,*) - write(logout,'(2a,2x,i0)') trim(subname),' stream_nlev = ',stream_nlev + write(logout,'(2a,i0)') trim(subname),' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then write(logout,'(3a)') trim(subname),' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs end if @@ -792,6 +877,7 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r real(r8), allocatable :: data_double(:) integer :: pio_iovartype integer :: lsize + integer :: istat character(*), parameter :: subname = '(shr_strdata_set_stream_domain) ' ! ---------------------------------------------- @@ -818,16 +904,27 @@ 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 + rc = istat + 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 + rc = istat + 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) else + rc = ESMF_FAILURE call shr_log_error(subName//"ERROR: only real and double types are supported for stream domain read", rc=rc) return end if @@ -932,6 +1029,7 @@ 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" @@ -970,8 +1068,18 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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 + rc = istat + 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 + rc = istat + call shr_log_error(subName//'allocation error of ymd with size '//toString(nstreams), rc=rc) + return + end if do ns = 1,nstreams ! --------------------------------------------------------- @@ -1009,6 +1117,7 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) ! TODO: need to put in capability to read all stream data at once case default write(logout,'(2a)') "ERROR: Unsupported readmode : ", trim(sdat%stream(ns)%readmode) + rc = ESMF_FAILURE call shr_log_error(subName//"ERROR: Unsupported readmode: "//trim(sdat%stream(ns)%readmode), rc=rc) return end select @@ -1037,6 +1146,7 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) ! case (3), abort write(logout,'(3a)') trim(subname),' ERROR: mismatch calendar ', & trim(sdat%model_calendar),':',trim(sdat%stream(ns)%calendar) + rc = ESMF_FAILURE call shr_log_error(trim(subname)//' ERROR: mismatch calendar ', rc=rc) return endif @@ -1092,6 +1202,7 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) write(logout,'(a,4(i0,2x))') trim(subName),' ERROR: ymdLB, todLB, ymdUB, todUB = ', & sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB end if + rc = ESMF_FAILURE call shr_log_error(trim(subName)//' ERROR dt limit for stream, see atm.log output', rc=rc) return endif @@ -1118,7 +1229,12 @@ 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 + rc = istat + 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') @@ -1128,8 +1244,8 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenC') if (debug > 0 .and. mainproc) then do n = 1,size(coszen) - write(logout,'(a,i0,2x,2(i0,2x),i0,es13.6)')' stream,ymdmod,todmod,n,coszen= ',& - ns, ymd, tod, n, coszen(n) + write(logout,'(2a,4(i0,2x),es13.6)') trim(subname),& + ' stream,ymdmod,todmod,n,coszen= ',ns, ymd, tod, n, coszen(n) end do end if @@ -1138,7 +1254,13 @@ 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 + rc = istat + 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, & @@ -1204,8 +1326,8 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) algo=trim(sdat%stream(ns)%tinterpalgo), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (debug > 0 .and. mainproc) then - write(logout,'(a,i4,2(f10.5,2x))') & - trim(subname)//' non-cosz-interp stream, flb, fub= ',ns,flb,fub + write(logout,'(2a,i0,2(f10.5,2x))') & + trim(subname),' non-cosz-interp stream, flb, fub= ',ns,flb,fub write(logout,'(a)') '------------------------------------------------------' endif do nf = 1,size(sdat%pstrm(ns)%fldlist_model) @@ -1532,6 +1654,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & integer :: i, lev logical :: checkflag = .false. character(CL) :: errmsg + integer :: istat character(*), parameter :: subname = '(shr_strdata_readstrm) ' !------------------------------------------------------------------------------- @@ -1551,6 +1674,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (mainproc) then inquire(file=trim(fileName),exist=fileExists) if (.not. fileExists) then + rc = ESMF_FAILURE call shr_log_error(subName//"ERROR: file does not exist: "//trim(fileName), rc=rc) return end if @@ -1603,6 +1727,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (stream_nlev == 1) then allocate(dataptr1d(1)) else + rc = ESMF_FAILURE call shr_log_error("ERROR: multi-level streams always require a stream mesh", rc=rc) return end if @@ -1617,7 +1742,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & call ESMF_TraceRegionEnter(trim(istr)//'_readpio') if (mainproc) then - write(logout,'(3a,2x)') trim(subname),' reading file ' // trim(boundstr) //': ',trim(filename) + write(logout,'(5a)') trim(subname),' reading file ',trim(boundstr),': ',trim(filename) endif if (ESMF_FieldIsCreated(per_stream%field_stream_vector)) then @@ -1637,20 +1762,52 @@ 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 + rc = istat + 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 + rc = istat + 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=istat) + 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=istat) + 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=istat) + 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=istat) + return + end if endif end if @@ -1680,9 +1837,9 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & call PIO_seterrorhandling(pioid, old_error_handle) if (debug>0 .and. mainproc) then - write(logout,'(3a,2x,i0)') trim(subname),& - ' reading '//trim(per_stream%fldlist_stream(nf))//& - ' into '//trim(per_stream%fldlist_model(nf)), & + write(logout,'(6a,i0)') trim(subname),& + ' reading ',trim(per_stream%fldlist_stream(nf)), & + ' into ',trim(per_stream%fldlist_model(nf)), & ' at time index: ',nt end if @@ -1706,8 +1863,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_real2d == fillvalue_r4)) then - write(errmsg,*) ' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - if(mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) + write(errmsg,'(2a)')' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) + if (mainproc) then + write(logout,'(2a)') trim(subname),trim(errmsg) + end if call shr_log_error(errmsg, rc=rc) return endif @@ -1741,8 +1900,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_real1d == fillvalue_r4)) then - write(errmsg,*) ' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - if(mainproc) write(logout,'(2a)') trim(subname),trim(errmsg) + write (errmsg,'(2a)')' ERROR: _Fillvalue found in stream input variable: ',trim(per_stream%fldlist_stream(nf)) + if (mainproc) then + write(logout,'(2a)') trim(subname),trim(errmsg) + end if + rc = ESMF_FAILURE call shr_log_error(errmsg, rc=rc) return endif @@ -1922,11 +2084,22 @@ 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)) + 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 @@ -2019,6 +2192,7 @@ 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) + integer :: istat character(*), parameter :: subname = '(shr_strdata_set_stream_iodesc) ' !------------------------------------------------------------------------------- @@ -2036,8 +2210,19 @@ 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)) @@ -2048,11 +2233,21 @@ 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 if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then if (ndims == 3) then @@ -2100,14 +2295,14 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if ((trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then if (mainproc) then - write(logout,'(2a,2(i0,2x),a)') trim(subname),' setting iodesc for 2d: '//trim(fldname)// & + write(logout,'(4a,i0,a)') trim(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 (mainproc) then - write(logout,'(2a,2x,i0,2x,i0,a)') trim(subname),' setting iodesc for 2d: '//trim(fldname)// & + write(logout,'(4a,i0,2x,i0,a)') trim(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 @@ -2115,7 +2310,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) per_stream%stream_pio_iodesc) else if (mainproc) then - write(logout,'(2a,2x,2(i0,2x),a)') trim(subname),' setting iodesc for 2d: '//trim(fldname)// & + write(logout,'(4a,i0,2x,i0,a)') trim(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 @@ -2130,8 +2325,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then if (stream_nlev > 1) then if (mainproc) then - write(logout,'(2a,2x,2(i0,2x),a)') trim(subname), & - 'setting iodesc for 3d: '//trim(fldname)//' with dimlens(1),dimlens(2) = ', & + write(logout,'(4a,i0,2x,i0,a)') trim(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 @@ -2139,8 +2334,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) per_stream%stream_pio_iodesc) else if (mainproc) then - write(logout,'(2a,2x,2(i0,2x),a)') trim(subname),& - ' setting iodesc for 3d: '//trim(fldname)//' with dimlens(1),dimlens(2) = ', & + write(logout,'(4a,i0,2x,i0,a)') trim(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 @@ -2150,8 +2345,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) else if (stream_nlev > 1) then if (mainproc) then - write(logout,'(2a,2x,3(i0,2x),a)') trim(subname), & - ' setting iodesc for 3d: '//trim(fldname)//' with dimlens(1), dimlens(2), dimlens(3) = ',& + write(logout,'(4a,3(i0,2x),a)') trim(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 @@ -2170,8 +2365,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if (stream_nlev > 1 .and. (trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then if (mainproc) then - write(logout,'(2a,2x,3(i0,2x),a)') trim(subname), & - ' setting iodesc for 4d: '//trim(fldname)//' with dimlens(1), dimlens(2),dimlens(3) = ',& + write(logout,'(4a,3(i0,2x),a)') trim(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 @@ -2223,7 +2418,7 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, & ! loop over all input streams and determine if the strm_fld is in the field bundle of the target stream 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 + ! 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)), & @@ -2238,8 +2433,8 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, & if (found) then ! If pointer found, preset value if (mainproc) then - write(logout,'(2a)') trim(subname), & - ' strm_ptr is allocated and preset to nan for stream field strm_'//trim(strm_fld) + write(logout,'(3a)') trim(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 @@ -2289,7 +2484,7 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & ! loop over all input streams and determine if the strm_fld is in the field bundle of the target stream 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 + ! 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)), & @@ -2304,8 +2499,8 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & if (found) then ! If pointer found, preset value if (mainproc) then - write(logout,'(2a)') trim(subname), & - ' strm_ptr is allocated and preset to nan for stream field strm_'//trim(strm_fld) + write(logout,'(3a)') trim(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) diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index 72fd7109f..d58e917d2 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 @@ -154,7 +156,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu 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, ESMF_FAILURE ! --------------------------------------------------------------------- ! The xml format of a stream txt file will look like the following @@ -203,6 +205,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu integer :: status integer :: tmp(6) real(r8) :: rtmp(1) + integer :: istat character(*),parameter :: subName = '(shr_stream_init_from_xml) ' ! -------------------------------------------------------- @@ -217,6 +220,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu Sdoc => parseFile(streamfilename, iostat=status) if (status /= 0) then + rc = ESMF_FAILURE call shr_log_error("Could not parse file "//trim(streamfilename), rc=rc) return endif @@ -224,7 +228,13 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu nstrms = getLength(streamlist) ! allocate an array of shr_streamtype objects on just mainproc - allocate(streamdat(nstrms)) + allocate(streamdat(nstrms), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//& + ': allocation error for streamdat with size '//toString(nstrms), rc=rc) + return + end if ! fill in non-default values for the streamdat attributes do i= 1, nstrms @@ -236,6 +246,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (streamdat(i)%taxmode /= shr_stream_taxis_cycle .and. & streamdat(i)%taxmode /= shr_stream_taxis_extend .and. & streamdat(i)%taxmode /= shr_stream_taxis_limit) then + rc = ESMF_FAILURE call shr_log_error("tintalgo must have a value of either cycle, extend or limit", rc=rc) return end if @@ -250,6 +261,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%mapalgo /= shr_stream_mapalgo_consf .and. & streamdat(i)%mapalgo /= shr_stream_mapalgo_consd .and. & streamdat(i)%mapalgo /= shr_stream_mapalgo_none) then + rc = ESMF_FAILURE call shr_log_error("mapaglo must have a value of either bilinear, redist, nn, consf or consd", rc=rc) return end if @@ -263,6 +275,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%tInterpAlgo /= shr_stream_tinterp_nearest .and. & streamdat(i)%tInterpAlgo /= shr_stream_tinterp_linear .and. & streamdat(i)%tInterpAlgo /= shr_stream_tinterp_coszen) then + rc = ESMF_FAILURE call shr_log_error("tintalgo must have a value of either lower, upper, nearest, linear or coszen", rc=rc) return end if @@ -277,6 +290,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if(associated(p)) then call extractDataContent(p, streamdat(i)%yearFirst) else + rc = ESMF_FAILURE call shr_log_error("yearFirst must be provided", rc=rc) return endif @@ -285,6 +299,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if(associated(p)) then call extractDataContent(p, streamdat(i)%yearLast) else + rc = ESMF_FAILURE call shr_log_error("yearLast must be provided", rc=rc) return endif @@ -293,6 +308,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if(associated(p)) then call extractDataContent(p, streamdat(i)%yearAlign) else + rc = ESMF_FAILURE call shr_log_error("yearAlign must be provided", rc=rc) return endif @@ -311,6 +327,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%meshfile) else + rc = ESMF_FAILURE call shr_log_error("mesh file name must be provided", rc=rc) return endif @@ -319,6 +336,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%stream_vectors) else + rc = ESMF_FAILURE call shr_log_error("stream vectors must be provided", rc=rc) return endif @@ -328,6 +346,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%lev_dimname) else + rc = ESMF_FAILURE call shr_log_error("stream vertical level dimension name must be provided", rc=rc) return endif @@ -335,12 +354,20 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu ! Determine input data files p => item(getElementsByTagname(streamnode, "datafiles"), 0) if (.not. associated(p)) then + rc = ESMF_FAILURE call shr_log_error("stream data files must be provided", rc=rc) return endif filelist => getElementsByTagname(p,"file") streamdat(i)%nfiles = getLength(filelist) - allocate(streamdat(i)%file( streamdat(i)%nfiles)) + allocate(streamdat(i)%file(streamdat(i)%nfiles), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//& + ': allocation error for streamdat('//toString(i)//')%file'//& + ' with size '//toString(streamdat(i)%nfiles), rc=rc) + return + end if do n=1, streamdat(i)%nfiles p => item(filelist, n-1) call extractDataContent(p, streamdat(i)%file(n)%name) @@ -350,7 +377,14 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu p => item(getElementsByTagname(streamnode, "datavars"), 0) varlist => getElementsByTagname(p, "var") streamdat(i)%nvars = getLength(varlist) - allocate(streamdat(i)%varlist(streamdat(i)%nvars)) + allocate(streamdat(i)%varlist(streamdat(i)%nvars), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//& + ': allocation error for streamdat('//toString(i)//')%varlist'//& + ' with size '//toString(streamdat(i)%nvars), rc=rc) + return + end if do n = 1, streamdat(i)%nvars p => item(varlist, n-1) call extractDataContent(p, tmpstr) @@ -373,7 +407,13 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (ChkErr(rc,__LINE__,u_FILE_u)) return nstrms = tmp(1) if (.not. mainproc) then - allocate(streamdat(nstrms)) + allocate(streamdat(nstrms), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//& + ': allocation error for streamdat with size '//toString(nstrms), rc=rc) + return + end if endif ! broadcast the contents of streamdat from the main task to all tasks @@ -393,8 +433,22 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%yearAlign = tmp(5) streamdat(i)%offset = tmp(6) if(.not. mainproc) then - allocate(streamdat(i)%file(streamdat(i)%nfiles)) - allocate(streamdat(i)%varlist(streamdat(i)%nvars)) + allocate(streamdat(i)%file(streamdat(i)%nfiles), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//& + ': allocation error for streamdat('//toString(i)//')%file'//& + ' with size '//toString(streamdat(i)%nfiles), rc=rc) + return + end if + allocate(streamdat(i)%varlist(streamdat(i)%nvars), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//& + ': allocation error for streamdat('//toString(i)//')%varlist'//& + ' with size '//toString(streamdat(i)%nvars), rc=rc) + return + end if endif do n=1,streamdat(i)%nfiles call ESMF_VMBroadCast(vm, streamdat(i)%file(n)%name, CX, 0, rc=rc) @@ -417,7 +471,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 @@ -440,16 +493,17 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%pio_ioformat = io_format #endif if (mainproc) then - write(logout,'(2a,i0)') trim(subname),' getting calendar for stream ',i + write(logout,'(2a,i0)') subname,' getting calendar for stream ',i end if call shr_stream_getCalendar(streamdat(i), 1, streamdat(i)%calendar) if (mainproc) then - write(logout,'(2a,i0,2a)') trim(subname),' calendar for stream ',i,' is ',trim(streamdat(i)%calendar) + write(logout,'(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) + rc = ESMF_FAILURE + 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 @@ -505,6 +559,8 @@ subroutine shr_stream_init_from_inline(streamdat, & integer :: n integer :: nfiles integer :: nvars + integer :: istat + integer :: rc character(CS) :: calendar ! stream calendar character(*),parameter :: subName = '(shr_stream_init_from_inline) ' ! -------------------------------------------------------- @@ -515,14 +571,11 @@ subroutine shr_stream_init_from_inline(streamdat, & ! Initialize module variable mainproc mainproc = isroot_task - ! 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 - ! mainproc = (localPet == main_task) - ! 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 ! overwrite default values streamdat(1)%meshFile = trim(stream_meshFile) @@ -558,7 +611,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 @@ -566,7 +622,10 @@ 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)) @@ -586,12 +645,11 @@ subroutine shr_stream_init_from_inline(streamdat, & end subroutine shr_stream_init_from_inline !=============================================================================== - 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, ESMF_VMGet - use esmf , only : ESMF_SUCCESS, ESMF_ConfigCreate, ESMF_ConfigLoadFile + use esmf , only : ESMF_SUCCESS, ESMF_ConfigCreate, ESMF_ConfigLoadFile, ESMF_FAILURE use esmf , only : ESMF_ConfigGetLen, ESMF_ConfigGetAttribute use esmf , only : ESMF_Config, ESMF_MAXSTR @@ -633,6 +691,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, integer :: i, n, nstrms integer :: myid character(2) :: mystrm + integer :: istat character(len=ESMF_MAXSTR), allocatable :: strm_tmpstrings(:) character(*), parameter :: u_FILE_u = __FILE__ character(*), parameter :: subName = '(shr_stream_init_from_esmfconfig)' @@ -664,8 +723,14 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, ! allocate an array of shr_stream_streamtype objects on just mainproc if( nstrms > 0 ) then - allocate(streamdat(nstrms)) + allocate(streamdat(nstrms), stat=istat) + if ( istat /= 0 ) then + rc = istat + call shr_log_error(subName//': allocation error for streamdat with size '//toString(nstrms),rc=rc) + return + end if else + rc = istat call shr_log_error("no stream_info in config file "//trim(streamfilename), rc=rc) return endif @@ -689,6 +754,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearFirst,label="yearFirst"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + rc = ESMF_FAILURE call shr_log_error("yearFirst must be provided", rc=rc) return endif @@ -697,6 +763,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearLast,label="yearLast"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + rc = ESMF_FAILURE call shr_log_error("yearLast must be provided", rc=rc) return endif @@ -705,6 +772,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearAlign,label="yearAlign"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + rc = ESMF_FAILURE call shr_log_error("yearAlign must be provided", rc=rc) return endif @@ -719,6 +787,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%meshfile,label="stream_mesh_file"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + rc = ESMF_FAILURE call shr_log_error("stream_mesh_file must be provided", rc=rc) return endif @@ -727,6 +796,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%stream_vectors,label="stream_vectors"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + rc = ESMF_FAILURE call shr_log_error("stream_vectors must be provided", rc=rc) return endif @@ -735,6 +805,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%lev_dimname,label="stream_lev_dimname"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + rc = ESMF_FAILURE call shr_log_error("stream_lev_dimname must be provided", rc=rc) return endif @@ -742,8 +813,15 @@ 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(strm_tmpstrings(streamdat(i)%nfiles)) + allocate(streamdat(i)%file( streamdat(i)%nfiles), stat=istat) + if ( istat /= 0 ) then + rc = istat + 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), stat=istat) call ESMF_ConfigGetAttribute(CF,valueList=strm_tmpstrings, label="stream_data_files"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1,streamdat(i)%nfiles @@ -751,6 +829,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, enddo deallocate(strm_tmpstrings) else + rc = ESMF_FAILURE call shr_log_error("stream data files must be provided", rc=rc) return endif @@ -758,8 +837,22 @@ 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 + rc = istat + 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 + rc = istat + 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)), " ")) @@ -767,6 +860,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, enddo deallocate(strm_tmpstrings) else + rc = ESMF_FAILURE call shr_log_error("stream data variables must be provided", rc=rc) return endif @@ -787,7 +881,8 @@ 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) + rc = ESMF_FAILURE + call shr_log_error(subname//" ERROR: if taxmode value is extend set dtlimit to 1.e30", rc=rc) return end if @@ -853,11 +948,11 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & !------------------------------------------------------------------------------- if (debug>0 .and. mainproc) then - write(logout,'(a,a)') trim(subname),"DEBUG: ---------- enter ------------------" + write(logout,'(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 @@ -870,7 +965,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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 !---------------------------------------------------------------------------- @@ -888,7 +983,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (cycle) then dYear = yrFirst + modulo(mYear-yrAlign+(2*nYears),nYears) ! current data year if(debug>0 .and. mainproc) then - write(logout,'(2a,4(2x,i0))') trim(subname), ' dyear, yrfirst, myear, yralign, nyears =', & + write(logout,'(2a,4(i0,2x))') subname, ' dyear, yrfirst, myear, yralign, nyears = ', & dyear, yrfirst, myear, yralign, nyears endif else @@ -897,16 +992,18 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (dYear < 0) then if (mainproc) then - write(logout,'(2a,2x,i0)') trim(subName),' ERROR: dyear lt zero = ',dYear + write(logout,'(2a,i0)') subname,' ERROR: dyear lt zero = ',dYear end if - call shr_sys_abort(trim(subName)//' ERROR: dyear lt zero') + 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. mainproc) then - write(logout,'(a,2(i8,2x),2(f20.4,2x))') 'mYear,dYear,dDateIn,rDateIn = ',mYear,dYear,dDateIn,rDateIn - write(logout,'(a,2(i8,2x),2(f20.4,2x))') 'yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears + write(logout,'(2a,3(i0,2x),f20.4)') subname, & + ' mYear,dYear,dDateIn,rDateIn = ',mYear,dYear,dDateIn,rDateIn + write(logout,'(a,4(i0,2x))') subname, & + ' yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears endif !---------------------------------------------------------------------------- @@ -918,7 +1015,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (.not. strm%file(k)%haveData) then 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 @@ -932,18 +1029,18 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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 if (mainproc) then - write(logout,'(2a)') trim(subname)," ERROR: LVD not found, all data is after yearLast" + write(logout,'(2a)') subname," ERROR: LVD not found, all data is after yearLast" end if - call shr_sys_abort(trim(subName)//" ERROR: LVD not found, all data is after yearLast") + call shr_sys_abort(subname//" ERROR: LVD not found, all data is after yearLast") end if end if if (debug>1 .and. mainproc) then - if (strm%found_lvd) write(logout,'(2a,2x,i0)') trim(subname)," found LVD = ",strm%file(k)%date(n) + if (strm%found_lvd) write(logout,'(2a,i0)') subname," found LVD = ",strm%file(k)%date(n) end if end if @@ -953,9 +1050,9 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & rDatelvd = strm%file(k)%date(n) + strm%file(k)%secs(n)/spd ! LVD date + frac day else if (mainproc) then - write(logout,'(2a)') trim(subname)," ERROR: LVD not found yet" + write(logout,'(2a)') subname," ERROR: LVD not found yet" end if - call shr_sys_abort(trim(subName)//" ERROR: LVD not found yet") + call shr_sys_abort(subname//" ERROR: LVD not found yet") endif if (strm%found_gvd) then @@ -966,7 +1063,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & rDategvd = 99991231.0 endif if (debug>0 .and. mainproc) then - write(logout,'(2a,3(f20.4,2x))') trim(subname),' rDateIn,rDatelvd,rDategvd = ',rDateIn,rDatelvd,rDategvd + write(logout,'(2a,3(f20.4,2x))') subname,' rDateIn,rDatelvd,rDategvd = ',rDateIn,rDatelvd,rDategvd endif !----------------------------------------------------------- @@ -979,9 +1076,10 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (rDateIn < rDatelvd) then if (limit) then if (mainproc) then - write(logout,'(2a,2(i0,2x))') trim(subName)," ERROR: limit on and rDateIn lt rDatelvd",rDateIn,rDatelvd + write(logout,'(2a,2(f20.4,2x))') subname,& + " ERROR: limit on and rDateIn lt rDatelvd ",rDateIn,rDatelvd end if - call shr_sys_abort(trim(subName)//" ERROR: rDateIn lt rDatelvd limit true") + call shr_sys_abort(subname//" ERROR: rDateIn lt rDatelvd limit true") endif if (.not.cycle) then @@ -1012,7 +1110,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (.not. strm%file(k)%haveData) then 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 --- @@ -1023,7 +1121,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & strm%found_gvd = .true. rDategvd = strm%file(k)%date(n) + strm%file(k)%secs(n)/spd ! GVD date + frac day if (debug>1 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname)," found GVD ",strm%file(k)%date(n) + write(logout,'(2a,i0)') subname," found GVD ",strm%file(k)%date(n) end if exit B end if @@ -1033,9 +1131,9 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (.not. strm%found_gvd) then if (mainproc) then - write(logout,'(2a)') trim(subname)," ERROR: GVD not found1" + write(logout,'(2a)') subname," ERROR: GVD not found1" end if - call shr_sys_abort(trim(subName)//" ERROR: GVD not found1") + call shr_sys_abort(subname//" ERROR: GVD not found1") endif k_lb = strm%k_gvd @@ -1069,9 +1167,10 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & else if (strm%found_gvd .and. rDateIn >= rDategvd) then if (limit) then if (mainproc) then - write(logout,'(2a,2(d13.5,2x))') trim(subName)," ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd + write(logout,'(2a,2(f13.5,2x))') subname,& + " ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd end if - call shr_sys_abort(trim(subName)//" ERROR: rDateIn >= rDategvd limit true") + call shr_sys_abort(subname//" ERROR: rDateIn >= rDategvd limit true") endif if (.not.cycle) then @@ -1126,7 +1225,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (.not. strm%file(k)%haveData) then 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 --- @@ -1171,9 +1270,10 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (strm%found_gvd .and. rDateIn >= rDategvd) then if (limit) then if (mainproc) then - write(logout,'(2a,2(d13.5,2x))') trim(subName)," ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd + write(logout,'(2a,2(f13.5,2x))') subname,& + " ERROR: limit on and rDateIn >= rDategvd",rDateIn,rDategvd end if - call shr_sys_abort(trim(subName)//" ERROR: rDateIn >= rDategvd limit true") + call shr_sys_abort(subname//" ERROR: rDateIn >= rDategvd limit true") endif if (.not.cycle) then @@ -1247,7 +1347,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & yy = yy + (mYear-dYear) if(mm == 2 .and. dd==29 .and. .not. shr_cal_leapyear(yy)) then if (mainproc) then - write(logout,'(2a,3(i0,2x))') trim(subname),' Found leapyear mismatch', myear, dyear, yy + write(logout,'(2a,3(i0,2x))') subname,' Found leapyear mismatch', myear, dyear, yy end if mm = 3 dd = 1 @@ -1262,7 +1362,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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 @@ -1294,6 +1394,7 @@ subroutine shr_stream_readTCoord(strm, k, rc) real(R8) :: nsec ! elapsed secs on calendar date real(R8),allocatable :: tvar(:) character(CX) :: msg + integer :: istat character(*),parameter :: subname = '(shr_stream_readTCoord) ' !------------------------------------------------------------------------------- @@ -1305,14 +1406,17 @@ subroutine shr_stream_readTCoord(strm, k, rc) ! open file if needed if (.not. pio_file_is_open(strm%file(k)%fileid)) then if (debug>1 .and. mainproc) then - write(logout, '(2a)') trim(subname),' opening stream filename = '//trim(filename) + write(logout,'(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 @@ -1321,10 +1425,18 @@ subroutine shr_stream_readTCoord(strm, k, 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 @@ -1353,7 +1465,10 @@ subroutine shr_stream_readTCoord(strm, k, 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) @@ -1366,14 +1481,14 @@ subroutine shr_stream_readTCoord(strm, k, rc) ! close file if (debug>1 .and. mainproc) then - write(logout, '(2a)') trim(subname),' closing stream filename = '//trim(filename) + write(logout,'(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 @@ -1382,12 +1497,19 @@ subroutine shr_stream_readTCoord(strm, k, rc) do n = 1,num din = strm%file(k)%date(n) sin = strm%file(k)%secs(n) + if (debug > 5 .and. mainproc) then + write(logout,'(2a,4(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 - ! if (mainproc) then - ! write(logout,'(2a,6(i0,2x))') 'debug ',n,strm%offset,din,sin,dout,sout - ! end if + if (debug > 5 .and. mainproc) then + write(logout,'(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 @@ -1429,13 +1551,13 @@ subroutine verifyTCoord(strm,k,rc) rc = 0 if (debug>1 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname)," checking t-coordinate data for file k =",k + write(logout,'(2a,i0)') subname," checking t-coordinate data for file k =",k end if if ( .not. strm%file(k)%haveData) then rc = 1 if (mainproc) then - write(logout,'(2a,i0)') trim(subname)," ERROR: do not have data for file ",k + write(logout,'(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 @@ -1455,7 +1577,7 @@ subroutine verifyTCoord(strm,k,rc) secs2 = strm%file(k )%secs(n) checkIt = .true. if (debug>1 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname)," comparing with previous file for file k =",k + write(logout,'(2a,i0)') subname," comparing with previous file for file k =",k end if end if end if @@ -1470,7 +1592,7 @@ subroutine verifyTCoord(strm,k,rc) secs2 = strm%file(k+1)%secs(1) checkIt = .true. if (debug>1 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname)," comparing with next file for file k =",k + write(logout,'(2a,i0)') subname," comparing with next file for file k =",k end if end if end if @@ -1488,16 +1610,16 @@ subroutine verifyTCoord(strm,k,rc) if ( date1 > date2 ) then rc = 1 if (mainproc) then - write(logout,'(2a)') trim(subname)," ERROR: calendar dates must be increasing" - write(logout,'(2a,2(i0,2x))') trim(subname)," date(n), date(n+1) = ",date1,date2 + write(logout,'(2a)') subname," ERROR: calendar dates must be increasing" + write(logout,'(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 if (mainproc) then - write(logout,'(2a)') trim(subname), "ERROR: elapsed seconds on a date must be strickly increasing" - write(logout,'(2a,2(i0,2x))') trim(subname)," secs(n), secs(n+1) = ",secs1,secs2 + write(logout,'(2a)') subname, "ERROR: elapsed seconds on a date must be strictly increasing" + write(logout,'(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 @@ -1505,8 +1627,8 @@ subroutine verifyTCoord(strm,k,rc) if ( secs1 < 0 .or. spd < secs1 ) then rc = 1 if (mainproc) then - write(logout,'(2a)') trim(subname)," ERROR: elapsed seconds out of valid range [0,spd]" - write(logout,'(2a,i0)') trim(subname), " secs(n) = ",secs1 + write(logout,'(2a)') subname," ERROR: elapsed seconds out of valid range [0,spd]" + write(logout,'(2a,i0)') subname, " secs(n) = ",secs1 end if call shr_sys_abort(subName//"ERROR: elapsed seconds out of range") end if @@ -1514,7 +1636,7 @@ subroutine verifyTCoord(strm,k,rc) end do stream_file_times if (debug>0 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname)," data is OK (non-decreasing) for file k =",k + write(logout,'(2a,i0)') subname," data is OK (non-decreasing) for file k =",k end if end subroutine verifyTCoord @@ -1601,17 +1723,17 @@ subroutine shr_stream_getCalendar(strm, k, calendar) if (.not. pio_file_is_open(strm%file(k)%fileid)) then if (debug>0 .and. mainproc) then - write(logout,'(3x,2a)') trim(subname),' opening stream filename = '//trim(filename) + write(logout,'(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 (debug>0 .and. mainproc) then - write(logout,'(3x,2a)') trim(subname),' reading stream filename = '//trim(filename) + write(logout,'(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) @@ -1628,7 +1750,7 @@ subroutine shr_stream_getCalendar(strm, k, calendar) if (ichar(lcal(n:n)) == 0 ) lcal(n:n) = ' ' else if (debug>0 .and. mainproc) then - write(logout,'(2a)') trim(subname),& + write(logout,'(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)) @@ -1638,7 +1760,7 @@ subroutine shr_stream_getCalendar(strm, k, calendar) calendar = trim(shr_cal_calendarName(trim(lcal))) if (debug>0 .and. mainproc) then - write(logout, '(3x,2a)') trim(subname),' closing stream filename = '//trim(filename) + write(logout, '(3a)') subname,' closing stream filename = ',trim(filename) end if call pio_closefile(strm%file(k)%fileid) @@ -1713,7 +1835,7 @@ subroutine shr_stream_getNextFileName(strm, fn, fnNext,rc) if (.not. found) then rCode = 1 if (mainproc) then - write(logout,'(3a)') trim(subname)," ERROR: input file name is not in stream file: ",trim(fn) + write(logout,'(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 @@ -1769,7 +1891,7 @@ subroutine shr_stream_getPrevFileName(strm, fn, fnPrev,rc) if (.not. found) then rCode = 1 if (mainproc) then - write(logout,'(3a)') trim(subname)," ERROR: input file name is not in stream: ",trim(fn) + write(logout,'(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 @@ -1804,6 +1926,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 @@ -1821,6 +1944,7 @@ subroutine shr_stream_restIO(pioid, streams, mode) integer :: maxnt = 0 integer, allocatable :: tmp(:) character(len=CX) :: fname, rfname, rsfname + integer :: istat character(*),parameter :: subName = '(shr_stream_restIO) ' !------------------------------------------------------------------------------- @@ -1863,7 +1987,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 @@ -1957,7 +2084,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 @@ -2024,21 +2154,23 @@ subroutine shr_stream_restIO(pioid, streams, mode) if(trim(fname) /= trim(streams(k)%file(n)%name)) then if (mainproc) then - write(logout,'(2a)') trim(subname),'Filename does not match restart record, checking realpath' + write(logout,'(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 if (mainproc) then - write(logout,'(2a)') trim(subname),'Filename path does not match restartfile, checking filename' + write(logout,'(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 if (mainproc) then - write(logout,'(2a)') trim(subname),trim(rfname), '<>', trim(rsfname) - write(logout,'(2a)') trim(subname),' fname = '//trim(fname) - write(logout,'(2a,i8,2x,i8,2x,a)') trim(subname),' k,n,streams(k)%file(n)%name = ',& + write(logout,'(2a)') subname,trim(rfname), '<>', trim(rsfname) + write(logout,'(2a)') subname,' fname = '//trim(fname) + write(logout,'(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') @@ -2047,7 +2179,10 @@ subroutine shr_stream_restIO(pioid, streams, mode) 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 @@ -2058,7 +2193,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) @@ -2106,25 +2245,25 @@ subroutine shr_stream_dataDump(strm) !------------------------------------------------------------------------------- if (debug>0 .and. mainproc) then - write(logout,'(2a)') trim(subname),"dump internal data for debugging..." - write(logout,'(2a,i0)') trim(subname)," nFiles = ", strm%nFiles + write(logout,'(2a)') subname,"dump internal data for debugging..." + write(logout,'(2a,i0)') subname," nFiles = ", strm%nFiles do nf = 1,strm%nFiles - write(logout,'(2a,i0)') trim(subname)," data for file nf = ",nf - write(logout,'(2a)') trim(subname)," file(nf)%name = ", trim(strm%file(nf)%name) + write(logout,'(2a,i0)') subname," data for file nf = ",nf + write(logout,'(2a)') subname," file(nf)%name = ", trim(strm%file(nf)%name) if ( strm%file(nf)%haveData ) then - write(logout,'(2a,i0)') trim(subname)," file(nf)%nt = ", strm%file(nf)%nt + write(logout,'(2a,i0)') subname," file(nf)%nt = ", strm%file(nf)%nt do nt = 1, size(strm%file(nf)%date) - write(logout,'(2a,2(i0,2x))') trim(subname)," file(nf)%date(nt) = ",nt,strm%file(nf)%date(nt) - write(logout,'(2a,2(i0,2x))') trim(subname)," file(nf)%secs(nt) = ",nt,strm%file(nf)%secs(nt) + write(logout,'(2a,2(i0,2x))') subname," file(nf)%date(nt) = ",nt,strm%file(nf)%date(nt) + write(logout,'(2a,2(i0,2x))') subname," file(nf)%secs(nt) = ",nt,strm%file(nf)%secs(nt) end do else - write(logout,'(2a)') trim(subname),' time coord data not read in yet for this file' + write(logout,'(2a)') subname,' time coord data not read in yet for this file' end if end do - write(logout,'(2a,3(2x,i0))') trim(subname),"yearF/L/A = ",strm%yearFirst,strm%yearLast,strm%yearAlign - write(logout,'(2a,i0)') trim(subname),"offset = ",strm%offset - write(logout,'(3a)') trim(subname),"taxMode = ",trim(strm%taxMode) - write(logout,'(3a)') trim(subname),"meshfile = ",trim(strm%meshfile) + write(logout,'(2a,3(2x,i0))') subname,"yearF/L/A = ",strm%yearFirst,strm%yearLast,strm%yearAlign + write(logout,'(2a,i0)') subname,"offset = ",strm%offset + write(logout,'(3a)') subname,"taxMode = ",trim(strm%taxMode) + write(logout,'(3a)') subname,"meshfile = ",trim(strm%meshfile) end if end subroutine shr_stream_dataDump From e49446e363384ffd39917887658e8ccb3c343bc7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 30 Dec 2025 10:59:37 +0100 Subject: [PATCH 24/44] udpates to back out module variable settings of mainproc and logunit --- streams/dshr_strdata_mod.F90 | 444 ++++++++++++++++------------------- streams/dshr_stream_mod.F90 | 426 ++++++++++++++------------------- 2 files changed, 379 insertions(+), 491 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 55135db14..10c915716 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -5,8 +5,7 @@ module dshr_strdata_mod use ESMF , only : ESMF_Mesh, ESMF_RouteHandle, ESMF_Field, ESMF_FieldBundle use ESMF , only : ESMF_Clock, ESMF_VM, ESMF_VMGet, ESMF_VMGetCurrent - use ESMF , only : ESMF_DistGrid, ESMF_MeshGet, ESMF_DistGridGet - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_DistGrid, ESMF_SUCCESS, ESMF_MeshGet, ESMF_DistGridGet use ESMF , only : ESMF_VMBroadCast, ESMF_MeshIsCreated, ESMF_MeshCreate use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use ESMF , only : ESMF_CalKind_Flag, ESMF_Time, ESMF_TimeInterval @@ -84,7 +83,7 @@ module dshr_strdata_mod private :: shr_strdata_readLBUB ! Public data members: - integer :: debug = 0 ! local debug flag + 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 @@ -120,7 +119,8 @@ module dshr_strdata_mod type shr_strdata_type type(shr_strdata_perstream), allocatable :: pstrm(:) ! stream info type(shr_stream_streamType), pointer :: stream(:)=> null() ! stream datatype - logical :: mainproc ! not used, needed for cmeps backwards compatibility + 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 @@ -146,11 +146,8 @@ module dshr_strdata_mod type(ESMF_Field) :: field_vector_dst ! needed for vector fields - logical :: mainproc ! root processor - integer :: logout ! log unit for mainproc output - real(r8) ,parameter :: deg2rad = SHR_CONST_PI/180.0_r8 - character(*) ,parameter :: u_FILE_u = & + character(len=*) ,parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -211,9 +208,6 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, ! ---------------------------------------------- rc = ESMF_SUCCESS - ! Set module variable logout - logout = logunit - #ifdef CESMCOUPLED ! Initialize sdat pio sdat%pio_subsystem => shr_pio_getiosys(trim(compname)) @@ -226,16 +220,19 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - mainproc = (localPet == main_task) + sdat%mainproc = (localPet == main_task) + + ! Initialize sdat logunit + sdat%logunit = logunit ! Initialize sdat streams #ifdef DISABLE_FoX ! Read input ESMF config file - call shr_stream_init_from_esmfconfig(streamfilename, sdat%stream, logout, & + call shr_stream_init_from_esmfconfig(streamfilename, sdat%stream, sdat%logunit, & sdat%pio_subsystem, sdat%io_type, sdat%io_format, rc=rc) #else ! Read input xml file - call shr_stream_init_from_xml(streamfilename, sdat%stream, mainproc, logout, & + 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 @@ -243,7 +240,6 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, stream_count = shr_strdata_get_stream_count(sdat) allocate(sdat%pstrm(stream_count), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for sdat%pstrm with stream_count '//toString(stream_count), rc=rc) return @@ -270,58 +266,48 @@ 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 - type(ESMF_VM) :: vm integer :: istat - integer :: localpet character(len=*), parameter :: subname='(shr_strdata_init_from_inline)' ! ---------------------------------------------- rc = ESMF_SUCCESS - ! 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 - mainproc = (localPet == main_task) + ! Initialize sdat%logunit and sdat%mainproc + sdat%mainproc = (my_task == main_task) + sdat%logunit = logunit - ! Set module variable logout - if (mainproc) then - logout = logunit - end if - - if (mainproc) then + if (sdat%mainproc) then if (present(stream_name)) then - write(logout,'(3a)') trim(subname),' inline call for stream ',trim(stream_name) + write(sdat%logunit,'(3a)') subname,' inline call for stream ',trim(stream_name) else - write(logout,'(2a)') trim(subname),' inline call for generic stream stream_data' + write(sdat%logunit,'(2a)') subname,' inline call for generic stream stream_data' end if end if @@ -339,7 +325,6 @@ subroutine shr_strdata_init_from_inline(sdat, my_task, logunit, compname, & ! Initialize sdat%pstrm - ASSUME only 1 stream allocate(sdat%pstrm(1), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//': allocation error for sdat%pstrm(1)', rc=rc) return end if @@ -356,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, & - logout, trim(compname), mainproc, 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) @@ -398,7 +383,6 @@ subroutine shr_strdata_init_model_domain( sdat, rc) ! initialize sdat%model_gindex allocate(sdat%model_gindex(sdat%model_lsize), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for sdat%model_gindex with size '//toString(sdat%model_lsize), rc=rc) return @@ -412,7 +396,6 @@ subroutine shr_strdata_init_model_domain( sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(elementCountPTile(tileCount), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for distGrid elementCountPTile with size '//toString(tileCount), rc=rc) return @@ -431,7 +414,6 @@ subroutine shr_strdata_init_model_domain( sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for mesh ownedElemCoords with size '//toString(spatialDim*numOwnedElements), rc=rc) return @@ -446,14 +428,12 @@ subroutine shr_strdata_init_model_domain( sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(sdat%model_lon(numOwnedElements)) if ( istat /= 0 ) then - rc = istat 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)) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for sdat%model_lat with size '//toString(numOwnedElements), rc=rc) return @@ -469,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 @@ -510,11 +490,10 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ! Create the target stream mesh from the stream mesh file 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 - rc = ESMF_FAILURE - call shr_log_error(trim(subname)//"ERROR: stream mesh 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 @@ -535,7 +514,6 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ! Allocate memory allocate(sdat%pstrm(ns)%fldList_model(nvars), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for sdat%pstrm('//toString(ns)//')%fldlist_model with nvars '//toString(nvars), rc=rc) return @@ -543,7 +521,6 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) call shr_stream_getModelFieldList(sdat%stream(ns), sdat%pstrm(ns)%fldlist_model) allocate(sdat%pstrm(ns)%fldlist_stream(nvars), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for sdat%pstrm('//toString(ns)//')%fldlist_stream with nvars '//toString(nvars), rc=rc) return @@ -556,13 +533,12 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) sdat%pstrm(ns)%stream_ub = 2 allocate(sdat%pstrm(ns)%fldbun_data(2), stat=istat) if (istat /= 0) then - rc = istat call shr_log_error(subName//': allocation error for sdat%pstrm(ns)%fldbun_data(2) ',rc=rc) return end if - if (mainproc) then - write(logout,'(2a,i0)') trim(subname), & - " Creating field bundle array fldbun_data of size 2 for stream ",ns + 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 @@ -586,11 +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(logout,'(4a,i0)') trim(subname),& - " 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 @@ -703,7 +678,6 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) else if (trim(sdat%stream(ns)%mapalgo) == 'none') then ! single point stream data, no action required. else - rc = ESMF_FAILURE call shr_log_error('ERROR: map algo '//trim(sdat%stream(ns)%mapalgo)//' is not supported', rc=rc) return end if @@ -723,19 +697,16 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) ! check that for now u and v are only for single level fields if (stream_nlev > 1) then ! TODO: add support for u and v for multi level fields - rc = ESMF_FAILURE call shr_log_error(subname//': vector fields are not currently supported for multi-level fields', rc=rc) return end if ! check that stream vector names are valid if (.not. shr_string_listIsValid(stream_vector_names)) then - rc = ESMF_FAILURE call shr_log_error(subname//': vec fldlist invalid:'//trim(stream_vector_names), rc=rc) return endif ! check that only 2 fields are contained for any vector pairing if (shr_string_listGetNum(stream_vector_names) /= 2) then - rc = ESMF_FAILURE call shr_log_error(subname//': vec fldlist ne 2:'//trim(stream_vector_names), rc=rc) return endif @@ -744,8 +715,8 @@ 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(logout,'(4a,i0)') trim(subname)," creating ESMF stream vector field with names", & + 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 @@ -760,19 +731,18 @@ subroutine shr_strdata_init(sdat, model_clock, stream_name, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then sdat%model_calendar = trim(shr_cal_gregorian) else - rc = ESMF_FAILURE call shr_log_error(subname//" ERROR bad ESMF calendar name "//trim(calendar), rc=rc) return 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(logout,'(2a)') trim(subname),' successfully initialized sdat' + write(sdat%logunit,'(2a)') subname,' successfully initialized sdat' endif end subroutine shr_strdata_init @@ -798,7 +768,7 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) integer :: old_handle ! previous setting of pio error handling character(CS) :: units integer :: istat - character(*), parameter :: subname = '(shr_strdata_get_stream_nlev) ' + character(len=*), parameter :: subname = '(shr_strdata_get_stream_nlev) ' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -809,7 +779,7 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) else call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mainproc) then + if (sdat%mainproc) then call shr_stream_getData(sdat%stream(stream_index), 1, filename) end if call ESMF_VMBroadCast(vm, filename, CX, 0, rc=rc) @@ -819,7 +789,6 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) rcode = pio_inq_dimlen(pioid, dimid, stream_nlev) allocate(sdat%pstrm(stream_index)%stream_vlevs(stream_nlev), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for sdat%pstrm('//toString(stream_index)//')%stream_vlevs '//& ' with stream_nlev '//toString(stream_nlev), rc=rc) @@ -841,11 +810,11 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) end if call pio_closefile(pioid) end if - if (mainproc) then - write(logout,*) - write(logout,'(2a,i0)') trim(subname),' stream_nlev = ',stream_nlev + if (sdat%mainproc) then + write(sdat%logunit,*) + write(sdat%logunit,'(2a,i0)') subname,' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then - write(logout,'(3a)') trim(subname),' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs + write(sdat%logunit,'(3a)') subname,' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs end if end if @@ -878,7 +847,7 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r integer :: pio_iovartype integer :: lsize integer :: istat - character(*), parameter :: subname = '(shr_strdata_set_stream_domain) ' + character(len=*), parameter :: subname = '(shr_strdata_set_stream_domain) ' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -886,7 +855,7 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Determine the file to open - if (mainproc) then + if (sdat%mainproc) then call shr_stream_getData(sdat%stream(stream_index), 1, filename) end if call ESMF_VMBroadCast(vm, filename, CX, 0, rc=rc) @@ -906,7 +875,6 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r if (pio_iovartype == PIO_REAL) then allocate(data_real(lsize), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//'allocation error of data_real with size '//toString(lsize), rc=rc) return end if @@ -916,7 +884,6 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r else if (pio_iovartype == PIO_DOUBLE) then allocate(data_double(lsize), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//'allocation error of data_double with size '//toString(lsize), rc=rc) return end if @@ -924,7 +891,6 @@ subroutine shr_strdata_get_stream_domain(sdat, stream_index, fldname, flddata, r flddata(:) = data_double(:) deallocate(data_double) else - rc = ESMF_FAILURE call shr_log_error(subName//"ERROR: only real and double types are supported for stream domain read", rc=rc) return end if @@ -1033,7 +999,7 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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(len=*) ,parameter :: subname = "(shr_strdata_advance) " !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1061,7 +1027,7 @@ 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(logout,'(2a)') 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') @@ -1070,13 +1036,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) if (nstreams > 0) then allocate(newData(nstreams), stat=istat) if ( istat /= 0 ) then - rc = istat 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 - rc = istat call shr_log_error(subName//'allocation error of ymd with size '//toString(nstreams), rc=rc) return end if @@ -1116,16 +1080,19 @@ 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(logout,'(2a)') "ERROR: Unsupported readmode : ", trim(sdat%stream(ns)%readmode) - rc = ESMF_FAILURE + 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. mainproc) then - write(logout,'(2a,2x,i0,2x,a,2x,l4)') trim(subname),' newData flag for stream = ',ns,' is ',newData(ns) - write(logout,'(2a,2x,3(i0,2x))') trim(subname),' LB ymd,tod = ',ns,sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB - write(logout,'(2a,2x,3(i0,2x))') trim(subname),' UB ymd,tod = ',ns,sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB + if (sdat%mainproc) then + if (newData(ns)) then + write(sdat%logunit,'(2a,2x,i0,2x,a,2x,l4)') subname,' newData flag for stream = ',ns,' is ',newData(ns) + write(sdat%logunit,'(2a,2x,3(i0,2x))') subname,' LB ymd,tod = ',ns,sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB + write(sdat%logunit,'(2a,2x,3(i0,2x))') subname,' UB ymd,tod = ',ns,sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB + end if endif ! --------------------------------------------------------- @@ -1144,10 +1111,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(logout,'(3a)') trim(subname),' ERROR: mismatch calendar ', & - trim(sdat%model_calendar),':',trim(sdat%stream(ns)%calendar) - rc = ESMF_FAILURE - 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 @@ -1182,8 +1150,8 @@ 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 (mainproc) then - write(logout,'(2a,2x,i0,a)') trim(subname),' WARNING: Stream ',& + 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 @@ -1193,17 +1161,16 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) sdat%pstrm(ns)%dtmax = max(sdat%pstrm(ns)%dtmax,dtime) if ((sdat%pstrm(ns)%dtmax/sdat%pstrm(ns)%dtmin) > sdat%stream(ns)%dtlimit) then - if (mainproc) then - write(logout,'(2a,i0)') trim(subname),' ERROR: for stream ',ns - write(logout,'(3a)') trim(subname),' ERROR: calendar = ',trim(calendar) - write(logout,'(2a,i0)') trim(subname),' ERROR: dday = ',dday - write(logout,'(2a,4(es13.6,2x))') trim(subName),' ERROR: dtime, dtmax, dtmin, dtlimit = ',& + if (sdat%mainproc) then + 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(logout,'(a,4(i0,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 - rc = ESMF_FAILURE - 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 @@ -1231,7 +1198,6 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) call ESMF_TraceRegionEnter(trim(lstr)//trim(timname)//'_coszen') allocate(coszen(sdat%model_lsize), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//'allocation error of coszen with size '//toString(sdat%model_lsize), rc=rc) return end if @@ -1240,11 +1206,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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, & - mainproc, logout) + sdat%mainproc, sdat%logunit) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenC') - if (debug > 0 .and. mainproc) then + if (debug_level > 0 .and. sdat%mainproc) then do n = 1,size(coszen) - write(logout,'(2a,4(i0,2x),es13.6)') trim(subname),& + 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 @@ -1256,7 +1222,6 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) if (.not. allocated(sdat%tavCoszen)) then allocate(sdat%tavCoszen(sdat%model_lsize), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//'allocation error of sdat%tavCoszen with size '// & toString(sdat%model_lsize), rc=rc) return @@ -1265,11 +1230,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) 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, mainproc, logout, rc=rc) + sdat%stream(ns)%calendar, sdat%mainproc, sdat%logunit, rc=rc) call ESMF_TraceRegionExit(trim(lstr)//trim(timname)//'_coszenN') - if (debug > 0 .and. mainproc) then + if (debug_level > 0 .and. sdat%mainproc) then do n = 1,size(coszen) - write(logout,'(2a,i0,2x,4(i0,2x),i0,es13.6)') trim(subname), & + 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) @@ -1322,13 +1287,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=logout, & + 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. mainproc) then - write(logout,'(2a,i0,2(f10.5,2x))') & - trim(subname),' non-cosz-interp stream, flb, fub= ',ns,flb,fub - write(logout,'(a)') '------------------------------------------------------' + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0,2(f10.5,2x))') & + 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 @@ -1427,33 +1392,33 @@ subroutine shr_strdata_print(sdat, name) ! local variables integer :: ns - character(*),parameter :: subName = "(shr_strdata_print) " + character(len=*),parameter :: subName = "(shr_strdata_print) " !------------------------------------------------------------------------------- - write(logout,*) - write(logout,'(a)') '------------------------------------------------------' - write(logout,'(3a)') trim(subname)," name = ",trim(name) - write(logout,'(3a)') trim(subname)," calendar = ",trim(sdat%model_calendar) - write(logout,'(2a,2x,es13.6)') trim(subname)," eccen = ",sdat%eccen - write(logout,'(2a,2x,es13.6)') trim(subname)," mvelpp = ",sdat%mvelpp - write(logout,'(2a,2x,es13.6)') trim(subname)," lambm0 = ",sdat%lambm0 - write(logout,'(2a,2x,es13.6)') trim(subname)," obliqr = ",sdat%obliqr - write(logout,'(2a,i0)') trim(subname)," pio_iotype = ",sdat%io_type - write(logout,'(2a,2x,i0)') trim(subname)," nstreams = ",shr_strdata_get_stream_count(sdat) - write(logout,'(2a)') trim(subname)," 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(logout,'(2a,i0,2a)') trim(subname)," taxMode (",ns,") = ",trim(sdat%stream(ns)%taxmode) - write(logout,'(2a,i0,a,es13.6)') trim(subname)," dtlimit (",ns,") = ",sdat%stream(ns)%dtlimit - write(logout,'(2a,i0,2a)') trim(subname)," tintalgo(",ns,") = ",trim(sdat%stream(ns)%tinterpalgo) - write(logout,'(2a,i0,2a)') trim(subname)," mapalgo (",ns,") = ",trim(sdat%stream(ns)%mapalgo) - write(logout,'(2a,i0,2a)') trim(subname)," readmode(",ns,") = ",trim(sdat%stream(ns)%readmode) - write(logout,'(2a,i0,2a)') trim(subname)," vectors (",ns,") = ",trim(sdat%stream(ns)%stream_vectors) - write(logout,'(2a,i0,a,i0)') trim(subname)," src_mask(",ns,") = ",sdat%stream(ns)%src_mask_val - write(logout,'(2a,i0,a,i0)') trim(subname)," dst_mask(",ns,") = ",sdat%stream(ns)%dst_mask_val - write(logout,'(2a)') trim(subname)," " + 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(logout,'(a)') '------------------------------------------------------' - write(logout,*) + write(sdat%logunit,'(a)') '------------------------------------------------------' + write(sdat%logunit,*) end subroutine shr_strdata_print @@ -1487,7 +1452,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(len=*), parameter :: subname = '(shr_strdata_readLBUB) ' !------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1530,36 +1495,38 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) newdata = (sdat%pstrm(ns)%ymdLB /= oDateLB .or. sdat%pstrm(ns)%todLB /= oSecLB) ! write time bounds info - if (debug > 0 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname),' stream number is: ',ns - write(logout,'(2a,l7,a,l7)') trim(subname), & + if (debug_level > 0 .and. sdat%mainproc) then + if (debug_level > 0) then + write(sdat%logunit,'(2a,i0)') subname,' stream number is: ',ns + write(sdat%logunit,'(2a,l7,a,l7)') subname, & ' find_bounds = ',find_bounds,' newdata is = ',newdata - write(logout,'(2a,4(2x,i0))') trim(subname), & - ' oDateLB, OSecLb, oDateUB, OsecUB = ',& - oDateLB, OSecLb, oDateUB, OsecUB - write(logout,'(2a,2x,3(f13.6,2x),l4)') trim(subname), & - ' rdateLB,rdateM,rdateUB = ',& - rdateLB, rdateM, rdateUB - write(logout,'(2a,2x,6(i0,2x))') trim(subname), & - ' lbymd,lbsec,mdate,msec,ubymd,ubsec = ',& - sdat%pstrm(ns)%ymdLB, sdat%pstrm(ns)%todLB, & - mdate, msec, & - sdat%pstrm(ns)%ymdUB, sdat%pstrm(ns)%todUB + write(sdat%logunit,'(2a,4(2x,i0))') subname, & + ' oDateLB, OSecLb, oDateUB, OsecUB = ',& + oDateLB, OSecLb, oDateUB, OsecUB + write(sdat%logunit,'(2a,2x,3(f13.6,2x),l4)') subname, & + ' rdateLB,rdateM,rdateUB = ',& + rdateLB, rdateM, rdateUB + write(sdat%logunit,'(2a,2x,6(i0,2x))') subname, & + ' 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 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 > 0 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname),' Copying upper bound bound of data to lower bound for stream ',ns + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0)') subname,' Copying upper bound bound of data to lower bound for stream ',ns 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 > 0 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname),' Reading in new lower bound of data for stream ',ns + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0)') subname,' Reading in new lower bound of data for stream ',ns end if ! read lower bound of data call shr_strdata_readstrm(sdat, sdat%pstrm(ns), stream, & @@ -1575,14 +1542,14 @@ 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 > 0 .and. mainproc) then - write(logout,'(2a,i0)') trim(subname),' Reading in new upper bound of data for stream ',ns + if (debug_level > 0 .and. sdat%mainproc) then + write(sdat%logunit,'(2a,i0)') subname,' Reading in new upper bound of data for stream ',ns end if endif ! determine previous & next data files in list of files call ESMF_TraceRegionEnter(trim(istr)//'_filemgt') - if (mainproc .and. newdata) then + if (sdat%mainproc .and. newdata) then call shr_stream_getPrevFileName(stream, filename_lb, filename_prev) call shr_stream_getNextFileName(stream, filename_ub, filename_next) inquire(file=trim(filename_next),exist=fileExists) @@ -1655,7 +1622,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & logical :: checkflag = .false. character(CL) :: errmsg integer :: istat - character(*), parameter :: subname = '(shr_strdata_readstrm) ' + character(len=*), parameter :: subname = '(shr_strdata_readstrm) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1671,10 +1638,9 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & nullify(data_v_dst) ! Set up file to read from - if (mainproc) then + if (sdat%mainproc) then inquire(file=trim(fileName),exist=fileExists) if (.not. fileExists) then - rc = ESMF_FAILURE call shr_log_error(subName//"ERROR: file does not exist: "//trim(fileName), rc=rc) return end if @@ -1688,13 +1654,13 @@ 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 (mainproc) then - write(logout,'(3a)') trim(subname),' closing : ',trim(currfile) + if (sdat%mainproc) then + write(sdat%logunit,'(3a)') subname,' closing : ',trim(currfile) end if call pio_closefile(pioid) endif - if (mainproc) then - write(logout,'(3a)') trim(subname),' 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) @@ -1708,8 +1674,8 @@ 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 (mainproc) then - write(logout,'(3a)') trim(subname),' setting pio descriptor : ',trim(filename) + if (sdat%mainproc) then + write(sdat%logunit,'(3a)') subname,' setting pio descriptor : ',trim(filename) end if call shr_strdata_set_stream_iodesc(sdat, per_stream, trim(per_stream%fldlist_stream(1)), & pioid, rc=rc) @@ -1727,7 +1693,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (stream_nlev == 1) then allocate(dataptr1d(1)) else - rc = ESMF_FAILURE call shr_log_error("ERROR: multi-level streams always require a stream mesh", rc=rc) return end if @@ -1741,8 +1706,8 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & ! ****************************************************************************** call ESMF_TraceRegionEnter(trim(istr)//'_readpio') - if (mainproc) then - write(logout,'(5a)') trim(subname),' reading file ',trim(boundstr),': ',trim(filename) + if (sdat%mainproc) then + write(sdat%logunit,'(5a)') subname,' reading file ',trim(boundstr),': ',trim(filename) endif if (ESMF_FieldIsCreated(per_stream%field_stream_vector)) then @@ -1764,7 +1729,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & if (pio_iovartype == PIO_REAL .and. .not. allocated(data_real2d)) then allocate(data_real2d(lsize, stream_nlev), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//'allocation error of data_real2d with size '// & toString(lsize*stream_nlev), rc=rc) return @@ -1772,7 +1736,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & else if (pio_iovartype == PIO_DOUBLE .and. .not. allocated(data_dbl2d)) then allocate(data_dbl2d(lsize, stream_nlev), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//'allocation error of data_dbl2d with size '// & toString(lsize*stream_nlev), rc=rc) return @@ -1821,13 +1784,11 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & else if (pio_iovartype == PIO_SHORT) then rcode = pio_get_att(pioid, varid, "scale_factor", scale_factor) if(rcode /= PIO_NOERR) then - rc = rcode call shr_log_error('DATATYPE PIO_SHORT requires attributes scale_factor', rc=rc) return endif rcode = pio_get_att(pioid, varid, "add_offset", add_offset) if(rcode /= PIO_NOERR) then - rc = rcode call shr_log_error('DATATYPE PIO_SHORT requires attributes add_offset', rc=rc) return endif @@ -1836,8 +1797,8 @@ 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. mainproc) then - write(logout,'(6a,i0)') trim(subname),& + if (debug_level>0 .and. sdat%mainproc) then + write(sdat%logunit,'(6a,i0)') subname,& ' reading ',trim(per_stream%fldlist_stream(nf)), & ' into ',trim(per_stream%fldlist_model(nf)), & ' at time index: ',nt @@ -1856,16 +1817,16 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,1,nt/),count=(/1,1,1,1/), ival=data_real2d) end if if ( rcode /= PIO_NOERR ) then - rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if 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,'(2a)')' ERROR: _Fillvalue found in stream input variable: '// trim(per_stream%fldlist_stream(nf)) - if (mainproc) then - write(logout,'(2a)') trim(subname),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 @@ -1893,7 +1854,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,nt/),count=(/1,1,1/), ival=data_real1d) endif if ( rcode /= PIO_NOERR ) then - rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1901,10 +1861,9 @@ 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_real1d == fillvalue_r4)) then write (errmsg,'(2a)')' ERROR: _Fillvalue found in stream input variable: ',trim(per_stream%fldlist_stream(nf)) - if (mainproc) then - write(logout,'(2a)') trim(subname),trim(errmsg) + if (sdat%mainproc) then + write(sdat%logunit,'(2a)') subname,trim(errmsg) end if - rc = ESMF_FAILURE call shr_log_error(errmsg, rc=rc) return endif @@ -1932,7 +1891,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,1,nt/), count=(/1,1,1,1/), ival=data_dbl2d) end if if ( rcode /= PIO_NOERR ) then - rc = rcode call shr_log_error(' ERROR: reading in 2d double variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1966,7 +1924,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,nt/), count=(/1,1,1/), ival=data_dbl1d) endif if ( rcode /= PIO_NOERR ) then - rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1974,7 +1931,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(trim(subname)//trim(errmsg), rc=rc) + call shr_log_error(subname//trim(errmsg), rc=rc) return endif do n = 1,size(dataptr1d) @@ -2002,7 +1959,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,1,nt/), count=(/1,1,1,1/), ival=data_short2d) end if if ( rcode /= PIO_NOERR ) then - rc = rcode call shr_log_error(' ERROR: reading in 2d short variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -2030,7 +1986,6 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,nt/),count=(/1,1,1/), ival=data_short1d) endif if ( rcode /= PIO_NOERR ) then - rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -2193,7 +2148,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) integer, pointer :: compdof3d(:) integer :: rCode ! pio return code (only used when pio error handling is PIO_BCAST_ERROR) integer :: istat - character(*), parameter :: subname = '(shr_strdata_set_stream_iodesc) ' + character(len=*), parameter :: subname = '(shr_strdata_set_stream_iodesc) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -2212,15 +2167,13 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) ! allocate memory for dimids and dimlens allocate(dimids(ndims), stat=istat) if ( istat /= 0 ) then - call shr_log_error(subName//'allocation error of dimids with size '// & - toString(ndims), rc=rc) + 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) + 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)) @@ -2235,8 +2188,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(compdof(lsize), stat=istat) if ( istat /= 0 ) then - call shr_log_error(subName//'allocation error of compdof '// & - toString(lsize), rc=rc) + 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) @@ -2257,7 +2209,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) ! third dimension is lev and fourth dimension is time gsize2d = dimlens(1)*dimlens(2) else - call shr_log_error(trim(subname)//' only ndims of 3 and 4 '//& + 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 @@ -2270,7 +2222,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) ! third dimension is lev gsize2d = dimlens(1)*dimlens(2) else - call shr_log_error(trim(subname)//' only ndims of 2 and 3 '// & + 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 @@ -2294,23 +2246,23 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) !------------------------------- rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if ((trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then - if (mainproc) then - write(logout,'(4a,i0,a)') trim(subname),' setting iodesc for 2d: ',trim(fldname), & + if (sdat%mainproc) then + 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 (mainproc) then - write(logout,'(4a,i0,2x,i0,a)') trim(subname),' setting iodesc for 2d: ',trim(fldname), & + 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 (mainproc) then - write(logout,'(4a,i0,2x,i0,a)') trim(subname),' setting iodesc for 2d: ',trim(fldname), & + 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 the variable has no time or vertical dimension ' end if @@ -2324,8 +2276,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if (trim(dimname) == 'time' .or. trim(dimname) == 'nt') then if (stream_nlev > 1) then - if (mainproc) then - write(logout,'(4a,i0,2x,i0,a)') trim(subname), & + 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 ' @@ -2333,8 +2285,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) call pio_initdecomp(sdat%pio_subsystem, pio_iovartype, (/dimlens(1),dimlens(2)/), compdof3d, & per_stream%stream_pio_iodesc) else - if (mainproc) then - write(logout,'(4a,i0,2x,i0,a)') trim(subname),& + 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 ' @@ -2344,8 +2296,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) end if else if (stream_nlev > 1) then - if (mainproc) then - write(logout,'(4a,3(i0,2x),a)') trim(subname), & + 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' @@ -2353,7 +2305,7 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) 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(trim(subname)//& + 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 @@ -2364,8 +2316,8 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) !------------------------------- rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) if (stream_nlev > 1 .and. (trim(dimname) == 'time' .or. trim(dimname) == 'nt')) then - if (mainproc) then - write(logout,'(4a,3(i0,2x),a)') trim(subname), & + if (sdat%mainproc) then + 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 ' @@ -2373,12 +2325,12 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) 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(trim(subname)//' dimlens = 4 assumes a time dimension and a vertical dimension', rc=rc) + call shr_log_error(subname//' dimlens = 4 assumes a time dimension and a vertical dimension', rc=rc) return end if else - 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 @@ -2432,8 +2384,8 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, & if (found) then ! If pointer found, preset value - if (mainproc) then - write(logout,'(3a)') trim(subname), & + 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) @@ -2444,8 +2396,8 @@ subroutine shr_strdata_get_stream_pointer_1d(sdat, strm_fld, strm_ptr, & if (present(requirePointer)) then if (requirePointer) then if (present(errmsg)) then - if (mainproc) then - write(logout,'(2a)') trim(subname), trim(errmsg) + 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) @@ -2498,8 +2450,8 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & if (found) then ! If pointer found, preset value - if (mainproc) then - write(logout,'(3a)') trim(subname), & + 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) @@ -2512,8 +2464,8 @@ subroutine shr_strdata_get_stream_pointer_2d(sdat, strm_fld, strm_ptr, & if (present(requirePointer)) then if (requirePointer) then if (present(errmsg)) then - if (mainproc) then - write(logout,'(2a)') trim(subname),trim(errmsg) + 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) diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index d58e917d2..a61adb7ea 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -103,6 +103,8 @@ 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 logical :: init = .false. ! has stream been initialized @@ -137,13 +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 + integer , parameter :: main_task = 0 - integer :: logout - logical :: mainproc - - character(*) , parameter :: u_FILE_u = & + character(len=*) , parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -156,7 +156,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu 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, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadCast, ESMF_SUCCESS ! --------------------------------------------------------------------- ! The xml format of a stream txt file will look like the following @@ -206,21 +206,17 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu integer :: tmp(6) real(r8) :: rtmp(1) integer :: istat - character(*),parameter :: subName = '(shr_stream_init_from_xml) ' + character(len=*),parameter :: subName = '(shr_stream_init_from_xml) ' ! -------------------------------------------------------- rc = ESMF_SUCCESS nstrms = 0 - ! Set module variables logout and mainproc - logout = logunit - mainproc = isroot_task - if (mainproc) then + if_isroot_task: if (isroot_task) then Sdoc => parseFile(streamfilename, iostat=status) if (status /= 0) then - rc = ESMF_FAILURE call shr_log_error("Could not parse file "//trim(streamfilename), rc=rc) return endif @@ -228,13 +224,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu nstrms = getLength(streamlist) ! allocate an array of shr_streamtype objects on just mainproc - allocate(streamdat(nstrms), stat=istat) - if ( istat /= 0 ) then - rc = istat - call shr_log_error(subName//& - ': allocation error for streamdat with size '//toString(nstrms), rc=rc) - return - end if + allocate(streamdat(nstrms)) ! fill in non-default values for the streamdat attributes do i= 1, nstrms @@ -246,7 +236,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (streamdat(i)%taxmode /= shr_stream_taxis_cycle .and. & streamdat(i)%taxmode /= shr_stream_taxis_extend .and. & streamdat(i)%taxmode /= shr_stream_taxis_limit) then - rc = ESMF_FAILURE call shr_log_error("tintalgo must have a value of either cycle, extend or limit", rc=rc) return end if @@ -261,7 +250,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%mapalgo /= shr_stream_mapalgo_consf .and. & streamdat(i)%mapalgo /= shr_stream_mapalgo_consd .and. & streamdat(i)%mapalgo /= shr_stream_mapalgo_none) then - rc = ESMF_FAILURE call shr_log_error("mapaglo must have a value of either bilinear, redist, nn, consf or consd", rc=rc) return end if @@ -275,7 +263,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu streamdat(i)%tInterpAlgo /= shr_stream_tinterp_nearest .and. & streamdat(i)%tInterpAlgo /= shr_stream_tinterp_linear .and. & streamdat(i)%tInterpAlgo /= shr_stream_tinterp_coszen) then - rc = ESMF_FAILURE call shr_log_error("tintalgo must have a value of either lower, upper, nearest, linear or coszen", rc=rc) return end if @@ -290,26 +277,21 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if(associated(p)) then call extractDataContent(p, streamdat(i)%yearFirst) else - rc = ESMF_FAILURE - 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 - rc = ESMF_FAILURE - 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 - rc = ESMF_FAILURE - call shr_log_error("yearAlign must be provided", rc=rc) + call shr_sys_abort(subname//" yearAlign must be provided", rc=rc) return endif @@ -327,18 +309,14 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%meshfile) else - rc = ESMF_FAILURE - 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 - rc = ESMF_FAILURE - 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 @@ -346,28 +324,17 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%lev_dimname) else - rc = ESMF_FAILURE - 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 - rc = ESMF_FAILURE - 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), stat=istat) - if ( istat /= 0 ) then - rc = istat - call shr_log_error(subName//& - ': allocation error for streamdat('//toString(i)//')%file'//& - ' with size '//toString(streamdat(i)%nfiles), rc=rc) - return - end if + 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) @@ -377,14 +344,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu p => item(getElementsByTagname(streamnode, "datavars"), 0) varlist => getElementsByTagname(p, "var") streamdat(i)%nvars = getLength(varlist) - allocate(streamdat(i)%varlist(streamdat(i)%nvars), stat=istat) - if ( istat /= 0 ) then - rc = istat - call shr_log_error(subName//& - ': allocation error for streamdat('//toString(i)//')%varlist'//& - ' with size '//toString(streamdat(i)%nvars), rc=rc) - return - end if + allocate(streamdat(i)%varlist(streamdat(i)%nvars)) do n = 1, streamdat(i)%nvars p => item(varlist, n-1) call extractDataContent(p, tmpstr) @@ -394,10 +354,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) @@ -406,50 +366,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. mainproc) then + + if (.not. isroot_task) then allocate(streamdat(nstrms), stat=istat) - if ( istat /= 0 ) then - rc = istat - call shr_log_error(subName//& - ': allocation error for streamdat with size '//toString(nstrms), rc=rc) - return - end if 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 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. mainproc) then - allocate(streamdat(i)%file(streamdat(i)%nfiles), stat=istat) - if ( istat /= 0 ) then - rc = istat - call shr_log_error(subName//& - ': allocation error for streamdat('//toString(i)//')%file'//& - ' with size '//toString(streamdat(i)%nfiles), rc=rc) - return - end if - allocate(streamdat(i)%varlist(streamdat(i)%nvars), stat=istat) - if ( istat /= 0 ) then - rc = istat - call shr_log_error(subName//& - ': allocation error for streamdat('//toString(i)//')%varlist'//& - ' with size '//toString(streamdat(i)%nvars), rc=rc) - return - end if + + 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 @@ -483,31 +435,32 @@ 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 - if (mainproc) then - write(logout,'(2a,i0)') subname,' getting calendar for stream ',i + 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 (mainproc) then - write(logout,'(2a,i0,2a)') subname,' calendar for stream ',i,' is ',trim(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 - rc = ESMF_FAILURE 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 loop_over_streams end subroutine shr_stream_init_from_xml @@ -536,19 +489,19 @@ 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 @@ -560,23 +513,19 @@ subroutine shr_stream_init_from_inline(streamdat, & integer :: nfiles integer :: nvars integer :: istat - integer :: rc character(CS) :: calendar ! stream calendar - character(*),parameter :: subName = '(shr_stream_init_from_inline) ' + character(len=*),parameter :: subName = '(shr_stream_init_from_inline) ' ! -------------------------------------------------------- - ! Set module variagble logout - logout = logunit - - ! Initialize module variable mainproc - mainproc = isroot_task - ! Assume only 1 stream 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) streamdat(1)%lev_dimname = trim(stream_lev_dimname) @@ -596,7 +545,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 @@ -649,7 +598,7 @@ 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, ESMF_VMGet - use esmf , only : ESMF_SUCCESS, ESMF_ConfigCreate, ESMF_ConfigLoadFile, ESMF_FAILURE + use esmf , only : ESMF_SUCCESS, ESMF_ConfigCreate, ESMF_ConfigLoadFile use esmf , only : ESMF_ConfigGetLen, ESMF_ConfigGetAttribute use esmf , only : ESMF_Config, ESMF_MAXSTR @@ -693,21 +642,17 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, character(2) :: mystrm integer :: istat character(len=ESMF_MAXSTR), allocatable :: strm_tmpstrings(:) - character(*), parameter :: u_FILE_u = __FILE__ - character(*), parameter :: subName = '(shr_stream_init_from_esmfconfig)' + character(len=*), parameter :: u_FILE_u = __FILE__ + character(len=*), parameter :: subName = '(shr_stream_init_from_esmfconfig)' ! --------------------------------------------------------------------- rc = ESMF_SUCCESS - ! Set module variable logout - logout = logunit - ! 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 - mainproc = (myid == 0) ! allocate streamdat instance on all tasks nstrms = 0 @@ -721,22 +666,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 mainproc - if( nstrms > 0 ) then + ! allocate an array of shr_stream_streamtype objects + if (nstrms > 0) then allocate(streamdat(nstrms), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//': allocation error for streamdat with size '//toString(nstrms),rc=rc) return end if else - rc = istat - 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 @@ -754,7 +701,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearFirst,label="yearFirst"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - rc = ESMF_FAILURE call shr_log_error("yearFirst must be provided", rc=rc) return endif @@ -763,7 +709,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearLast,label="yearLast"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - rc = ESMF_FAILURE call shr_log_error("yearLast must be provided", rc=rc) return endif @@ -772,7 +717,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearAlign,label="yearAlign"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - rc = ESMF_FAILURE call shr_log_error("yearAlign must be provided", rc=rc) return endif @@ -787,7 +731,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%meshfile,label="stream_mesh_file"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - rc = ESMF_FAILURE call shr_log_error("stream_mesh_file must be provided", rc=rc) return endif @@ -796,7 +739,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%stream_vectors,label="stream_vectors"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - rc = ESMF_FAILURE call shr_log_error("stream_vectors must be provided", rc=rc) return endif @@ -805,7 +747,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%lev_dimname,label="stream_lev_dimname"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - rc = ESMF_FAILURE call shr_log_error("stream_lev_dimname must be provided", rc=rc) return endif @@ -815,7 +756,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, if( streamdat(i)%nfiles > 0) then allocate(streamdat(i)%file( streamdat(i)%nfiles), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for streamdat('//toString(i)//')%file'//& ' with size '//toString(streamdat(i)%nfiles), rc=rc) @@ -829,7 +769,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, enddo deallocate(strm_tmpstrings) else - rc = ESMF_FAILURE call shr_log_error("stream data files must be provided", rc=rc) return endif @@ -839,7 +778,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, if( streamdat(i)%nvars > 0) then allocate(streamdat(i)%varlist(streamdat(i)%nvars), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for streamdat('//toString(i)//')%varlist'//& ' with size '//toString(streamdat(i)%nvars), rc=rc) @@ -847,7 +785,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, end if allocate(strm_tmpstrings(streamdat(i)%nvars), stat=istat) if ( istat /= 0 ) then - rc = istat call shr_log_error(subName//& ': allocation error for strm_tmpstrings('//toString(i)//')%varlist'//& ' with size '//toString(streamdat(i)%nvars), rc=rc) @@ -860,7 +797,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, enddo deallocate(strm_tmpstrings) else - rc = ESMF_FAILURE call shr_log_error("stream data variables must be provided", rc=rc) return endif @@ -881,7 +817,6 @@ 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 - rc = ESMF_FAILURE call shr_log_error(subname//" ERROR: if taxmode value is extend set dtlimit to 1.e30", rc=rc) return end if @@ -915,12 +850,12 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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 @@ -944,11 +879,11 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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(len=*),parameter :: subName = '(shr_stream_findBounds) ' !------------------------------------------------------------------------------- - if (debug>0 .and. mainproc) then - write(logout,'(a,a)') subname,"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 @@ -982,8 +917,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & n = 0 if (cycle) then dYear = yrFirst + modulo(mYear-yrAlign+(2*nYears),nYears) ! current data year - if(debug>0 .and. mainproc) then - write(logout,'(2a,4(i0,2x))') subname, ' dyear, yrfirst, myear, yralign, nyears = ', & + if(debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(2a,4(i0,2x))') subname, ' dyear, yrfirst, myear, yralign, nyears = ', & dyear, yrfirst, myear, yralign, nyears endif else @@ -991,18 +926,18 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & endif if (dYear < 0) then - if (mainproc) then - write(logout,'(2a,i0)') subname,' ERROR: dyear lt zero = ',dYear + 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. mainproc) then - write(logout,'(2a,3(i0,2x),f20.4)') subname, & + 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(logout,'(a,4(i0,2x))') subname, & + write(strm%logunit,'(a,4(i0,2x))') subname, & ' yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears endif @@ -1033,14 +968,14 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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 - if (mainproc) then - write(logout,'(2a)') 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. mainproc) then - if (strm%found_lvd) write(logout,'(2a,i0)') subname," 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 @@ -1049,8 +984,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & n = strm%n_lvd rDatelvd = strm%file(k)%date(n) + strm%file(k)%secs(n)/spd ! LVD date + frac day else - if (mainproc) then - write(logout,'(2a)') 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 @@ -1062,8 +997,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & else rDategvd = 99991231.0 endif - if (debug>0 .and. mainproc) then - write(logout,'(2a,3(f20.4,2x))') subname,' 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 !----------------------------------------------------------- @@ -1075,8 +1010,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (rDateIn < rDatelvd) then if (limit) then - if (mainproc) then - write(logout,'(2a,2(f20.4,2x))') subname,& + 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") @@ -1120,8 +1055,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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. mainproc) then - write(logout,'(2a,i0)') subname," 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 @@ -1130,8 +1065,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & end if if (.not. strm%found_gvd) then - if (mainproc) then - write(logout,'(2a)') 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 @@ -1166,8 +1101,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & else if (strm%found_gvd .and. rDateIn >= rDategvd) then if (limit) then - if (mainproc) then - write(logout,'(2a,2(f13.5,2x))') subname,& + 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") @@ -1269,8 +1204,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (strm%found_gvd .and. rDateIn >= rDategvd) then if (limit) then - if (mainproc) then - write(logout,'(2a,2(f13.5,2x))') subname,& + 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") @@ -1346,8 +1281,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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 (mainproc) then - write(logout,'(2a,3(i0,2x))') subname,' 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 @@ -1395,7 +1330,7 @@ subroutine shr_stream_readTCoord(strm, k, rc) real(R8),allocatable :: tvar(:) character(CX) :: msg integer :: istat - character(*),parameter :: subname = '(shr_stream_readTCoord) ' + character(len=*),parameter :: subname = '(shr_stream_readTCoord) ' !------------------------------------------------------------------------------- lrc = 0 @@ -1405,8 +1340,8 @@ subroutine shr_stream_readTCoord(strm, k, rc) ! open file if needed if (.not. pio_file_is_open(strm%file(k)%fileid)) then - if (debug>1 .and. mainproc) then - write(logout,'(3a)') 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 @@ -1480,8 +1415,8 @@ subroutine shr_stream_readTCoord(strm, k, rc) deallocate(tvar) ! close file - if (debug>1 .and. mainproc) then - write(logout,'(3a)') 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) @@ -1497,16 +1432,16 @@ subroutine shr_stream_readTCoord(strm, k, rc) do n = 1,num din = strm%file(k)%date(n) sin = strm%file(k)%secs(n) - if (debug > 5 .and. mainproc) then - write(logout,'(2a,4(i0,2x))') subname,& + if (debug_level > 5 .and. strm%mainproc) then + write(strm%logunit,'(2a,4(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 - if (debug > 5 .and. mainproc) then - write(logout,'(2a,5(i0,2x))') subname,& + 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 @@ -1537,7 +1472,7 @@ 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(len=*),parameter :: subName = '(shr_stream_verifyTCoord) ' !------------------------------------------------------------------------------- ! Notes: @@ -1550,14 +1485,14 @@ subroutine verifyTCoord(strm,k,rc) !------------------------------------------------------------------------------- rc = 0 - if (debug>1 .and. mainproc) then - write(logout,'(2a,i0)') subname," 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 - if (mainproc) then - write(logout,'(2a,i0)') subname," ERROR: do not 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 @@ -1576,8 +1511,8 @@ subroutine verifyTCoord(strm,k,rc) date2 = strm%file(k )%date(n) secs2 = strm%file(k )%secs(n) checkIt = .true. - if (debug>1 .and. mainproc) then - write(logout,'(2a,i0)') subname," 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 @@ -1591,8 +1526,8 @@ 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. mainproc) then - write(logout,'(2a,i0)') subname," 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 @@ -1609,34 +1544,34 @@ subroutine verifyTCoord(strm,k,rc) if (checkIt) then if ( date1 > date2 ) then rc = 1 - if (mainproc) then - write(logout,'(2a)') subname," ERROR: calendar dates must be increasing" - write(logout,'(2a,2(i0,2x))') subname," 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 - if (mainproc) then - write(logout,'(2a)') subname, "ERROR: elapsed seconds on a date must be strictly increasing" - write(logout,'(2a,2(i0,2x))') subname," 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 - if (mainproc) then - write(logout,'(2a)') subname," ERROR: elapsed seconds out of valid range [0,spd]" - write(logout,'(2a,i0)') subname, " 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 stream_file_times - if (debug>0 .and. mainproc) then - write(logout,'(2a,i0)') subname," data is OK (non-decreasing) for file k =",k + 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 @@ -1663,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 @@ -1682,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 @@ -1703,7 +1638,7 @@ subroutine shr_stream_getCalendar(strm, k, calendar) ! 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 integer :: vid, n @@ -1712,7 +1647,7 @@ subroutine shr_stream_getCalendar(strm, k, calendar) integer(PIO_OFFSET_KIND) :: attlen integer :: old_handle integer :: rCode - character(*),parameter :: subName = '(shr_stream_getCalendar) ' + character(len=*),parameter :: subName = '(shr_stream_getCalendar) ' !------------------------------------------------------------------------------- lcal = ' ' @@ -1722,13 +1657,13 @@ subroutine shr_stream_getCalendar(strm, k, calendar) fileName = strm%file(k)%name if (.not. pio_file_is_open(strm%file(k)%fileid)) then - if (debug>0 .and. mainproc) then - write(logout,'(3a)') 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 (debug>0 .and. mainproc) then - write(logout,'(3a)') subname,' reading stream filename = ',trim(filename) + if (debug_level>0 .and. strm%mainproc) then + write(strm%logunit,'(3a)') subname,' reading stream filename = ',trim(filename) end if endif @@ -1749,8 +1684,8 @@ subroutine shr_stream_getCalendar(strm, k, calendar) if(n>0) then if (ichar(lcal(n:n)) == 0 ) lcal(n:n) = ' ' else - if (debug>0 .and. mainproc) then - write(logout,'(2a)') subname,& + 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)) @@ -1759,8 +1694,8 @@ subroutine shr_stream_getCalendar(strm, k, calendar) call shr_string_leftalign_and_convert_tabs(lcal) calendar = trim(shr_cal_calendarName(trim(lcal))) - if (debug>0 .and. mainproc) then - write(logout, '(3a)') 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) @@ -1774,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 !------------------------------------------------------------------------------- @@ -1792,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 !------------------------------------------------------------------------------- @@ -1811,15 +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(len=*),parameter :: subName = '(shr_stream_getNextFileName) ' !------------------------------------------------------------------------------- rCode = 0 @@ -1834,8 +1769,8 @@ subroutine shr_stream_getNextFileName(strm, fn, fnNext,rc) end do if (.not. found) then rCode = 1 - if (mainproc) then - write(logout,'(3a)') subname," ERROR: input file name is not in stream file: ",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 @@ -1862,15 +1797,15 @@ 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(len=*),parameter :: subName = '(shr_stream_getPrevFileName) ' !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- @@ -1890,8 +1825,8 @@ subroutine shr_stream_getPrevFileName(strm, fn, fnPrev,rc) end do if (.not. found) then rCode = 1 - if (mainproc) then - write(logout,'(3a)') subname," 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 @@ -1945,7 +1880,7 @@ subroutine shr_stream_restIO(pioid, streams, mode) integer, allocatable :: tmp(:) character(len=CX) :: fname, rfname, rsfname integer :: istat - character(*),parameter :: subName = '(shr_stream_restIO) ' + character(len=*),parameter :: subName = '(shr_stream_restIO) ' !------------------------------------------------------------------------------- if (mode .eq. 'define') then @@ -2146,31 +2081,32 @@ 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) - 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 - if (mainproc) then - write(logout,'(6a)') subname,' filename ',trim(streams(k)%file(n)%name), & + 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 - if (mainproc) then - write(logout,'(6a)') subname,'Filename path ',trim(rfname),& + 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 - if (mainproc) then - write(logout,'(2a)') subname,trim(rfname), '<>', trim(rsfname) - write(logout,'(2a)') subname,' fname = '//trim(fname) - write(logout,'(2a,i0,2x,i0,2x,a)') subname,' k,n,streams(k)%file(n)%name = ',& + if (streams(k)%mainproc) then + write(streams(k)%logunit,'(2a)') subname,trim(rfname), '<>', trim(rsfname) + write(streams(k)%logunit,'(2a)') 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') @@ -2225,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 @@ -2241,29 +2177,29 @@ subroutine shr_stream_dataDump(strm) ! local variables integer :: nf,nt ! generic loop indices - character(*),parameter :: subName = '(shr_stream_dataDump) ' + character(len=*),parameter :: subName = '(shr_stream_dataDump) ' !------------------------------------------------------------------------------- - if (debug>0 .and. mainproc) then - write(logout,'(2a)') subname,"dump internal data for debugging..." - write(logout,'(2a,i0)') subname," nFiles = ", strm%nFiles + 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(logout,'(2a,i0)') subname," data for file nf = ",nf - write(logout,'(2a)') subname," file(nf)%name = ", trim(strm%file(nf)%name) + 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(logout,'(2a,i0)') subname," file(nf)%nt = ", strm%file(nf)%nt + write(strm%logunit,'(2a,i0)') subname," file(nf)%nt = ", strm%file(nf)%nt do nt = 1, size(strm%file(nf)%date) - write(logout,'(2a,2(i0,2x))') subname," file(nf)%date(nt) = ",nt,strm%file(nf)%date(nt) - write(logout,'(2a,2(i0,2x))') subname," file(nf)%secs(nt) = ",nt,strm%file(nf)%secs(nt) + 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(logout,'(2a)') subname,' 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(logout,'(2a,3(2x,i0))') subname,"yearF/L/A = ",strm%yearFirst,strm%yearLast,strm%yearAlign - write(logout,'(2a,i0)') subname,"offset = ",strm%offset - write(logout,'(3a)') subname,"taxMode = ",trim(strm%taxMode) - write(logout,'(3a)') subname,"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 From f387187b75041afd61158d98a61376c6358a62f4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 30 Dec 2025 11:30:13 +0100 Subject: [PATCH 25/44] reintroduced rc=rcode before calls to shr_log_error for pio errors --- streams/dshr_strdata_mod.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 10c915716..ad2cb87f3 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -1784,11 +1784,13 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & else if (pio_iovartype == PIO_SHORT) then rcode = pio_get_att(pioid, varid, "scale_factor", scale_factor) if(rcode /= PIO_NOERR) then + rc = rcode call shr_log_error('DATATYPE PIO_SHORT requires attributes scale_factor', rc=rc) return endif rcode = pio_get_att(pioid, varid, "add_offset", add_offset) if(rcode /= PIO_NOERR) then + rc = rcode call shr_log_error('DATATYPE PIO_SHORT requires attributes add_offset', rc=rc) return endif @@ -1817,6 +1819,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,1,nt/),count=(/1,1,1,1/), ival=data_real2d) end if if ( rcode /= PIO_NOERR ) then + rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1854,6 +1857,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,nt/),count=(/1,1,1/), ival=data_real1d) endif if ( rcode /= PIO_NOERR ) then + rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1891,6 +1895,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,1,nt/), count=(/1,1,1,1/), ival=data_dbl2d) end if if ( rcode /= PIO_NOERR ) then + rc = rcode call shr_log_error(' ERROR: reading in 2d double variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1924,6 +1929,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,nt/), count=(/1,1,1/), ival=data_dbl1d) endif if ( rcode /= PIO_NOERR ) then + rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1959,6 +1965,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,1,nt/), count=(/1,1,1,1/), ival=data_short2d) end if if ( rcode /= PIO_NOERR ) then + rc = rcode call shr_log_error(' ERROR: reading in 2d short variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if @@ -1986,6 +1993,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & rcode = pio_get_var(pioid, varid,start=(/1,1,nt/),count=(/1,1,1/), ival=data_short1d) endif if ( rcode /= PIO_NOERR ) then + rc = rcode call shr_log_error(' ERROR: reading in variable: '// trim(per_stream%fldlist_stream(nf)), rc=rc) return end if From edd217673243c61dab8204e4d1b819342a48aea2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 30 Dec 2025 12:49:46 +0100 Subject: [PATCH 26/44] more reformatting of output data --- streams/dshr_strdata_mod.F90 | 50 +++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index ad2cb87f3..9eef15141 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -812,9 +812,11 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) end if if (sdat%mainproc) then write(sdat%logunit,*) - write(sdat%logunit,'(2a,i0)') subname,' stream_nlev = ',stream_nlev + write(sdat%logunit,'(2a,i0,a,i0)') subname, & + 'Stream: ',stream_index,' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then - write(sdat%logunit,'(3a)') subname,' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs + write(sdat%logunit,'(3a)') subname,& + 'Stream: ',stream_index,' stream vertical levels = ',sdat%pstrm(stream_index)%stream_vlevs end if end if @@ -1087,12 +1089,11 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) return end select - if (sdat%mainproc) then - if (newData(ns)) then - write(sdat%logunit,'(2a,2x,i0,2x,a,2x,l4)') subname,' newData flag for stream = ',ns,' is ',newData(ns) - write(sdat%logunit,'(2a,2x,3(i0,2x))') subname,' LB ymd,tod = ',ns,sdat%pstrm(ns)%ymdLB,sdat%pstrm(ns)%todLB - write(sdat%logunit,'(2a,2x,3(i0,2x))') subname,' UB ymd,tod = ',ns,sdat%pstrm(ns)%ymdUB,sdat%pstrm(ns)%todUB - end if + 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 ! --------------------------------------------------------- @@ -1497,16 +1498,19 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) ! write time bounds info if (debug_level > 0 .and. sdat%mainproc) then if (debug_level > 0) then - write(sdat%logunit,'(2a,i0)') subname,' stream number is: ',ns - write(sdat%logunit,'(2a,l7,a,l7)') subname, & - ' find_bounds = ',find_bounds,' newdata is = ',newdata - write(sdat%logunit,'(2a,4(2x,i0))') subname, & - ' oDateLB, OSecLb, oDateUB, OsecUB = ',& + 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,2x,3(f13.6,2x),l4)') subname, & - ' rdateLB,rdateM,rdateUB = ',& + write(sdat%logunit,'(2a,i0,a,2x,3(f13.6,2x),l4)') subname, & + 'Stream: ',ns,& + ' rdateLB,rdateM,rdateUB = ',& rdateLB, rdateM, rdateUB - write(sdat%logunit,'(2a,2x,6(i0,2x))') subname, & + 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, & @@ -1518,7 +1522,7 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) 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)') subname,' Copying upper bound bound of data to lower bound for stream ',ns + 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 @@ -1526,7 +1530,7 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) sdat%pstrm(ns)%stream_lb = i else if (debug_level > 0 .and. sdat%mainproc) then - write(sdat%logunit,'(2a,i0)') subname,' Reading in new lower bound of data for stream ',ns + 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, & @@ -1543,7 +1547,7 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) 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)') subname,' Reading in new upper bound of data for stream ',ns + write(sdat%logunit,'(2a,i0,a)') subname,' Stream: ',ns,' Reading in new upper bound of data' end if endif @@ -1674,8 +1678,8 @@ 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) then - write(sdat%logunit,'(3a)') subname,' 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) @@ -1707,7 +1711,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & call ESMF_TraceRegionEnter(trim(istr)//'_readpio') if (sdat%mainproc) then - write(sdat%logunit,'(5a)') subname,' reading file ',trim(boundstr),': ',trim(filename) + write(sdat%logunit,'(5a)') subname,' reading file ',trim(boundstr),': ',trim(filename) endif if (ESMF_FieldIsCreated(per_stream%field_stream_vector)) then @@ -1800,7 +1804,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & call PIO_seterrorhandling(pioid, old_error_handle) if (debug_level>0 .and. sdat%mainproc) then - write(sdat%logunit,'(6a,i0)') subname,& + 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 From b6ffcbbb3a0c11413e00ec7a3314c268cc94be42 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 30 Dec 2025 17:33:10 +0100 Subject: [PATCH 27/44] determine time dimname for multi-level dof3d calculation --- streams/dshr_strdata_mod.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 9eef15141..ead270fd2 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -815,8 +815,9 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) write(sdat%logunit,'(2a,i0,a,i0)') subname, & 'Stream: ',stream_index,' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then - write(sdat%logunit,'(3a)') subname,& - 'Stream: ',stream_index,' 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 @@ -2193,6 +2194,9 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimlen(pioid, dimids(n), dimlens(n)) end do + ! Determine if there is a time dimension + rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) + ! determine compdof for stream call ESMF_MeshGet(per_stream%stream_mesh, elementdistGrid=distGrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 3d97bac8ed37de52b4e87256d71b7c8ea20e5ef5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 31 Dec 2025 11:28:49 +0100 Subject: [PATCH 28/44] updated buildnml --- datm/cime_config/buildnml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/datm/cime_config/buildnml b/datm/cime_config/buildnml index 788a9e1fa..3653c81c9 100755 --- a/datm/cime_config/buildnml +++ b/datm/cime_config/buildnml @@ -213,7 +213,7 @@ def _create_namelists(case, confdir, inst_string, infile, nmlgen, data_list_path if clm_usrdat_name == 'NEON.PRISM': streamlist.append(clm_usrdat_name+"_PRECIP."+neonsite) if clm_usrdat_name == 'NEON': - streamlist.append(clm_usrdat_name+".NEON_PRECIP."+neonsite) + streamlist.append(clm_usrdat_name+".NEON_PRECIP."+neonsite) if clm_usrdat_name == 'PLUMBER2': streamlist.append(clm_usrdat_name+"."+plumber2site) @@ -243,7 +243,7 @@ def _create_drv_flds_in(case, confdir): # for now we are hard-coding this file name and values because we only need it for ozone if datm_preso3 != "none": - + # Generate drv_flds_in file outfile = os.path.join(confdir, "drv_flds_in") ozone_nl_name = "&ozone_coupling_nl" From 12b2a8682511b31cd69efba4299f15ea14946778 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 31 Dec 2025 12:58:38 +0100 Subject: [PATCH 29/44] addressed more issues raised in PR --- streams/dshr_strdata_mod.F90 | 51 ++++++++++++++++++------------------ streams/dshr_stream_mod.F90 | 11 ++++---- 2 files changed, 32 insertions(+), 30 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index ead270fd2..41677578c 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -815,9 +815,9 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) write(sdat%logunit,'(2a,i0,a,i0)') subname, & 'Stream: ',stream_index,' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then - write(sdat%logunit,'(2a,i0,a)') subname, & - 'Stream: ',stream_index,' has following vertical levels' - write(sdat%logunit,*) 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 @@ -1293,7 +1293,7 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) algo=trim(sdat%stream(ns)%tinterpalgo), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (debug_level > 0 .and. sdat%mainproc) then - write(sdat%logunit,'(2a,i0,2(f10.5,2x))') & + write(sdat%logunit,'(2a,i0,2(2x,f10.5))') & subname,' non-cosz-interp stream, flb, fub= ',ns,flb,fub write(sdat%logunit,'(a)') '------------------------------------------------------' endif @@ -1498,25 +1498,23 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) ! write time bounds info if (debug_level > 0 .and. sdat%mainproc) then - if (debug_level > 0) 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),l4)') 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 + 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 @@ -1831,7 +1829,7 @@ 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,'(2a)')' ERROR: _Fillvalue found in stream input variable: '//& + 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) @@ -2051,7 +2049,7 @@ 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) @@ -2217,12 +2215,15 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) return end if ! Assume that first 2 dimensions correspond to the compdof + 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 '//& diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index a61adb7ea..8d6245aef 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -918,7 +918,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (cycle) then dYear = yrFirst + modulo(mYear-yrAlign+(2*nYears),nYears) ! current data year if(debug_level>0 .and. strm%mainproc) then - write(strm%logunit,'(2a,4(i0,2x))') subname, ' dyear, yrfirst, myear, yralign, nyears = ', & + write(strm%logunit,'(2a,5(i0,2x))') subname, & + ' dyear, yrfirst, myear, yralign, nyears = ', & dyear, yrfirst, myear, yralign, nyears endif else @@ -937,7 +938,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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,'(a,4(i0,2x))') subname, & + write(strm%logunit,'(2a,4(i0,2x))') subname, & ' yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears endif @@ -1433,7 +1434,7 @@ subroutine shr_stream_readTCoord(strm, k, rc) din = strm%file(k)%date(n) sin = strm%file(k)%secs(n) if (debug_level > 5 .and. strm%mainproc) then - write(strm%logunit,'(2a,4(i0,2x))') subname,& + 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 @@ -2104,8 +2105,8 @@ subroutine shr_stream_restIO(pioid, streams, mode) rsfname = streams(k)%file(n)%name(index(streams(k)%file(n)%name, '/',.true.):) if (trim(rfname) /= trim(rsfname)) then if (streams(k)%mainproc) then - write(streams(k)%logunit,'(2a)') subname,trim(rfname), '<>', trim(rsfname) - write(streams(k)%logunit,'(2a)') subname,' fname = '//trim(fname) + 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 From 4e56bf5f4ae6def39bf43b9584d3973c1586505d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 31 Dec 2025 13:59:59 +0100 Subject: [PATCH 30/44] removed istat check for allocate on maintask --- streams/dshr_stream_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index 8d6245aef..ba02abb65 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -368,7 +368,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu nstrms = tmp(1) if (.not. isroot_task) then - allocate(streamdat(nstrms), stat=istat) + allocate(streamdat(nstrms)) endif ! Set the logunit and mainproc attributes for each stream From a719f819de463d32815379d050c690c63c8575be Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 31 Dec 2025 22:15:33 +0100 Subject: [PATCH 31/44] fixed compilation problem for gnu --- datm/datm_datamode_cplhist_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/datm/datm_datamode_cplhist_mod.F90 b/datm/datm_datamode_cplhist_mod.F90 index d411d6d61..2b0e99ab9 100644 --- a/datm/datm_datamode_cplhist_mod.F90 +++ b/datm/datm_datamode_cplhist_mod.F90 @@ -36,7 +36,6 @@ 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_ndep(:,:) => null() character(*), parameter :: nullstr = 'null' character(*), parameter :: u_FILE_u = & From 29becf27b431de109705095afca3ec4f4a2fa110 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 31 Dec 2025 22:17:45 +0100 Subject: [PATCH 32/44] updated to cdeps1.0.83_noresm_v3 --- streams/dshr_strdata_mod.F90 | 51 ++++++++++++++++++------------------ streams/dshr_stream_mod.F90 | 13 ++++----- 2 files changed, 33 insertions(+), 31 deletions(-) diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index ead270fd2..41677578c 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -815,9 +815,9 @@ subroutine shr_strdata_get_stream_nlev(sdat, stream_index, rc) write(sdat%logunit,'(2a,i0,a,i0)') subname, & 'Stream: ',stream_index,' stream_nlev = ',stream_nlev if (stream_nlev /= 1) then - write(sdat%logunit,'(2a,i0,a)') subname, & - 'Stream: ',stream_index,' has following vertical levels' - write(sdat%logunit,*) 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 @@ -1293,7 +1293,7 @@ subroutine shr_strdata_advance(sdat, ymd, tod, logunit, istr, timers, rc) algo=trim(sdat%stream(ns)%tinterpalgo), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (debug_level > 0 .and. sdat%mainproc) then - write(sdat%logunit,'(2a,i0,2(f10.5,2x))') & + write(sdat%logunit,'(2a,i0,2(2x,f10.5))') & subname,' non-cosz-interp stream, flb, fub= ',ns,flb,fub write(sdat%logunit,'(a)') '------------------------------------------------------' endif @@ -1498,25 +1498,23 @@ subroutine shr_strdata_readLBUB(sdat, ns, mDate, mSec, newData, istr, rc) ! write time bounds info if (debug_level > 0 .and. sdat%mainproc) then - if (debug_level > 0) 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),l4)') 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 + 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 @@ -1831,7 +1829,7 @@ 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,'(2a)')' ERROR: _Fillvalue found in stream input variable: '//& + 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) @@ -2051,7 +2049,7 @@ 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) @@ -2217,12 +2215,15 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) return end if ! Assume that first 2 dimensions correspond to the compdof + 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 '//& diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index a61adb7ea..ba02abb65 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -368,7 +368,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu nstrms = tmp(1) if (.not. isroot_task) then - allocate(streamdat(nstrms), stat=istat) + allocate(streamdat(nstrms)) endif ! Set the logunit and mainproc attributes for each stream @@ -918,7 +918,8 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & if (cycle) then dYear = yrFirst + modulo(mYear-yrAlign+(2*nYears),nYears) ! current data year if(debug_level>0 .and. strm%mainproc) then - write(strm%logunit,'(2a,4(i0,2x))') subname, ' dyear, yrfirst, myear, yralign, nyears = ', & + write(strm%logunit,'(2a,5(i0,2x))') subname, & + ' dyear, yrfirst, myear, yralign, nyears = ', & dyear, yrfirst, myear, yralign, nyears endif else @@ -937,7 +938,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, & 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,'(a,4(i0,2x))') subname, & + write(strm%logunit,'(2a,4(i0,2x))') subname, & ' yrFirst,yrLast,yrAlign,nYears= ',yrFirst,yrLast,yrAlign,nYears endif @@ -1433,7 +1434,7 @@ subroutine shr_stream_readTCoord(strm, k, rc) din = strm%file(k)%date(n) sin = strm%file(k)%secs(n) if (debug_level > 5 .and. strm%mainproc) then - write(strm%logunit,'(2a,4(i0,2x))') subname,& + 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 @@ -2104,8 +2105,8 @@ subroutine shr_stream_restIO(pioid, streams, mode) rsfname = streams(k)%file(n)%name(index(streams(k)%file(n)%name, '/',.true.):) if (trim(rfname) /= trim(rsfname)) then if (streams(k)%mainproc) then - write(streams(k)%logunit,'(2a)') subname,trim(rfname), '<>', trim(rsfname) - write(streams(k)%logunit,'(2a)') subname,' fname = '//trim(fname) + 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 From b139209a8d26c9650274edeb96203e98ae62832e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 31 Dec 2025 22:27:00 +0100 Subject: [PATCH 33/44] updated comments --- datm/atm_comp_nuopc.F90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index 8a702bdaf..358103384 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -729,25 +729,19 @@ 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 co2 if appropriate + ! update export state if appropriate if (flds_co2) then call datm_pres_co2_advance() if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - ! update export state o3 if appropriate if (flds_preso3) then call datm_pres_o3_advance() if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - ! ungridded dimension output - update export state nitrogen deposition if appropriate if (flds_presndep) then call datm_pres_ndep_advance() if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - ! ungridded dimension output - upate prescribed aerosol if appropriate if (flds_presaero) then call datm_pres_aero_advance() if (ChkErr(rc,__LINE__,u_FILE_u)) return From c43ac116b2cff2388aa1915171b9094f8e6143c2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 3 Jan 2026 19:18:33 +0100 Subject: [PATCH 34/44] fixed gnu compiler error --- datm/atm_comp_nuopc.F90 | 2 +- streams/dshr_stream_mod.F90 | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index 358103384..e0b3fd4dd 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -729,7 +729,7 @@ 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 if appropriate + ! 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 diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index ba02abb65..4df33fb9e 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -205,7 +205,6 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu integer :: status integer :: tmp(6) real(r8) :: rtmp(1) - integer :: istat character(len=*),parameter :: subName = '(shr_stream_init_from_xml) ' ! -------------------------------------------------------- From e63cccd0be18404d413ae76c632899bc59803b05 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 3 Jan 2026 20:12:54 +0100 Subject: [PATCH 35/44] merged dlnd/dlnd_datamode_glc_forcing_mod.F90 --- dlnd/dlnd_datamode_glc_forcing_mod.F90 | 30 -------------------------- 1 file changed, 30 deletions(-) diff --git a/dlnd/dlnd_datamode_glc_forcing_mod.F90 b/dlnd/dlnd_datamode_glc_forcing_mod.F90 index 7335ba54c..06693cf45 100644 --- a/dlnd/dlnd_datamode_glc_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_glc_forcing_mod.F90 @@ -129,35 +129,6 @@ subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac call dshr_state_getfldptr(exportState, 'Flgl_qice_elev', fldptr2=Flgl_qice_elev, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return -<<<<<<< HEAD - ! Create stream-> export state mapping - ! Note that strm_flds is the model name for the stream field - ! Note that state_fld is the model name for the export field - - if (trim(datamode) == 'glc_forcing_mct') then - allocate(strm_flds_tsrf(0:glc_nec)) - allocate(strm_flds_topo(0:glc_nec)) - allocate(strm_flds_qice(0:glc_nec)) - do n = 0,glc_nec - write(nec_str, '(i2.2)') n - strm_flds_tsrf(n) = 'Sl_tsrf_elev' // trim(nec_str) - strm_flds_topo(n) = 'Sl_topo_elev' // trim(nec_str) - strm_flds_qice(n) = 'Flgl_qice_elev' // trim(nec_str) - end do - - else if (trim(datamode) == 'glc_forcing' ) then - allocate(strm_flds_tsrf(1:glc_nec+1)) - allocate(strm_flds_topo(1:glc_nec+1)) - allocate(strm_flds_qice(1:glc_nec+1)) - do n = 1,glc_nec+1 - write(nec_str, '(i0)') n - strm_flds_tsrf(n) = 'Sl_tsrf_elev' // trim(nec_str) - strm_flds_topo(n) = 'Sl_topo_elev' // trim(nec_str) - strm_flds_qice(n) = 'Flgl_qice_elev' // trim(nec_str) - end do - else - call shr_log_error(subname//'ERROR illegal datamode = '//trim(datamode), rc=rc) -======= ! Obtain pointers to stream fields allocate(strm_Sl_tsrf_elev(glc_nec+1), & @@ -166,7 +137,6 @@ subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac if ( istat /= 0 ) then call shr_log_error(subName//& ': allocation error for strm_Sl_tsrf_elev, Strm_Sl_topo_elev and strm_Flgl_qice_elev',rc=rc) ->>>>>>> mvertens/feature/new_datm_optional_streams return end if From cb5f4a78bc8bc09b87e89f3643f3b72352d7a3b7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 3 Jan 2026 20:27:31 +0100 Subject: [PATCH 36/44] updated dglc tests --- dglc/cime_config/testdefs/testlist_dglc.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/dglc/cime_config/testdefs/testlist_dglc.xml b/dglc/cime_config/testdefs/testlist_dglc.xml index 6f47c8112..5d0f49a70 100644 --- a/dglc/cime_config/testdefs/testlist_dglc.xml +++ b/dglc/cime_config/testdefs/testlist_dglc.xml @@ -22,6 +22,7 @@ + @@ -31,7 +32,7 @@ - + From 361da003823e0f9cea3c537d1eecf9c1f7085e84 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 3 Jan 2026 20:28:31 +0100 Subject: [PATCH 37/44] updated dglc testlist --- dglc/cime_config/testdefs/testlist_dglc.xml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/dglc/cime_config/testdefs/testlist_dglc.xml b/dglc/cime_config/testdefs/testlist_dglc.xml index 89f23f4d2..5d0f49a70 100644 --- a/dglc/cime_config/testdefs/testlist_dglc.xml +++ b/dglc/cime_config/testdefs/testlist_dglc.xml @@ -22,6 +22,7 @@ + @@ -30,7 +31,8 @@ - + + From 76fec8085443be187d54c1356016db3251f498da Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 4 Jan 2026 22:31:51 +0100 Subject: [PATCH 38/44] addressed comments in PR review --- datm/atm_comp_nuopc.F90 | 24 +++++++------- datm/cime_config/namelist_definition_datm.xml | 2 -- datm/cime_config/stream_definition_datm.xml | 2 -- datm/datm_datamode_clmncep_mod.F90 | 15 +++++---- datm/datm_datamode_core2_mod.F90 | 16 +++++----- datm/datm_datamode_cplhist_mod.F90 | 6 ++-- datm/datm_datamode_era5_mod.F90 | 11 ++++--- datm/datm_datamode_gefs_mod.F90 | 10 +++--- datm/datm_datamode_jra_mod.F90 | 8 ++--- datm/datm_datamode_simple_mod.F90 | 6 ++-- datm/datm_pres_aero_mod.F90 | 32 +++++++++---------- datm/datm_pres_co2_mod.F90 | 15 ++++----- datm/datm_pres_ndep_mod.F90 | 4 +-- datm/datm_pres_o3_mod.F90 | 6 ++-- dglc/cime_config/namelist_definition_dglc.xml | 2 -- dglc/cime_config/stream_definition_dglc.xml | 2 -- dice/cime_config/namelist_definition_dice.xml | 10 +++--- dice/cime_config/stream_definition_dice.xml | 2 -- dlnd/cime_config/namelist_definition_dlnd.xml | 2 -- dlnd/cime_config/stream_definition_dlnd.xml | 2 -- docn/cime_config/namelist_definition_docn.xml | 2 -- docn/cime_config/stream_definition_docn.xml | 2 -- drof/cime_config/namelist_definition_drof.xml | 4 +-- drof/cime_config/stream_definition_drof.xml | 2 -- dwav/cime_config/namelist_definition_dwav.xml | 2 -- dwav/cime_config/stream_definition_dwav.xml | 2 -- 26 files changed, 82 insertions(+), 109 deletions(-) diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index e0b3fd4dd..225b2ae47 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -155,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 = & @@ -172,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 @@ -228,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 / & @@ -386,7 +386,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return endif - ! Advertise fields that are not datamode specific + ! Advertise fields that ARE NOT datamode specific if (flds_co2) then call datm_pres_co2_advertise(fldsExport, datamode) end if @@ -400,7 +400,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call datm_pres_aero_advertise(fldsExport) end if - ! Advertise fields that are not datamode specific + ! 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, rc) @@ -455,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 @@ -555,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 @@ -844,7 +844,7 @@ 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) diff --git a/datm/cime_config/namelist_definition_datm.xml b/datm/cime_config/namelist_definition_datm.xml index 8ca888bb3..146a20d06 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 74da7589c..9db7d7386 100644 --- a/datm/cime_config/stream_definition_datm.xml +++ b/datm/cime_config/stream_definition_datm.xml @@ -1,7 +1,5 @@ - - diff --git a/datm/datm_datamode_clmncep_mod.F90 b/datm/datm_datamode_clmncep_mod.F90 index 4e03255b0..0001a90b8 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 @@ -88,8 +89,8 @@ 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__ !=============================================================================== @@ -249,7 +250,7 @@ subroutine datm_datamode_clmncep_init_pointers(importState, exportState, sdat, r ! 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 @@ -309,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 @@ -324,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 @@ -332,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 diff --git a/datm/datm_datamode_core2_mod.F90 b/datm/datm_datamode_core2_mod.F90 index e386605f0..67e0b3922 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 @@ -81,8 +81,8 @@ 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__ !=============================================================================== @@ -227,13 +227,13 @@ subroutine datm_datamode_core2_init_pointers(exportState, sdat, datamode, factor if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 @@ -372,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 @@ -398,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 2b0e99ab9..de46522d8 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 @@ -37,8 +37,8 @@ module datm_datamode_cplhist_mod real(r8), pointer :: Faxa_swvdr(:) => null() real(r8), pointer :: Faxa_swvdf(:) => null() - character(*), parameter :: nullstr = 'null' - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: nullstr = 'null' + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== diff --git a/datm/datm_datamode_era5_mod.F90 b/datm/datm_datamode_era5_mod.F90 index a03f28f6a..d962152da 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 @@ -55,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__ !=============================================================================== @@ -223,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) @@ -231,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. diff --git a/datm/datm_datamode_gefs_mod.F90 b/datm/datm_datamode_gefs_mod.F90 index 80d5716d8..54a32309d 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 e522e07ba..d0bcf2e8e 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 @@ -56,8 +56,8 @@ 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__ !=============================================================================== @@ -191,7 +191,7 @@ subroutine datm_datamode_jra_init_pointers(exportState, sdat, rc) ! 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 diff --git a/datm/datm_datamode_simple_mod.F90 b/datm/datm_datamode_simple_mod.F90 index da6ca7cd8..b754b6208 100644 --- a/datm/datm_datamode_simple_mod.F90 +++ b/datm/datm_datamode_simple_mod.F90 @@ -27,7 +27,7 @@ module datm_datamode_simple_mod use shr_log_mod , only : shr_log_error implicit none - private ! except + private public :: datm_datamode_simple_advertise public :: datm_datamode_simple_init_pointers @@ -74,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__ !=============================================================================== diff --git a/datm/datm_pres_aero_mod.F90 b/datm/datm_pres_aero_mod.F90 index 151052e39..dc3401c2d 100644 --- a/datm/datm_pres_aero_mod.F90 +++ b/datm/datm_pres_aero_mod.F90 @@ -7,7 +7,7 @@ module datm_pres_aero_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: datm_pres_aero_advertise public :: datm_pres_aero_init_pointers @@ -38,7 +38,7 @@ module datm_pres_aero_mod real(r8), pointer :: strm_Faxa_dstdry3(:) => null() real(r8), pointer :: strm_Faxa_dstdry4(:) => null() - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -86,59 +86,59 @@ subroutine datm_pres_aero_init_pointers(exportState, sdat, rc) ! 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=trim(subname)//'strm_Faxa_bcphidry must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_bcphodry must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_bcphiwet must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_ocphidry must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_ocphodry must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_ocphiwet must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstdry1 must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstdry2 must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstdry3 must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstdry4 must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstwet1 must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstwet2 must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstwet3 must be associated if flds_presaero is .true.', rc=rc) + 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=trim(subname)//'strm_Faxa_dstwet4 must be associated if flds_presaero is .true.', rc=rc) + 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 diff --git a/datm/datm_pres_co2_mod.F90 b/datm/datm_pres_co2_mod.F90 index 1234512c1..0a792a224 100644 --- a/datm/datm_pres_co2_mod.F90 +++ b/datm/datm_pres_co2_mod.F90 @@ -7,7 +7,7 @@ module datm_pres_co2_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: datm_pres_co2_advertise public :: datm_pres_co2_init_pointers @@ -23,7 +23,7 @@ module datm_pres_co2_mod character(len=CL) :: datamode - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -66,15 +66,14 @@ subroutine datm_pres_co2_init_pointers(exportState, sdat, rc) 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 - if the - ! following stream fields are not in any sdat streams, then a null value is returned + ! 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=trim(subname)//'strm_Sa_co2diag must be associated if flds_co2 is .true.', rc=rc) + 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=trim(subname)//'strm_Sa_co2prog must be associated if flds_co2 is .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 @@ -88,8 +87,8 @@ subroutine datm_pres_co2_advance() Sa_co2diag(:) = strm_Sa_co2diag(:) Sa_co2prog(:) = strm_Sa_co2prog(:) else - ! This is intentional since we don't have any Sa_co2prog - but for now - ! will set Sa_co2prog equal to Sa_co2diag + ! 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 diff --git a/datm/datm_pres_ndep_mod.F90 b/datm/datm_pres_ndep_mod.F90 index 1ac262d65..484f4ffbd 100644 --- a/datm/datm_pres_ndep_mod.F90 +++ b/datm/datm_pres_ndep_mod.F90 @@ -8,7 +8,7 @@ module datm_pres_ndep_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: datm_pres_ndep_advertise public :: datm_pres_ndep_init_pointers @@ -28,7 +28,7 @@ module datm_pres_ndep_mod logical :: use_cmip7_ndep - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== diff --git a/datm/datm_pres_o3_mod.F90 b/datm/datm_pres_o3_mod.F90 index c05962777..d6cfa3c00 100644 --- a/datm/datm_pres_o3_mod.F90 +++ b/datm/datm_pres_o3_mod.F90 @@ -7,7 +7,7 @@ module datm_pres_o3_mod use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add implicit none - private ! except + private public :: datm_pres_o3_advertise public :: datm_pres_o3_init_pointers @@ -19,7 +19,7 @@ module datm_pres_o3_mod ! stream pointer real(r8), pointer :: strm_Sa_o3(:) => null() - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -55,7 +55,7 @@ subroutine datm_pres_o3_init_pointers(exportState, sdat, rc) ! 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=trim(subname)//'ERROR: strm_Sa_o3 must be associated if flds_pres_o3 is .true.', rc=rc) + 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 diff --git a/dglc/cime_config/namelist_definition_dglc.xml b/dglc/cime_config/namelist_definition_dglc.xml index 2de7f7143..d860e6d8f 100644 --- a/dglc/cime_config/namelist_definition_dglc.xml +++ b/dglc/cime_config/namelist_definition_dglc.xml @@ -1,7 +1,5 @@ - - diff --git a/docn/cime_config/stream_definition_docn.xml b/docn/cime_config/stream_definition_docn.xml index ea8738750..fc20d8b32 100644 --- a/docn/cime_config/stream_definition_docn.xml +++ b/docn/cime_config/stream_definition_docn.xml @@ -1,7 +1,5 @@ - - diff --git a/drof/cime_config/namelist_definition_drof.xml b/drof/cime_config/namelist_definition_drof.xml index 694c9c401..56f8646c6 100644 --- a/drof/cime_config/namelist_definition_drof.xml +++ b/drof/cime_config/namelist_definition_drof.xml @@ -1,7 +1,5 @@ - - @@ -46,7 +44,7 @@ - + char streams abs diff --git a/drof/cime_config/stream_definition_drof.xml b/drof/cime_config/stream_definition_drof.xml index bea37aa3a..aa76291ec 100644 --- a/drof/cime_config/stream_definition_drof.xml +++ b/drof/cime_config/stream_definition_drof.xml @@ -1,7 +1,5 @@ - - diff --git a/dwav/cime_config/namelist_definition_dwav.xml b/dwav/cime_config/namelist_definition_dwav.xml index 16517984f..9cfbd3d91 100644 --- a/dwav/cime_config/namelist_definition_dwav.xml +++ b/dwav/cime_config/namelist_definition_dwav.xml @@ -1,7 +1,5 @@ - - diff --git a/dwav/cime_config/stream_definition_dwav.xml b/dwav/cime_config/stream_definition_dwav.xml index 9bd1ecaab..46d1b4fe4 100644 --- a/dwav/cime_config/stream_definition_dwav.xml +++ b/dwav/cime_config/stream_definition_dwav.xml @@ -1,7 +1,5 @@ - - From 8ef224a79e3e9785e94b6413ce36e7e7b423c920 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 6 Jan 2026 12:38:38 +0100 Subject: [PATCH 39/44] new cmip7 default settings for datm ndep forcing --- datm/cime_config/config_component.xml | 16 ++-- datm/cime_config/stream_definition_datm.xml | 88 +++++++++++++++++++-- datm/datm_pres_ndep_mod.F90 | 42 +++++----- 3 files changed, 111 insertions(+), 35 deletions(-) diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index 275335fec..75441bf95 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -102,18 +102,22 @@ char - none,clim_1850,clim_1850_cmip7,clim_2000,clim_2010,hist,hist_cmip7,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,clim_hist_cmip7, + clim_1850_cmip6,clim_2000_cmip6,hist,hist_cmip6,clim_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 + clim_1850_cmip7 + clim_2000_cmip7 + clim_2010_cmip7 + hist_cmip7 + hist_cmip7 SSP1-2.6 SSP2-4.5 SSP3-7.0 SSP5-8.5 - hist - hist cplhist none diff --git a/datm/cime_config/stream_definition_datm.xml b/datm/cime_config/stream_definition_datm.xml index 9db7d7386..5ec085c1d 100644 --- a/datm/cime_config/stream_definition_datm.xml +++ b/datm/cime_config/stream_definition_datm.xml @@ -189,11 +189,13 @@ - DATM_NDEP is set by the 4 character time prefix in config_component.xml ======================== presndep.clim_1850_cmip7 - presndep.clim_1850 - presndep.clim_2000 - presndep.clim_2010 + presndep.clim_2000_cmip7 + presndep.clim_2010_cmip7 presndep.hist_cmip7 - presndep.hist + 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 @@ -4896,6 +4898,76 @@ 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 @@ -4931,7 +5003,7 @@ single - + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc @@ -4964,7 +5036,7 @@ single - + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc @@ -4997,7 +5069,7 @@ single - + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc @@ -5029,7 +5101,7 @@ single - + $DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc diff --git a/datm/datm_pres_ndep_mod.F90 b/datm/datm_pres_ndep_mod.F90 index 484f4ffbd..2b1548e12 100644 --- a/datm/datm_pres_ndep_mod.F90 +++ b/datm/datm_pres_ndep_mod.F90 @@ -18,13 +18,13 @@ module datm_pres_ndep_mod real(r8), pointer :: Faxa_ndep(:,:) => null() ! stream data - real(r8), pointer :: strm_ndep_nhx_dry(:) => null() ! stream cmip7 ndep data - real(r8), pointer :: strm_ndep_nhx_wet(:) => null() ! stream cmip7 ndep data - real(r8), pointer :: strm_ndep_noy_dry(:) => null() ! stream cmip7 ndep data - real(r8), pointer :: strm_ndep_noy_wet(:) => null() ! stream cmip7 ndep 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_ndep_nhx(:) => null() ! pre-cmip7 ndep data - real(r8), pointer :: strm_ndep_noy(:) => null() ! pre-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 @@ -66,27 +66,27 @@ subroutine datm_pres_ndep_init_pointers(exportState, sdat, rc) ! 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 forcing - call shr_strdata_get_stream_pointer(sdat, 'Faxa_ndep_nhx_dry', strm_ndep_nhx_dry, rc) + ! 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_ndep_nhx_wet, rc) + 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_ndep_noy_dry, rc) + 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_ndep_noy_wet, rc) + 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 - ! older ndep forcing - call shr_strdata_get_stream_pointer( sdat, 'Faxa_ndep_nhx', strm_ndep_nhx, rc) + ! 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_ndep_noy, rc) + 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_ndep_nhx_dry) .and. associated(strm_ndep_nhx_wet) .and. & - associated(strm_ndep_noy_dry) .and. associated(strm_ndep_noy_wet)) then + 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_ndep_nhx) .and. associated(strm_ndep_noy)) then + 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) @@ -100,12 +100,12 @@ subroutine datm_pres_ndep_advance() if (use_cmip7_ndep) then ! assume data is in kgN/m2/s - Faxa_ndep(1,:) = strm_ndep_nhx_dry(:) + strm_ndep_nhx_wet(:) - Faxa_ndep(2,:) = strm_ndep_noy_dry(:) + strm_ndep_noy_wet(:) + 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_ndep_nhx(:) / 1000._r8 - Faxa_ndep(2,:) = strm_ndep_noy(:) / 1000._r8 + 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 From 47566bb408d8b8e6dcf724e3a31b71526e5a913c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 6 Jan 2026 12:39:21 +0100 Subject: [PATCH 40/44] added issues raised in review of ESCOMP/CDEPS PR#368 --- dlnd/dlnd_datamode_rof_forcing_mod.F90 | 23 ++++++++++++++--------- dlnd/lnd_comp_nuopc.F90 | 8 +++++++- streams/dshr_strdata_mod.F90 | 17 +++++++---------- streams/dshr_stream_mod.F90 | 4 ++-- 4 files changed, 30 insertions(+), 22 deletions(-) diff --git a/dlnd/dlnd_datamode_rof_forcing_mod.F90 b/dlnd/dlnd_datamode_rof_forcing_mod.F90 index bb6b09427..955276c7e 100644 --- a/dlnd/dlnd_datamode_rof_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_rof_forcing_mod.F90 @@ -11,6 +11,7 @@ module dlnd_datamode_rof_forcing_mod use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add use shr_lnd2rof_tracers_mod , only : shr_lnd2rof_tracers_readnl + use shr_strconvert_mod , only : toString implicit none private ! except @@ -43,6 +44,7 @@ module dlnd_datamode_rof_forcing_mod real(r8), pointer :: strm_Flrl_irrig(:) => null() integer :: ntracers_nonh2o + integer, parameter :: ntracers_nonh2o_max = 99 character(*), parameter :: nullstr = 'null' character(*), parameter :: u_FILE_u = & @@ -81,9 +83,10 @@ subroutine dlnd_datamode_rof_forcing_advertise(exportState, fldsExport, flds_sca call shr_lnd2rof_tracers_readnl('drv_flds_in', lnd2rof_tracers) if (lnd2rof_tracers /= ' ') then ntracers_nonh2o = shr_string_listGetNum(lnd2rof_tracers) - if (ntracers_nonh2o > 99) then + if (ntracers_nonh2o > ntracers_nonh2o_max) then rc = ESMF_FAILURE - call shr_log_error(subName//': ERROR: number of tracers must be less than 99', rc=rc) + call shr_log_error(subName//': ERROR: number of tracers must be less than '//& + trim(toString(ntracers_nonh2o_max)), rc=rc) return end if else @@ -146,12 +149,14 @@ subroutine dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, model_frac call dshr_state_getfldptr(exportState, fldname='Sl_lfrin', fldptr1=lfrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return lfrac(:) = model_frac(:) ! Set fractional land pointer in export state - if (ntracers_nonh2o > 1) then - call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur_nonh2o', fldptr2=Flrl_rofsur_nonh2o_2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur_nonh2o', fldptr1=Flrl_rofsur_nonh2o_1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ntracers_nonh2o > 0) then + if (ntracers_nonh2o > 1) then + call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur_nonh2o', fldptr2=Flrl_rofsur_nonh2o_2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur_nonh2o', fldptr1=Flrl_rofsur_nonh2o_1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if call dshr_state_getfldptr(exportState, fldname='Flrl_rofsur', fldptr1=Flrl_rofsur, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -253,7 +258,7 @@ subroutine dlnd_datamode_rof_forcing_advance() end do if (associated(strm_Flrl_irrig)) then - do ni = 1,size(Flrl_rofsur) + do ni = 1,size(Flrl_irrig) if (lfrac(ni) == 0._r8) then Flrl_irrig(ni) = SHR_CONST_SPVAL else diff --git a/dlnd/lnd_comp_nuopc.F90 b/dlnd/lnd_comp_nuopc.F90 index d77c85e2a..5f9abfc3e 100644 --- a/dlnd/lnd_comp_nuopc.F90 +++ b/dlnd/lnd_comp_nuopc.F90 @@ -67,7 +67,7 @@ module cdeps_dlnd_comp integer :: flds_scalar_index_ny = 0 integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom - logical :: mainproc ! true of my_task == main_task + logical :: mainproc ! true if my_task == main_task integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number @@ -460,6 +460,9 @@ subroutine dlnd_comp_run(importState, exportState, target_ymd, target_tod, rc) case('rof_forcing') call dlnd_datamode_rof_forcing_init_pointers(exportState, sdat, model_frac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + case default + call shr_log_error(' ERROR illegal dlnd datamode = '//trim(datamode), rc=rc) + return end select first_time = .false. @@ -481,6 +484,9 @@ subroutine dlnd_comp_run(importState, exportState, target_ymd, target_tod, rc) call dlnd_datamode_glc_forcing_advance() case('rof_forcing') call dlnd_datamode_rof_forcing_advance() + case default + call shr_log_error(' ERROR illegal dlnd datamode = '//trim(datamode), rc=rc) + return end select call ESMF_TraceRegionExit('DLND_RUN') diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 41677578c..94109d456 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/streams/dshr_strdata_mod.F90 @@ -412,7 +412,7 @@ 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) @@ -426,13 +426,13 @@ subroutine shr_strdata_init_model_domain( sdat, rc) 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_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)) + 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) @@ -1747,7 +1747,7 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & 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=istat) + toString(lsize*stream_nlev), rc=rc) return end if endif @@ -1757,21 +1757,21 @@ subroutine shr_strdata_readstrm(sdat, per_stream, stream, fldbun_data, & 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=istat) + toString(lsize), rc=rc) return end if else if (pio_iovartype == PIO_DOUBLE .and. .not. allocated(data_dbl1d)) then 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=istat) + toString(lsize), rc=rc) return end if else if(pio_iovartype == PIO_SHORT .and. .not. allocated(data_short1d)) then 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=istat) + toString(lsize), rc=rc) return end if endif @@ -2192,9 +2192,6 @@ subroutine shr_strdata_set_stream_iodesc(sdat, per_stream, fldname, pioid, rc) rcode = pio_inq_dimlen(pioid, dimids(n), dimlens(n)) end do - ! Determine if there is a time dimension - rcode = pio_inq_dimname(pioid, dimids(ndims), dimname) - ! determine compdof for stream call ESMF_MeshGet(per_stream%stream_mesh, elementdistGrid=distGrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index 4df33fb9e..ba81d4f61 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -290,7 +290,7 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if(associated(p)) then call extractDataContent(p, streamdat(i)%yearAlign) else - call shr_sys_abort(subname//" yearAlign must be provided", rc=rc) + call shr_sys_abort(subname//" yearAlign must be provided") return endif @@ -760,7 +760,7 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, ' with size '//toString(streamdat(i)%nfiles), rc=rc) return end if - allocate(strm_tmpstrings(streamdat(i)%nfiles), stat=istat) + 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 do n=1,streamdat(i)%nfiles From 410ce304ee485207dfa176c6b6d5449ed1978d13 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 6 Jan 2026 13:26:10 +0100 Subject: [PATCH 41/44] addressed testing failures --- datm/cime_config/config_component.xml | 4 +-- dglc/cime_config/testdefs/testlist_dglc.xml | 30 +++++++-------------- 2 files changed, 12 insertions(+), 22 deletions(-) diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index 75441bf95..762e9cdb6 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -103,8 +103,8 @@ char none, - clim_1850_cmip7,clim_2000_cmip7,clim_2010_cmip7,clim_hist_cmip7, - clim_1850_cmip6,clim_2000_cmip6,hist,hist_cmip6,clim_hist_cmip6, + 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 diff --git a/dglc/cime_config/testdefs/testlist_dglc.xml b/dglc/cime_config/testdefs/testlist_dglc.xml index 5d0f49a70..9eb1b6dba 100644 --- a/dglc/cime_config/testdefs/testlist_dglc.xml +++ b/dglc/cime_config/testdefs/testlist_dglc.xml @@ -22,30 +22,20 @@ - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + From 8a1b5a4c26780ea3e07c75740e0a6e3bd1776205 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 6 Jan 2026 16:50:56 +0100 Subject: [PATCH 42/44] changed default ndep forcing to cmip6 for CESM --- datm/cime_config/config_component.xml | 10 +++++----- dglc/cime_config/testdefs/testlist_dglc.xml | 1 - 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index 762e9cdb6..35bf01b60 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -109,11 +109,11 @@ clim_2000 - clim_1850_cmip7 - clim_2000_cmip7 - clim_2010_cmip7 - hist_cmip7 - hist_cmip7 + clim_1850_cmip6 + clim_2000_cmip6 + clim_2010_cmip6 + hist_cmip6 + hist_cmip6 SSP1-2.6 SSP2-4.5 SSP3-7.0 diff --git a/dglc/cime_config/testdefs/testlist_dglc.xml b/dglc/cime_config/testdefs/testlist_dglc.xml index 5c67f2b4e..9eb1b6dba 100644 --- a/dglc/cime_config/testdefs/testlist_dglc.xml +++ b/dglc/cime_config/testdefs/testlist_dglc.xml @@ -22,7 +22,6 @@ - From 9272ffe0726c5d35b70b85656ca2938c989c46bc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 6 Jan 2026 19:59:38 +0100 Subject: [PATCH 43/44] added additional comment --- dlnd/dlnd_datamode_rof_forcing_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/dlnd/dlnd_datamode_rof_forcing_mod.F90 b/dlnd/dlnd_datamode_rof_forcing_mod.F90 index 955276c7e..e6c4873fe 100644 --- a/dlnd/dlnd_datamode_rof_forcing_mod.F90 +++ b/dlnd/dlnd_datamode_rof_forcing_mod.F90 @@ -44,6 +44,9 @@ module dlnd_datamode_rof_forcing_mod real(r8), pointer :: strm_Flrl_irrig(:) => null() integer :: ntracers_nonh2o + + ! Note that setting the maximum value to 99 is due to the i2.2 format below + ! for generating the strm_fld field names integer, parameter :: ntracers_nonh2o_max = 99 character(*), parameter :: nullstr = 'null' From c0fe5e99fa98e7aa59fde03433c93f925f5c5b95 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 7 Jan 2026 09:40:56 +0100 Subject: [PATCH 44/44] reverted change to stream_cdeps.py --- cime_config/stream_cdeps.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/stream_cdeps.py b/cime_config/stream_cdeps.py index 17fbf6c1d..f80586e80 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)