From 28f4aa073b4b1721150c83435d55e0b1a63804e7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 30 Jan 2025 15:27:13 -0700 Subject: [PATCH] some need to remain shr_sys_abort (no return code available) --- streams/dshr_stream_mod.F90 | 72 +++++++++++++++++++++++------------- streams/dshr_tinterp_mod.F90 | 30 +++++++++------ 2 files changed, 65 insertions(+), 37 deletions(-) diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index e73fb19ca..8df6b9edc 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -16,7 +16,7 @@ module dshr_stream_mod ! ------------------------------------------------------------------------------- use shr_kind_mod , only : r8=>shr_kind_r8, cs=>shr_kind_cs, cl=>shr_kind_cl, cxx=>shr_kind_cxx, cx=>shr_kind_cx - use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : shr_log_error use shr_const_mod , only : shr_const_cday use shr_string_mod , only : shr_string_leftalign_and_convert_tabs, shr_string_parseCFtunit use shr_cal_mod , only : shr_cal_noleap @@ -210,7 +210,8 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu Sdoc => parseFile(streamfilename, iostat=status) if (status /= 0) then - call shr_sys_abort("Could not parse file "//trim(streamfilename)) + call shr_log_error("Could not parse file "//trim(streamfilename), rc=rc) + return endif streamlist => getElementsByTagname(Sdoc, "stream_info") nstrms = getLength(streamlist) @@ -228,7 +229,8 @@ 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 - call shr_sys_abort("tintalgo must have a value of either cycle, extend or limit") + call shr_log_error("tintalgo must have a value of either cycle, extend or limit", rc=rc) + return end if endif @@ -241,7 +243,8 @@ 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 - call shr_sys_abort("mapaglo must have a value of either bilinear, redist, nn, consf or consd") + call shr_log_error("mapaglo must have a value of either bilinear, redist, nn, consf or consd", rc=rc) + return end if endif @@ -253,7 +256,8 @@ 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 - call shr_sys_abort("tintalgo must have a value of either lower, upper, nearest, linear or coszen") + call shr_log_error("tintalgo must have a value of either lower, upper, nearest, linear or coszen", rc=rc) + return end if endif @@ -266,21 +270,24 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if(associated(p)) then call extractDataContent(p, streamdat(i)%yearFirst) else - call shr_sys_abort("yearFirst must be provided") + call shr_log_error("yearFirst must be provided", rc=rc) + return endif p=> item(getElementsByTagname(streamnode, "year_last"), 0) if(associated(p)) then call extractDataContent(p, streamdat(i)%yearLast) else - call shr_sys_abort("yearLast must be provided") + call shr_log_error("yearLast must be provided", rc=rc) + return endif p=> item(getElementsByTagname(streamnode, "year_align"), 0) if(associated(p)) then call extractDataContent(p, streamdat(i)%yearAlign) else - call shr_sys_abort("yearAlign must be provided") + call shr_log_error("yearAlign must be provided", rc=rc) + return endif p=> item(getElementsByTagname(streamnode, "dtlimit"), 0) @@ -297,14 +304,16 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%meshfile) else - call shr_sys_abort("mesh file name must be provided") + call shr_log_error("mesh file name must be provided", rc=rc) + return endif p => item(getElementsByTagname(streamnode, "vectors"), 0) if (associated(p)) then call extractDataContent(p, streamdat(i)%stream_vectors) else - call shr_sys_abort("stream vectors must be provided") + call shr_log_error("stream vectors must be provided", rc=rc) + return endif ! Determine name of vertical dimension @@ -312,13 +321,15 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu if (associated(p)) then call extractDataContent(p, streamdat(i)%lev_dimname) else - call shr_sys_abort("stream vertical level dimension name must be provided") + call shr_log_error("stream vertical level dimension name must be provided", rc=rc) + return endif ! Determine input data files p => item(getElementsByTagname(streamnode, "datafiles"), 0) if (.not. associated(p)) then - call shr_sys_abort("stream data files must be provided") + call shr_log_error("stream data files must be provided", rc=rc) + return endif filelist => getElementsByTagname(p,"file") streamdat(i)%nfiles = getLength(filelist) @@ -428,7 +439,8 @@ subroutine shr_stream_init_from_xml(streamfilename, streamdat, isroot_task, logu ! Error check if (trim(streamdat(i)%taxmode) == shr_stream_taxis_extend .and. streamdat(i)%dtlimit < 1.e10) then - call shr_sys_abort(trim(subName)//" ERROR: if taxmode value is extend set dtlimit to 1.e30") + call shr_log_error(trim(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. @@ -625,7 +637,8 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, if( nstrms > 0 ) then allocate(streamdat(nstrms)) else - call shr_sys_abort("no stream_info in config file "//trim(streamfilename)) + 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 @@ -647,21 +660,24 @@ 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 - call shr_sys_abort("yearFirst must be provided") + call shr_log_error("yearFirst must be provided", rc=rc) + return endif if( ESMF_ConfigGetLen(config=CF, label="yearLast"//mystrm//':', rc=rc) > 0 ) then call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearLast,label="yearLast"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort("yearLast must be provided") + call shr_log_error("yearLast must be provided", rc=rc) + return endif if( ESMF_ConfigGetLen(config=CF, label="yearAlign"//mystrm//':', rc=rc) > 0 ) then call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%yearAlign,label="yearAlign"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort("yearAlign must be provided") + call shr_log_error("yearAlign must be provided", rc=rc) + return endif call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%dtlimit,label="dtlimit"//mystrm//':', rc=rc) @@ -674,21 +690,24 @@ 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 - call shr_sys_abort("stream_mesh_file must be provided") + call shr_log_error("stream_mesh_file must be provided", rc=rc) + return endif if( ESMF_ConfigGetLen(config=CF, label="stream_vectors"//mystrm//':', rc=rc) > 0 ) then call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%stream_vectors,label="stream_vectors"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort("stream_vectors must be provided") + call shr_log_error("stream_vectors must be provided", rc=rc) + return endif if( ESMF_ConfigGetLen(config=CF, label="stream_lev_dimname"//mystrm//':', rc=rc) > 0 ) then 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 - call shr_sys_abort("stream_lev_dimname must be provided") + call shr_log_error("stream_lev_dimname must be provided", rc=rc) + return endif ! Get a list of stream file names @@ -703,7 +722,8 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, enddo deallocate(strm_tmpstrings) else - call shr_sys_abort("stream data files must be provided") + call shr_log_error("stream data files must be provided", rc=rc) + return endif ! Get name of stream variables in file and model @@ -718,7 +738,8 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, enddo deallocate(strm_tmpstrings) else - call shr_sys_abort("stream data variables must be provided") + call shr_log_error("stream data variables must be provided", rc=rc) + return endif ! Initialize stream pio @@ -739,7 +760,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_sys_abort(trim(subName)//" ERROR: if taxmode value is extend set dtlimit to 1.e30") + call shr_log_error(trim(subName)//" ERROR: if taxmode value is extend set dtlimit to 1.e30", rc=rc) + return end if enddo ! end loop nstrm @@ -826,7 +848,6 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & cycle = .false. limit = .true. else - write(strm%logunit,*) trim(subName),' ERROR: illegal taxMode = ',trim(strm%taxMode) call shr_sys_abort(trim(subName)//' ERROR: illegal taxMode = '//trim(strm%taxMode)) endif @@ -872,7 +893,7 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & if (.not. strm%file(k)%haveData) then call shr_stream_readtCoord(strm, k, isroot_task, rCode) if ( rCode /= 0 )then - call shr_sys_abort(trim(subName)//" ERROR: readtCoord1") + call shr_log_error(trim(subName)//" ERROR: readtCoord1") end if end if do n=1,strm%file(k)%nt @@ -886,7 +907,6 @@ subroutine shr_stream_findBounds(strm, mDateIn, secIn, isroot_task, & end do end do A if (.not. strm%found_lvd) then - write(strm%logunit,F00) "ERROR: LVD not found, all data is before yearFirst" call shr_sys_abort(trim(subName)//" ERROR: LVD not found, all data is before yearFirst") else !--- LVD is in or beyond yearFirst, verify it is not beyond yearLast --- diff --git a/streams/dshr_tinterp_mod.F90 b/streams/dshr_tinterp_mod.F90 index ef634d120..ecaa15efe 100644 --- a/streams/dshr_tinterp_mod.F90 +++ b/streams/dshr_tinterp_mod.F90 @@ -7,7 +7,7 @@ module dshr_tInterp_mod use ESMF , only : ESMF_Time, ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, operator(<), operator(-), operator(>), operator(==) use shr_kind_mod , only : i8=>shr_kind_i8, r8=>shr_kind_r8, cs=>shr_kind_cs, cl=>shr_kind_cl, shr_kind_in - use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : shr_log_error use shr_cal_mod , only : shr_cal_timeSet, shr_cal_advDateInt, shr_cal_date2julian use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl, SHR_ORB_UNDEF_REAL use shr_const_mod , only : SHR_CONST_PI @@ -88,7 +88,8 @@ subroutine shr_tInterp_getFactors(D1,S1,D2,S2,Din,Sin,f1,f2,calendar,logunit,alg ! --- always check that 1 <= 2, although we could relax this requirement --- if (itime2 < itime1) then write(logunit,F01) ' ERROR: itime2 < itime1 D=',D1,S1,D2,S2 - call shr_sys_abort(subName//' itime2 < itime1 ') + call shr_log_error(subName//' itime2 < itime1 ', rc=rc) + return endif f1 = -1.0 @@ -121,7 +122,8 @@ subroutine shr_tInterp_getFactors(D1,S1,D2,S2,Din,Sin,f1,f2,calendar,logunit,alg !--- check that itimein is between itime1 and itime2 --- if (itime2 < itimein .or. itime1 > itimein) then write(logunit,F02) ' ERROR illegal linear times: ',D1,S1,Din,Sin,D2,S2 - call shr_sys_abort(subName//' illegal itimes ') + call shr_log_error(subName//' illegal itimes ', rc=rc) + return endif if (itime2 == itime1) then f1 = 0.5_r8 @@ -135,8 +137,8 @@ subroutine shr_tInterp_getFactors(D1,S1,D2,S2,Din,Sin,f1,f2,calendar,logunit,alg f1 = real(snum,r8)/real(sden,r8) endif else - if (debug > 0) write(logunit,F00) 'ERROR: illegal lalgo option: ',trim(lalgo) - call shr_sys_abort(subName//' illegal algo option '//trim(lalgo)) + call shr_log_error(subName//' illegal algo option '//trim(lalgo), rc=rc) + return endif f2 = c1 - f1 @@ -145,8 +147,8 @@ subroutine shr_tInterp_getFactors(D1,S1,D2,S2,Din,Sin,f1,f2,calendar,logunit,alg if (f1 < c0-eps .or. f1 > c1+eps .or. & f2 < c0-eps .or. f2 > c1+eps .or. & abs(f1+f2-c1) > eps) then - if (debug > 0) write(logunit,F01) 'ERROR: illegal tInterp values ',f1,f2 - call shr_sys_abort(subName//' illegal tInterp values ') + call shr_log_error(subName//' illegal tInterp values ', rc=rc) + return endif if (debug > 0) then @@ -204,9 +206,11 @@ subroutine shr_tInterp_getAvgCosz(tavCosz, lon, lat, & ! error checks if (eccen == SHR_ORB_UNDEF_REAL) then - call shr_sys_abort(subname//' ERROR in orb params for coszen tinterp') + call shr_log_error(subname//' ERROR in orb params for coszen tinterp', rc=rc) + return else if (modeldt < 1) then - call shr_sys_abort(subname//' ERROR: model dt < 1 for coszen tinterp') + call shr_log_error(subname//' ERROR: model dt < 1 for coszen tinterp', rc=rc) + return endif !------------------------------------------------------------------------------- @@ -216,7 +220,10 @@ subroutine shr_tInterp_getAvgCosz(tavCosz, lon, lat, & !--- get LB & UB dates --- call shr_cal_timeSet(reday1,ymd1,tod1,calendar) call shr_cal_timeSet(reday2,ymd2,tod2,calendar) - if (reday1 > reday2) call shr_sys_abort(subname//'ERROR: lower-bound > upper-bound') + if (reday1 > reday2) then + call shr_log_error(subname//'ERROR: lower-bound > upper-bound', rc=rc) + return + endif timeint = reday2-reday1 call ESMF_TimeIntervalGet(timeint, s_i8=dtsec, rc=rc) @@ -299,7 +306,8 @@ subroutine shr_tInterp_getCosz(cosz, lon, lat, ymd, tod, & lsize = size(lon) if (lsize < 1 .or. size(lat) /= lsize .or. size(cosz) /= lsize) then write(6,*)'ERROR: lsize,size(lat),size(cosz) = ',lsize,size(lat),size(cosz) - call shr_sys_abort(subname//' ERROR: lon lat cosz sizes disagree') + call shr_log_error(subname//' ERROR: lon lat cosz sizes disagree', rc=rc) + return endif call shr_cal_date2julian(ymd, tod, calday, calendar)