From b19219ac9b2b0bde2dbfa0bd9f95241dcbc8a09a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 27 May 2023 23:16:44 -0600 Subject: [PATCH 01/52] Changes to get to compile with nag compiler on izumi --- route/build/cpl/RtmMod.F90 | 2 +- route/build/cpl/RtmTimeManager.F90 | 27 ++++++++------ route/build/src/accum_runoff.f90 | 6 ++-- route/build/src/dfw_route.f90 | 24 +++++++------ route/build/src/domain_decomposition.f90 | 4 +-- route/build/src/histVars_data.f90 | 4 +-- route/build/src/irf_route.f90 | 19 +++++----- route/build/src/kwe_route.f90 | 26 +++++++------- route/build/src/kwt_route.f90 | 46 +++++++++++++----------- route/build/src/mc_route.f90 | 31 ++++++++-------- route/build/src/nr_utils.f90 | 2 +- route/build/src/read_control.f90 | 2 +- route/build/src/var_lookup.f90 | 2 ++ route/build/src/write_restart_pio.f90 | 2 +- route/build/src/write_simoutput_pio.f90 | 3 +- 15 files changed, 112 insertions(+), 88 deletions(-) diff --git a/route/build/cpl/RtmMod.F90 b/route/build/cpl/RtmMod.F90 index 35a266143..290f053de 100644 --- a/route/build/cpl/RtmMod.F90 +++ b/route/build/cpl/RtmMod.F90 @@ -333,7 +333,7 @@ SUBROUTINE get_hru_area(NETOPO_in, RPARAM_in, offset, verbose) do iHru = 1, nCatch ix = NETOPO_in(iRch)%HRUIX(iHru) if (present(offset)) ix = ix+offset - write(iulog, '(a,x,5(g20.12))') & + write(iulog, '(a,1x,5(g20.12))') & 'reachID, hruID, basinArea [m2], weight[-], hruArea [m2]=', & NETOPO_in(iRch)%REACHID, NETOPO_in(iRch)%HRUID(iHru), RPARAM_in(iRch)%BASAREA, & NETOPO_in(iRch)%HRUWGT(iHru), rtmCTL%area(ix) diff --git a/route/build/cpl/RtmTimeManager.F90 b/route/build/cpl/RtmTimeManager.F90 index 028d8fe24..9a1716b23 100644 --- a/route/build/cpl/RtmTimeManager.F90 +++ b/route/build/cpl/RtmTimeManager.F90 @@ -1,6 +1,5 @@ MODULE RtmTimeManager - USE ESMF USE shr_kind_mod, ONLY: r8 => shr_kind_r8 USE shr_sys_mod , ONLY: shr_sys_abort, shr_sys_flush USE public_var , ONLY: iulog @@ -21,14 +20,14 @@ MODULE RtmTimeManager logical, parameter :: debug_write = .true. ! Input from CESM driver - integer, save :: nelapse = integerMissing, & ! number of timesteps (or days if negative) to extend a run + integer :: nelapse = integerMissing, & ! number of timesteps (or days if negative) to extend a run start_ymd = integerMissing, & ! starting date for run in yearmmdd format start_tod = 0, & ! starting time of day for run in seconds stop_ymd = integerMissing, & ! stopping date for run in yearmmdd format stop_tod = 0, & ! stopping time of day for run in seconds ref_ymd = integerMissing, & ! reference date for time coordinate in yearmmdd format ref_tod = 0 ! reference time of day for time coordinate in seconds - logical, save :: tm_first_restart_step = .false. ! true for first step of a restart or branch run + logical :: tm_first_restart_step = .false. ! true for first step of a restart or branch run CONTAINS @@ -60,7 +59,6 @@ SUBROUTINE init_time(ierr, message) character(*), intent(out) :: message ! error message ! local variable integer :: nTime - integer :: ix real(r8) :: dt_day ! simulation time step in day real(r8) :: timePerDay ! number of time-unit per a day. time-unit is from t_unit real(r8) :: secPerTime ! number of sec per time-unit. time-unit is from t_unit @@ -82,7 +80,10 @@ SUBROUTINE init_time(ierr, message) case('hours','hour','hr','h'); secPerTime=3600._r8; timePerDay=24._r8 case('days','day','d'); secPerTime=86400._r8; timePerDay=1._r8 case default - ierr=20; message=trim(message)//'= '//trim(time_units)//': must be seconds, minutes, hours or days.'; return + ierr=20 + message=trim(message)//'= '//trim(time_units)// & + ': must be seconds, minutes, hours or days.' + return end select dt_day = dt/secprday ! dt [sec] -> dt_day @@ -114,7 +115,11 @@ SUBROUTINE init_time(ierr, message) timeVar = (begJulday - refJulday)*timePerDay ! check that the dates are aligned - if(endDatetime < begDatetime) then; ierr=20; message=trim(message)//'simulation end is before simulation start'; return; endif + if(endDatetime < begDatetime) then + ierr=20 + message=trim(message)//'simulation end is before simulation start' + return + endif ! initialize model time at first time step (1) and previous time step (0) iTime = 1 @@ -125,8 +130,10 @@ SUBROUTINE init_time(ierr, message) if (masterproc .and. debug_write) then write(iulog,*) 'simStart datetime = ', trim(simStart) write(iulog,*) 'simEnd datetime = ', trim(simEnd) - write(iulog,*) 'reference datetime = ', refDatetime%year(), refDatetime%month(), refDatetime%day(), refDatetime%hour(), refDatetime%minute(), refDatetime%sec() - write(iulog,*) 'simDatetime = ', simDatetime(1)%year(), simDatetime(1)%month(), simDatetime(1)%day(), simDatetime(1)%hour(), simDatetime(1)%minute(), simDatetime(1)%sec() + write(iulog,*) 'reference datetime = ', refDatetime%year(), refDatetime%month(), refDatetime%day(), & + refDatetime%hour(), refDatetime%minute(), refDatetime%sec() + write(iulog,*) 'simDatetime = ', simDatetime(1)%year(), simDatetime(1)%month(), & + simDatetime(1)%day(), simDatetime(1)%hour(), simDatetime(1)%minute(), simDatetime(1)%sec() write(iulog,*) 'dt [sec] = ', dt write(iulog,*) 'nTime = ', nTime write(iulog,*) 'iTime, timeVar(iTime) = ', iTime, timeVar @@ -139,6 +146,7 @@ END SUBROUTINE init_time ! Public subroutine: SUBROUTINE shr_timeStr(esmfTime, timeStr) + USE ESMF , ONLY: ESMF_Time, ESMF_TimeGet implicit none ! Arguments @@ -151,9 +159,8 @@ SUBROUTINE shr_timeStr(esmfTime, timeStr) call ESMF_TimeGet(esmfTime , yy=yy, mm=mm, dd=dd, h=hr, m=mn, s=sec, rc=rc ) - write(timeStr,'(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)'), yy,'-',mm,'-',dd,' ',hr,':',mn,':',sec + write(timeStr,'(i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2)') yy,'-',mm,'-',dd,' ',hr,':',mn,':',sec END SUBROUTINE shr_timeStr - END MODULE RtmTimeManager diff --git a/route/build/src/accum_runoff.f90 b/route/build/src/accum_runoff.f90 index cf080dbdd..c5616bacb 100644 --- a/route/build/src/accum_runoff.f90 +++ b/route/build/src/accum_runoff.f90 @@ -163,7 +163,7 @@ SUBROUTINE accum_qupstream(iEns, & ! input: index of runoff ensemble to ! check if(segIndex == ixDesire)then write(iulog,'(2a)') new_line('a'),'** Check upstream discharge accumulation **' - write(iulog,'(a,x,I10,x,I10)') ' Reach index & ID =', segIndex, NETOPO_in(segIndex)%REACHID + write(iulog,'(a,1x,I10,1x,I10)') ' Reach index & ID =', segIndex, NETOPO_in(segIndex)%REACHID if (nUps>0) then write(fmt1,'(A,I5,A)') '(A,1X',nUps,'(1X,I10))' write(fmt2,'(A,I5,A)') '(A,1X',nUps,'(1X,F20.7))' @@ -172,8 +172,8 @@ SUBROUTINE accum_qupstream(iEns, & ! input: index of runoff ensemble to write(iulog,fmt2) ' prflux =', (RCHFLX_out(iens,NETOPO_in(segIndex)%UREACHI(iUps))%ROUTE(idxSUM)%REACH_Q, iUps=1,nUps) end if write(iulog,'(a)') ' * local area discharge (RCHFLX_out%BASIN_QR(1)) and final discharge (RCHFLX_out%ROUTE(idxSUM)%REACH_Q) [m3/s] :' - write(iulog,'(a,x,G15.4)') ' RCHFLX_out%BASIN_QR(1) =', RCHFLX_out(iEns,segIndex)%BASIN_QR(1) - write(iulog,'(a,x,G15.4)') ' RCHFLX_out%ROUTE(idxSUM)%REACH_Q =', RCHFLX_out(iens,segIndex)%ROUTE(idxSUM)%REACH_Q + write(iulog,'(a,1x,G15.4)') ' RCHFLX_out%BASIN_QR(1) =', RCHFLX_out(iEns,segIndex)%BASIN_QR(1) + write(iulog,'(a,1x,G15.4)') ' RCHFLX_out%ROUTE(idxSUM)%REACH_Q =', RCHFLX_out(iens,segIndex)%ROUTE(idxSUM)%REACH_Q endif END SUBROUTINE accum_qupstream diff --git a/route/build/src/dfw_route.f90 b/route/build/src/dfw_route.f90 index 170148f07..2d269b020 100644 --- a/route/build/src/dfw_route.f90 +++ b/route/build/src/dfw_route.f90 @@ -186,10 +186,11 @@ SUBROUTINE dfw_rch(iEns, segIndex, & ! input: index of runoff ensemble to be pro if (nUps>0) then do iUps = 1,nUps iRch_ups = NETOPO_in(segIndex)%UREACHI(iUps) ! index of upstream of segIndex-th reach - write(iulog,'(A,X,I12,X,G15.4)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps),RCHFLX_out(iens, iRch_ups)%ROUTE(idxDW)%REACH_Q + write(iulog,'(A,1X,I12,1X,G15.4)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps), & + RCHFLX_out(iens, iRch_ups)%ROUTE(idxDW)%REACH_Q enddo end if - write(iulog,'(A,X,G15.4)') ' RCHFLX_out(iEns,segIndex)%BASIN_QR(1)=',RCHFLX_out(iEns,segIndex)%BASIN_QR(1) + write(iulog,'(A,1X,G15.4)') ' RCHFLX_out(iEns,segIndex)%BASIN_QR(1)=',RCHFLX_out(iEns,segIndex)%BASIN_QR(1) endif ! solve diffusive wave equation @@ -204,16 +205,17 @@ SUBROUTINE dfw_rch(iEns, segIndex, & ! input: index of runoff ensemble to be pro verbose, & ! input: reach index to be examined ierr, cmessage) ! output: error control if(ierr/=0)then - write(message, '(A,X,I12,X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage) + write(message, '(A,1X,I12,1X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage) return endif if(verbose)then - write(iulog,'(A,X,G15.4)') ' RCHFLX_out(iens,segIndex)%REACH_Q=', RCHFLX_out(iens,segIndex)%ROUTE(idxDW)%REACH_Q + write(iulog,'(A,1X,G15.4)') ' RCHFLX_out(iens,segIndex)%REACH_Q=', RCHFLX_out(iens,segIndex)%ROUTE(idxDW)%REACH_Q endif if (RCHFLX_out(iens,segIndex)%ROUTE(idxDW)%REACH_VOL(1) < 0) then - write(iulog,'(A,X,G12.5,X,A,X,I9)') ' ---- NEGATIVE VOLUME = ', RCHFLX_out(iens,segIndex)%ROUTE(idxDW)%REACH_VOL(1), 'at ', NETOPO_in(segIndex)%REACHID + write(iulog,'(A,1X,G12.5,1X,A,1X,I9)') ' ---- NEGATIVE VOLUME = ', RCHFLX_out(iens,segIndex)%ROUTE(idxDW)%REACH_VOL(1), & + 'at ', NETOPO_in(segIndex)%REACHID end if call comp_reach_wb(NETOPO_in(segIndex)%REACHID, idxDW, q_upstream, RCHFLX_out(iens,segIndex), verbose, lakeFlag=.false.) @@ -348,17 +350,17 @@ SUBROUTINE diffusive_wave(rch_param, & ! input: river parameter data structu dx = rch_param%RLENGTH/(Nx-1) ! one extra sub-segment beyond outlet if (verbose) then - write(iulog,'(A,X,G12.5)') ' length [m] =',rch_param%RLENGTH - write(iulog,'(A,X,G12.5)') ' slope [-] =',rch_param%R_SLOPE - write(iulog,'(A,X,G12.5)') ' channel width [m] =',rch_param%R_WIDTH - write(iulog,'(A,X,G12.5)') ' manning coef [-] =',rch_param%R_MAN_N + write(iulog,'(A,1X,G12.5)') ' length [m] =',rch_param%RLENGTH + write(iulog,'(A,1X,G12.5)') ' slope [-] =',rch_param%R_SLOPE + write(iulog,'(A,1X,G12.5)') ' channel width [m] =',rch_param%R_WIDTH + write(iulog,'(A,1X,G12.5)') ' manning coef [-] =',rch_param%R_MAN_N end if ! time-step adjustment so Courant number is less than 1 dTsub = dt/ntSub if (verbose) then - write(iulog,'(A,X,I3,A,X,G12.5)') ' No. sub timestep=',nTsub,' sub time-step [sec]=',dTsub + write(iulog,'(A,1X,I3,A,1X,G12.5)') ' No. sub timestep=',nTsub,' sub time-step [sec]=',dTsub end if allocate(Qlocal(1:nMolecule%DW_ROUTE, 0:1), stat=ierr, errmsg=cmessage) @@ -451,7 +453,7 @@ SUBROUTINE diffusive_wave(rch_param, & ! input: river parameter data structu if (verbose) then write(fmt1,'(A,I5,A)') '(A,1X',nMolecule%DW_ROUTE,'(1X,G15.4))' - write(iulog,'(A,X,G12.5)') ' rflux%REACH_Q= ', rflux%ROUTE(idxDW)%REACH_Q + write(iulog,'(A,1X,G12.5)') ' rflux%REACH_Q= ', rflux%ROUTE(idxDW)%REACH_Q write(iulog,fmt1) ' Qprev(1:nMolecule)= ', Qprev(1:nMolecule%DW_ROUTE) write(iulog,'(A,5(1X,G12.5))') ' Qbar, Abar, Vbar, ck, dk= ',Qbar, Abar, Vbar, ck, dk write(iulog,'(A,2(1X,G12.5))') ' Cd, Ca= ', Cd, Ca diff --git a/route/build/src/domain_decomposition.f90 b/route/build/src/domain_decomposition.f90 index beef8f6f7..93b39a2fe 100644 --- a/route/build/src/domain_decomposition.f90 +++ b/route/build/src/domain_decomposition.f90 @@ -112,11 +112,11 @@ SUBROUTINE print_screen() associate (segIndexSub => domains_mpi(ix)%segIndex, nSubSeg => size(domains_mpi(ix)%segIndex)) do iSeg = 1,size(segIndexSub) if (downIndex(segIndexSub(iSeg)) > 0) then - write(iulog, "(I9,x,I12,x,I9,x,I12,x,I5,x,I3)") segIndexSub(iSeg),segId(segIndexSub(iSeg)), & + write(iulog, "(I9,1x,I12,1x,I9,1x,I12,1x,I5,1x,I3)") segIndexSub(iSeg),segId(segIndexSub(iSeg)), & downIndex(segIndexSub(iSeg)),segId(downIndex(segIndexSub(iSeg))), & ix, domains_mpi(ix)%idNode else - write(iulog, "(I9,x,I12,x,I9,x,I12,x,I5,x,I3)") segIndexSub(iSeg),segId(segIndexSub(iSeg)), & + write(iulog, "(I9,1x,I12,1x,I9,1x,I12,1x,I5,1x,I3)") segIndexSub(iSeg),segId(segIndexSub(iSeg)), & downIndex(segIndexSub(iSeg)),-999, & ix, domains_mpi(ix)%idNode endif diff --git a/route/build/src/histVars_data.f90 b/route/build/src/histVars_data.f90 index 4865f36a2..7eab07910 100644 --- a/route/build/src/histVars_data.f90 +++ b/route/build/src/histVars_data.f90 @@ -195,7 +195,7 @@ SUBROUTINE aggregate(this, & ! inout: case(muskingumCunge); idxMethod=idxMC case(diffusiveWave); idxMethod=idxDW case default - write(message,'(2A,X,G0,X,A)') trim(message), 'routing method index:',routeMethods(iRoute), 'must be 0-5' + write(message,'(2A,1X,G0,1X,A)') trim(message), 'routing method index:',routeMethods(iRoute), 'must be 0-5' ierr=81; return end select @@ -435,7 +435,7 @@ SUBROUTINE read_restart(this, restart_name, ierr, message) ixFlow=ixRFLX%DWroutedRunoff ixVol=ixRFLX%DWvolume case default - write(message,'(2A,X,G0,X,A)') trim(message), 'routing method index:',routeMethods(ixRoute), 'must be 0-5' + write(message,'(2A,1X,G0,1X,A)') trim(message), 'routing method index:',routeMethods(ixRoute), 'must be 0-5' ierr=81; return end select diff --git a/route/build/src/irf_route.f90 b/route/build/src/irf_route.f90 index 1ecfa7975..11a35c98d 100644 --- a/route/build/src/irf_route.f90 +++ b/route/build/src/irf_route.f90 @@ -222,20 +222,23 @@ SUBROUTINE irf_rch(iEns, & ! input: index of runoff ensemble to be proce ntdh = size(NETOPO_in(segIndex)%UH) write(fmt1,'(A,I5,A)') '(A, 1X',ntdh,'(1X,F20.7))' write(*,'(2a)') new_line('a'),'** Check Impulse Response Function routing **' - write(*,'(a,x,I10,x,I10)') ' Reach index & ID =', segIndex, NETOPO_in(segIndex)%REACHID - write(*,fmt1) ' Unit-Hydrograph =', (NETOPO_in(segIndex)%UH(itdh), itdh=1,ntdh) - write(*,'(a)') ' * total discharge from upstream(q_upstream) [m3/s], local area discharge [m3/s], and Final discharge [m3/s]:' - write(*,'(a,x,F15.7)') ' q_upstream =', q_upstream - write(*,'(a,x,F15.7)') ' RCHFLX_out%BASIN_QR(1) =', RCHFLX_out(iens,segIndex)%BASIN_QR(1) - write(*,'(a,x,F15.7)') ' RCHFLX_out%REACH_Q =', RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_Q + write(*,'(a,1x,I10,1x,I10)')' Reach index & ID =', segIndex, NETOPO_in(segIndex)%REACHID + write(*,fmt1) ' Unit-Hydrograph =', (NETOPO_in(segIndex)%UH(itdh), itdh=1,ntdh) + write(*,'(a)') ' * total discharge from upstream(q_upstream) [m3/s], local area discharge [m3/s]' // & + ', and Final discharge [m3/s]:' + write(*,'(a,1x,F15.7)') ' q_upstream =', q_upstream + write(*,'(a,1x,F15.7)') ' RCHFLX_out%BASIN_QR(1) =', RCHFLX_out(iens,segIndex)%BASIN_QR(1) + write(*,'(a,1x,F15.7)') ' RCHFLX_out%REACH_Q =', RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_Q endif if (RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_VOL(1) < 0) then - write(iulog,'(A,X,G12.5,X,A,X,I9)') ' ---- NEGATIVE VOLUME [m3]= ', RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_VOL(1), 'at ', NETOPO_in(segIndex)%REACHID + write(iulog,'(A,1X,G12.5,1X,A,1X,I9)') ' ---- NEGATIVE VOLUME [m3]= ', RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_VOL(1), & + 'at ', NETOPO_in(segIndex)%REACHID ! RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_VOL(1) = 0._dp end if if (RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_Q < 0) then - write(iulog,'(A,X,G12.5,X,A,X,I9)') ' ---- NEGATIVE FLOW [m3/s] = ', RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_Q, 'at ', NETOPO_in(segIndex)%REACHID + write(iulog,'(A,1X,G12.5,1X,A,1X,I9)') ' ---- NEGATIVE FLOW [m3/s] = ', RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_Q, & + 'at ', NETOPO_in(segIndex)%REACHID ! RCHFLX_out(iens,segIndex)%ROUTE(idxIRF)%REACH_Q = 0._dp end if diff --git a/route/build/src/kwe_route.f90 b/route/build/src/kwe_route.f90 index d38a2c797..013ea5c99 100644 --- a/route/build/src/kwe_route.f90 +++ b/route/build/src/kwe_route.f90 @@ -190,10 +190,11 @@ SUBROUTINE kw_rch(iEns, segIndex, & ! input: index of runoff ensemble to be proc if (nUps>0) then do iUps = 1,nUps iRch_ups = NETOPO_in(segIndex)%UREACHI(iUps) ! index of upstream of segIndex-th reach - write(iulog,'(A,X,I12,X,G12.5)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps),RCHFLX_out(iens, iRch_ups)%ROUTE(idxKW)%REACH_Q + write(iulog,'(A,1X,I12,1X,G12.5)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps), & + RCHFLX_out(iens, iRch_ups)%ROUTE(idxKW)%REACH_Q enddo end if - write(iulog,'(A,X,G15.4)') ' RCHFLX_out(iEns,segIndex)%BASIN_QR(1)=',RCHFLX_out(iEns,segIndex)%BASIN_QR(1) + write(iulog,'(A,1X,G15.4)') ' RCHFLX_out(iEns,segIndex)%BASIN_QR(1)=',RCHFLX_out(iEns,segIndex)%BASIN_QR(1) endif ! perform river network KW routing @@ -208,15 +209,16 @@ SUBROUTINE kw_rch(iEns, segIndex, & ! input: index of runoff ensemble to be proc verbose, & ! input: reach index to be examined ierr, cmessage) ! output: error control if(ierr/=0)then - write(message, '(A,X,I12,X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return + write(message, '(A,1X,I12,1X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return endif if(verbose)then - write(iulog,'(A,X,G15.4)') ' RCHFLX_out(iens,segIndex)%REACH_Q=', RCHFLX_out(iens,segIndex)%ROUTE(idxKW)%REACH_Q + write(iulog,'(A,1X,G15.4)') ' RCHFLX_out(iens,segIndex)%REACH_Q=', RCHFLX_out(iens,segIndex)%ROUTE(idxKW)%REACH_Q endif if (RCHFLX_out(iens,segIndex)%ROUTE(idxKW)%REACH_VOL(1) < 0) then - write(iulog,'(A,X,G12.5,X,A,X,I9)') ' ---- NEGATIVE VOLUME = ', RCHFLX_out(iens,segIndex)%ROUTE(idxKW)%REACH_VOL(1), 'at ', NETOPO_in(segIndex)%REACHID + write(iulog,'(A,1X,G12.5,1X,A,1X,I9)') ' ---- NEGATIVE VOLUME = ', RCHFLX_out(iens,segIndex)%ROUTE(idxKW)%REACH_VOL(1), & + 'at ', NETOPO_in(segIndex)%REACHID end if call comp_reach_wb(NETOPO_in(segIndex)%REACHID, idxKW, q_upstream, RCHFLX_out(iens,segIndex), verbose, lakeFlag=.false.) @@ -315,12 +317,12 @@ SUBROUTINE kinematic_wave(rch_param, & ! input: river parameter data structu Q(1,0) = QupMod if (verbose) then - write(iulog,'(A,X,G12.5)') ' length [m] =',rch_param%RLENGTH - write(iulog,'(A,X,G12.5)') ' slope [-] =',rch_param%R_SLOPE - write(iulog,'(A,X,G12.5)') ' channel width [m] =',rch_param%R_WIDTH - write(iulog,'(A,X,G12.5)') ' manning coef. [-] =',rch_param%R_MAN_N - write(iulog,'(A)') ' Initial 3 point discharge [m3/s]: ' - write(iulog,'(3(A,X,G12.5))') ' Q(0,0)=',Q(0,0),' Q(0,1)=',Q(0,1),' Q(1,0)=',Q(1,0) + write(iulog,'(A,1X,G12.5)') ' length [m] =',rch_param%RLENGTH + write(iulog,'(A,1X,G12.5)') ' slope [-] =',rch_param%R_SLOPE + write(iulog,'(A,1X,G12.5)') ' channel width [m] =',rch_param%R_WIDTH + write(iulog,'(A,1X,G12.5)') ' manning coef. [-] =',rch_param%R_MAN_N + write(iulog,'(A)') ' Initial 3 point discharge [m3/s]: ' + write(iulog,'(3(A,1X,G12.5))') ' Q(0,0)=',Q(0,0),' Q(0,1)=',Q(0,1),' Q(1,0)=',Q(1,0) end if ! ---------- @@ -381,7 +383,7 @@ SUBROUTINE kinematic_wave(rch_param, & ! input: river parameter data structu rflux%ROUTE(idxKW)%REACH_Q = Q(1,1)+rflux%BASIN_QR(1) if (verbose) then - write(iulog,'(1(A,X,G15.4))') ' Q(1,1)=',Q(1,1) + write(iulog,'(1(A,1X,G15.4))') ' Q(1,1)=',Q(1,1) end if ! Q abstraction diff --git a/route/build/src/kwt_route.f90 b/route/build/src/kwt_route.f90 index 52a093075..3d9caace9 100644 --- a/route/build/src/kwt_route.f90 +++ b/route/build/src/kwt_route.f90 @@ -241,11 +241,11 @@ SUBROUTINE qroute_rch(IENS,JRCH, & ! input: array indices if(JRCH==ixDesire) then write(iulog,'(2a)') new_line('a'),'** Check kinematic wave tracking routing **' - write(iulog,"(a,x,I10,x,I10)") ' Reach index & ID =', JRCH, NETOPO_in(JRCH)%REACHID - write(iulog,"(a,x,F20.7,1x,F20.7)") ' time step(T0,T1) =', T0, T1 - write(iulog,'(a,x,F15.7)') ' RPARAM_in%R_SLOPE =', RPARAM_in(JRCH)%R_SLOPE - write(iulog,'(a,x,F15.7)') ' RPARAM_in%R_MAN_N =', RPARAM_in(JRCH)%R_MAN_N - write(iulog,'(a,x,F15.7)') ' RPARAM_in%R_WIDTH =', RPARAM_in(JRCH)%R_WIDTH + write(iulog,"(a,1x,I10,1x,I10)") ' Reach index & ID =', JRCH, NETOPO_in(JRCH)%REACHID + write(iulog,"(a,1x,F20.7,1x,F20.7)") ' time step(T0,T1) =', T0, T1 + write(iulog,'(a,1x,F15.7)') ' RPARAM_in%R_SLOPE =', RPARAM_in(JRCH)%R_SLOPE + write(iulog,'(a,1x,F15.7)') ' RPARAM_in%R_MAN_N =', RPARAM_in(JRCH)%R_MAN_N + write(iulog,'(a,1x,F15.7)') ' RPARAM_in%R_WIDTH =', RPARAM_in(JRCH)%R_WIDTH end if ! ---------------------------------------------------------------------------------------- @@ -278,7 +278,10 @@ SUBROUTINE qroute_rch(IENS,JRCH, & ! input: array indices if(ierr/=0)then; message=trim(message)//'problem deallocating space for RCHSTA_out'; return; endif endif allocate(RCHSTA_out(IENS,JRCH)%LKW_ROUTE%KWAVE(0:0),STAT=ierr) - if(ierr/=0)then; message=trim(message)//'problem allocating space for RCHSTA_out(IENS,JRCH)%LKW_ROUTE%KWAVE(1)'; return; endif + if(ierr/=0)then + message=trim(message)//'problem allocating space for RCHSTA_out(IENS,JRCH)%LKW_ROUTE%KWAVE(1)' + return + endif RCHSTA_out(IENS,JRCH)%LKW_ROUTE%KWAVE(0)%QF=-9999 RCHSTA_out(IENS,JRCH)%LKW_ROUTE%KWAVE(0)%TI=-9999 RCHSTA_out(IENS,JRCH)%LKW_ROUTE%KWAVE(0)%TR=-9999 @@ -287,7 +290,7 @@ SUBROUTINE qroute_rch(IENS,JRCH, & ! input: array indices if(JRCH==ixDesire) then write(iulog,'(a)') ' * Final discharge (RCHFLX_out(IENS,JRCH)%REACH_Q) [m3/s]:' - write(iulog,'(x,G15.4)') RCHFLX_out(IENS,JRCH)%ROUTE(idxKWT)%REACH_Q + write(iulog,'(1x,G15.4)') RCHFLX_out(IENS,JRCH)%ROUTE(idxKWT)%REACH_Q end if return ! no upstream reaches (routing for sub-basins done using time-delay histogram) endif @@ -520,9 +523,9 @@ SUBROUTINE extract_from_rch(iens, jrch, & ! input: ensemble and rea call interp_rch(TENTRY(0:NR-1),Q_jrch_abs(0:NR-1), TP, Qavg, ierr,cmessage) Qabs = Qavg(1)*RPARAM_in(JRCH)%R_WIDTH write(*,'(a)') ' * Target abstraction (Qtake) [m3/s], Available discharge (totQ) [m3/s], Actual abstraction (Qabs) [m3/s] ' - write(*,'(a,x,G15.4)') ' Qtake =', Qtake - write(*,'(a,x,G15.4)') ' totQ =', totQ - write(*,'(a,x,G15.4)') ' Qabs =', Qabs + write(*,'(a,1x,G15.4)') ' Qtake =', Qtake + write(*,'(a,1x,G15.4)') ' totQ =', totQ + write(*,'(a,1x,G15.4)') ' Qabs =', Qabs end if ! modify wave speed at modified wave discharge and re-compute exit time @@ -666,9 +669,9 @@ subroutine getusq_rch(IENS,JRCH,LAKEFLAG,T0,T1,ixDesire, & ! input if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif if (JRCH == ixDesire) then write(fmt1,'(A,I5,A)') '(A,1X',ND,'(1X,G15.4))' - write(*,'(a)') ' * After qexmul_rch: # of routed wave from upstreams (ND) and wave discharge (QD) [m2/s]:' - write(*,'(A,x,I5)') ' ND=', ND - write(*,fmt1) ' QD=', (QD(iw), iw=1,ND) + write(*,'(a)') ' * After qexmul_rch: # of routed wave from upstreams (ND) and wave discharge (QD) [m2/s]:' + write(*,'(A,1x,I5)') ' ND=', ND + write(*,fmt1) ' QD=', (QD(iw), iw=1,ND) end if end if @@ -845,7 +848,8 @@ SUBROUTINE qexmul_rch(IENS,JRCH,T0,T1,ixDesire, & ! input TD(1) = T1 if(JRCH == ixDesire) then - write(iulog,'(A,x,I8,x,I8)') ' * Special case - This reach has one headwater upstream: IR, NETOPO_in(IR)%REACHID = ', IR, NETOPO_in(IR)%REACHID + write(iulog,'(A,1x,I8,1x,I8)') ' * Special case - This reach has one headwater upstream: IR, NETOPO_in(IR)%REACHID = ', & + IR, NETOPO_in(IR)%REACHID end if return @@ -1384,10 +1388,10 @@ SUBROUTINE kinwav_rch(JRCH,T_START,T_END,ixDesire, & ! input: loca if(jRch==ixDesire) then write(fmt1,'(A,I5,A)') '(A,1X',NN,'(1X,G15.4))' - write(iulog,'(a)') ' * Wave discharge (q1) [m2/s] and wave celertiy (wc) [m/s]:' - write(iulog,'(a,x,I3)') ' Number of wave =', NN - write(iulog,fmt1) ' q1=', (q1(iw), iw=1,NN) - write(iulog,fmt1) ' wc=', (wc(iw), iw=1,NN) + write(iulog,'(a)') ' * Wave discharge (q1) [m2/s] and wave celertiy (wc) [m/s]:' + write(iulog,'(a,1x,I3)') ' Number of wave =', NN + write(iulog,fmt1) ' q1=', (q1(iw), iw=1,NN) + write(iulog,fmt1) ' wc=', (wc(iw), iw=1,NN) end if ! handle breaking waves @@ -1444,9 +1448,9 @@ SUBROUTINE kinwav_rch(JRCH,T_START,T_END,ixDesire, & ! input: loca ! check if(jRch==ixDesire) then write(fmt1,'(A,I5,A)') '(A,1X',NN,'(1X,G15.4))' - write(iulog,'(a)') ' * After wave merge: wave celertiy (wc) [m/s]:' - write(iulog,'(a,x,I3)') ' Number of wave =', NN - write(iulog,fmt1) ' wc=', (wc(iw), iw=1,NN) + write(iulog,'(a)') ' * After wave merge: wave celertiy (wc) [m/s]:' + write(iulog,'(a,1x,I3)') ' Number of wave =', NN + write(iulog,fmt1) ' wc=', (wc(iw), iw=1,NN) end if ICOUNT=0 diff --git a/route/build/src/mc_route.f90 b/route/build/src/mc_route.f90 index 5023bf488..9579b060b 100644 --- a/route/build/src/mc_route.f90 +++ b/route/build/src/mc_route.f90 @@ -188,10 +188,11 @@ SUBROUTINE mc_rch(iEns, segIndex, & ! input: index of runoff ensemble to be proc if (nUps>0) then do iUps = 1,nUps iRch_ups = NETOPO_in(segIndex)%UREACHI(iUps) ! index of upstream of segIndex-th reach - write(iulog,'(A,X,I12,X,G12.5)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps),RCHFLX_out(iens, iRch_ups)%ROUTE(idxMC)%REACH_Q + write(iulog,'(A,1X,I12,1X,G12.5)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps), & + RCHFLX_out(iens, iRch_ups)%ROUTE(idxMC)%REACH_Q enddo end if - write(iulog,'(A,X,G12.5)') ' RCHFLX_out(iEns,segIndex)%BASIN_QR(1)=',RCHFLX_out(iEns,segIndex)%BASIN_QR(1) + write(iulog,'(A,1X,G12.5)') ' RCHFLX_out(iEns,segIndex)%BASIN_QR(1)=',RCHFLX_out(iEns,segIndex)%BASIN_QR(1) endif ! solve muskingum-cunge alogorithm @@ -206,15 +207,16 @@ SUBROUTINE mc_rch(iEns, segIndex, & ! input: index of runoff ensemble to be proc verbose, & ! input: reach index to be examined ierr, cmessage) ! output: error control if(ierr/=0)then - write(message, '(A,X,I10,X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return + write(message, '(A,1X,I10,1X,A)') trim(message)//'/segment=', NETOPO_in(segIndex)%REACHID, '/'//trim(cmessage); return endif if(verbose)then - write(iulog,'(A,X,G12.5)') ' RCHFLX_out(iens,segIndex)%REACH_Q=', RCHFLX_out(iens,segIndex)%ROUTE(idxMC)%REACH_Q + write(iulog,'(A,1X,G12.5)') ' RCHFLX_out(iens,segIndex)%REACH_Q=', RCHFLX_out(iens,segIndex)%ROUTE(idxMC)%REACH_Q endif if (RCHFLX_out(iens,segIndex)%ROUTE(idxMC)%REACH_VOL(1) < 0) then - write(iulog,'(A,X,G12.5,X,A,X,I9)') ' ---- NEGATIVE VOLUME = ', RCHFLX_out(iens,segIndex)%ROUTE(idxMC)%REACH_VOL(1), 'at ', NETOPO_in(segIndex)%REACHID + write(iulog,'(A,1X,G12.5,1X,A,1X,I9)') ' ---- NEGATIVE VOLUME = ', RCHFLX_out(iens,segIndex)%ROUTE(idxMC)%REACH_VOL(1), & + 'at ', NETOPO_in(segIndex)%REACHID end if call comp_reach_wb(NETOPO_in(segIndex)%REACHID, idxMC, q_upstream, RCHFLX_out(iens,segIndex), verbose, lakeFlag=.false.) @@ -248,6 +250,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct ! (time:0:1, loc:0:1) 0-previous time step/inlet, 1-current time step/outlet. ! Q or A(1,2,3,4): 1: (t=0,x=0), 2: (t=0,x=1), 3: (t=1,x=0), 4: (t=1,x=1) + use shr_infnan_mod, only : isnan => shr_infnan_isnan implicit none ! Argument variables type(RCHPRP), intent(in) :: rch_param ! River reach parameter @@ -315,12 +318,12 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct Q(1,0) = QupMod if (verbose) then - write(iulog,'(A,X,G12.5)') ' length [m] =',rch_param%RLENGTH - write(iulog,'(A,X,G12.5)') ' slope [-] =',rch_param%R_SLOPE - write(iulog,'(A,X,G12.5)') ' channel width [m] =',rch_param%R_WIDTH - write(iulog,'(A,X,G12.5)') ' manning coef [-] =',rch_param%R_MAN_N - write(iulog,'(A)') ' Initial 3 point discharge [m3/s]: ' - write(iulog,'(3(A,X,G12.5))') ' Qin(t-1) Q(0,0)=',Q(0,0),' Qin(t) Q(1,0)=',Q(1,0),' Qout(t-1) Q(0,1)=',Q(0,1) + write(iulog,'(A,1X,G12.5)') ' length [m] =',rch_param%RLENGTH + write(iulog,'(A,1X,G12.5)') ' slope [-] =',rch_param%R_SLOPE + write(iulog,'(A,1X,G12.5)') ' channel width [m] =',rch_param%R_WIDTH + write(iulog,'(A,1X,G12.5)') ' manning coef [-] =',rch_param%R_MAN_N + write(iulog,'(A)') ' Initial 3 point discharge [m3/s]: ' + write(iulog,'(3(A,1X,G12.5))') ' Qin(t-1) Q(0,0)=',Q(0,0),' Qin(t) Q(1,0)=',Q(1,0),' Qout(t-1) Q(0,1)=',Q(0,1) end if ! first, using 3-point average in computational molecule, check Cournat number is less than 1, otherwise subcycle within one time step @@ -338,7 +341,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct dTsub = dt/ntSub end if if (verbose) then - write(iulog,'(A,X,I3,A,X,G12.5)') ' No. sub timestep=',nTsub,' sub time-step [sec]=',dTsub + write(iulog,'(A,1X,I3,A,1X,G12.5)') ' No. sub timestep=',nTsub,' sub time-step [sec]=',dTsub end if allocate(QoutLocal(0:ntSub), QinLocal(0:ntSub), stat=ierr, errmsg=cmessage) @@ -372,7 +375,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct end if if (verbose) then - write(iulog,'(A,I3,X,A,G12.5,X,A,G12.5)') ' sub time-step= ',ix,'Courant number= ',Cn, 'Q= ',QoutLocal(ix) + write(iulog,'(A,I3,1X,A,G12.5,1X,A,G12.5)') ' sub time-step= ',ix,'Courant number= ',Cn, 'Q= ',QoutLocal(ix) end if end do @@ -416,7 +419,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct end if if (verbose) then - write(iulog,'(A,X,G12.5)') ' Qout(t)=',Q(1,1) + write(iulog,'(A,1X,G12.5)') ' Qout(t)=',Q(1,1) endif ! save inflow (index 1) and outflow (index 2) at current time step diff --git a/route/build/src/nr_utils.f90 b/route/build/src/nr_utils.f90 index 9f854736f..5d33dda48 100644 --- a/route/build/src/nr_utils.f90 +++ b/route/build/src/nr_utils.f90 @@ -423,7 +423,7 @@ FUNCTION match_index(array1, array2, ierr, message) RESULT(index1) do ix=1,size(array2) if(index1(ix) == integerMissing) cycle if(array2(ix) /= array1( index1(ix) ) )then - write(iulog,'(a,2(x,I10,x,I15))') 'ERROR Mapping: ix, ID(ix), index(ix), masterID(index(ix))=', ix, array2(ix), index1(ix), array1(index1(ix)) + write(iulog,'(a,2(1x,I10,1x,I15))') 'ERROR Mapping: ix, ID(ix), index(ix), masterID(index(ix))=', ix, array2(ix), index1(ix), array1(index1(ix)) message=trim(message)//'unable to find the match' ierr=20; return endif diff --git a/route/build/src/read_control.f90 b/route/build/src/read_control.f90 index 284b46135..4b061b549 100644 --- a/route/build/src/read_control.f90 +++ b/route/build/src/read_control.f90 @@ -101,7 +101,7 @@ SUBROUTINE read_control(ctl_fname, err, message) cName = adjustl(cLines(iLine)(ibeg_name:iend_name)) cData = adjustl(cLines(iLine)(iend_name+1:iend_data-1)) if (masterproc) then - write(iulog,'(x,a,a,a)') trim(cName), ' --> ', trim(cData) + write(iulog,'(1x,a,a,a)') trim(cName), ' --> ', trim(cData) endif if (index(cData, achar(9)) > 0) then diff --git a/route/build/src/var_lookup.f90 b/route/build/src/var_lookup.f90 index 98b0b22d5..334f115ac 100644 --- a/route/build/src/var_lookup.f90 +++ b/route/build/src/var_lookup.f90 @@ -5,6 +5,8 @@ MODULE var_lookup USE public_var, ONLY: integerMissing ! missing value for integers implicit none private + ! + INTRINSIC :: storage_size ! local variables integer(i4b),parameter :: ixVal=1 ! an example integer integer(i4b),parameter :: iLength=storage_size(ixVal) ! size of the example integer diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index a32dfe274..84323aee4 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -216,7 +216,7 @@ SUBROUTINE restart_fname(fname, timeStamp, ierr, message) ! local variables type(datetime) :: restartTimeStamp ! datetime corresponding to file name time stamp integer(i4b) :: sec_in_day ! second within day - character(len=50),parameter :: fmtYMDHMS = '(2a,I0.4,a,I0.2,a,I0.2,x,I0.2,a,I0.2,a,I0.2)' + character(len=50),parameter :: fmtYMDHMS = '(2a,I0.4,a,I0.2,a,I0.2,1x,I0.2,a,I0.2,a,I0.2)' character(len=50),parameter :: fmtYMDS='(a,I0.4,a,I0.2,a,I0.2,a,I0.5,a)' ierr=0; message='restart_fname/' diff --git a/route/build/src/write_simoutput_pio.f90 b/route/build/src/write_simoutput_pio.f90 index 05085042e..79cc1c883 100644 --- a/route/build/src/write_simoutput_pio.f90 +++ b/route/build/src/write_simoutput_pio.f90 @@ -128,7 +128,8 @@ logical(lgt) FUNCTION newFileAlarm(inDatetime, alarmFrequency, ierr, message) ierr=0; message='new_file_alarm/' if (masterproc) then - write(iulog,'(a,I4,4(x,I4))') new_line('a'), inDatetime(1)%year(), inDatetime(1)%month(), inDatetime(1)%day(), inDatetime(1)%hour(), inDatetime(1)%minute() + write(iulog,'(a,I4,4(1x,I4))') new_line('a'), inDatetime(1)%year(), inDatetime(1)%month(), & + inDatetime(1)%day(), inDatetime(1)%hour(), inDatetime(1)%minute() endif ! check need for the new file From a66d4be3c0f0c1883043fc3f2a36c87f099ff800 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 28 May 2023 00:43:02 -0600 Subject: [PATCH 02/52] More system calls for nag compiler --- route/build/src/init_model_data.f90 | 4 +++- route/build/src/mpi_utils.f90 | 5 +++-- route/build/src/water_balance.f90 | 3 ++- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/route/build/src/init_model_data.f90 b/route/build/src/init_model_data.f90 index d41d2365c..cc9bececf 100644 --- a/route/build/src/init_model_data.f90 +++ b/route/build/src/init_model_data.f90 @@ -501,6 +501,7 @@ SUBROUTINE init_ntopo(nHRU_out, nRch_out, USE process_ntopo, ONLY: check_river_properties ! check if river network data is physically valid USE ncio_utils, ONLY: get_var_dims USE process_ntopo, ONLY: augment_ntopo ! compute all the additional network topology (only compute option = on) + USE shr_sys_mod, ONLY: shr_sys_system implicit none ! Argument variables @@ -587,7 +588,8 @@ SUBROUTINE init_ntopo(nHRU_out, nRch_out, ! --> users can modify the hard-coded parameter "maxUpstreamFile" if desired if(tot_upstream > maxUpstreamFile) tot_upstream=0 - call system('rm -f '//trim(ancil_dir)//trim(fname_ntopNew)) + call shr_sys_system('rm -f '//trim(ancil_dir)//trim(fname_ntopNew), ierr) + if(ierr/=0)then; message=trim(message)//trim("Error in system call to remove fil"); return; endif call writeData(& ! input diff --git a/route/build/src/mpi_utils.f90 b/route/build/src/mpi_utils.f90 index 7de4c608e..e41405335 100644 --- a/route/build/src/mpi_utils.f90 +++ b/route/build/src/mpi_utils.f90 @@ -9,6 +9,7 @@ MODULE mpi_utils USE globalData, ONLY: masterproc USE public_var, ONLY: root USE public_var, ONLY: iulog + USE shr_sys_mod, ONLY: shr_sys_flush implicit none @@ -975,7 +976,7 @@ SUBROUTINE shr_mpi_abort(message, ierr, comm) integer(i4b) :: jerr write(iulog,*) trim(subName),trim(message),ierr - call flush(6) + call shr_sys_flush(6) if (present(comm)) then call MPI_ABORT(comm, ierr, jerr) @@ -1013,7 +1014,7 @@ SUBROUTINE mpi_handle_err(ierr,pid) ! finalize MPI call MPI_FINALIZE(jerr) - call flush(6) + call shr_sys_flush(6) stop endif diff --git a/route/build/src/water_balance.f90 b/route/build/src/water_balance.f90 index cfe7cf918..644a2718e 100644 --- a/route/build/src/water_balance.f90 +++ b/route/build/src/water_balance.f90 @@ -7,6 +7,7 @@ MODULE water_balance ! global parameters USE public_var, ONLY: iulog ! i/o logical unit number USE public_var, ONLY: dt ! simulation time step +USE shr_sys_mod, ONLY: shr_sys_flush implicit none @@ -200,7 +201,7 @@ SUBROUTINE comp_global_wb(ixRoute, verbose, ierr, message) if (abs(wb_error) > 1._dp) then ! tolerance is 1 [m3] write(iulog,'(A,1PG15.7,1X,A)') ' WARNING: global WB error [m3] = ', wb_error, '> 1.0 [m3]' end if - flush(iulog) + call shr_sys_flush(iulog) CONTAINS From c102d44f299a53c93e5cb6b63af9bdce28fb11a6 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 28 May 2023 15:57:59 -0600 Subject: [PATCH 03/52] Nag compiler on izumi has trouble with associated statement on list that has already been deallocated in the previous statement 'deallocate(previous)' --- route/build/src/ascii_utils.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/route/build/src/ascii_utils.f90 b/route/build/src/ascii_utils.f90 index d7c86512e..090c8d3bf 100644 --- a/route/build/src/ascii_utils.f90 +++ b/route/build/src/ascii_utils.f90 @@ -204,8 +204,10 @@ SUBROUTINE get_vlines(unt,vlines,err,message) vlines(current%ix) = current%chardat previous=>current; current=>current%next deallocate(previous) + nullify(previous) end do - if(associated(list)) nullify(list) + nullify(list) + !if(associated(list)) nullify(list) END SUBROUTINE get_vlines ! ********************************************************************************************** From 566bcfbab1d90a9554900c5bce62daa55b3d18b2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Jun 2023 23:41:50 -0600 Subject: [PATCH 04/52] Update buildnml for later cime, and have the buildnml test use cime from CTSM rather than mizuroute, add dataset files so that mizroute.input_data_list is set --- cime_config/buildnml | 36 ++++++++++--------- cime_config/namelist_definition_mizuRoute.xml | 23 ++++++++++++ cime_config/test/env_case.xml | 19 +++++++--- cime_config/test/env_run.xml | 2 +- cime_config/test/runbuildnml | 9 +++-- 5 files changed, 64 insertions(+), 25 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 5af5cdd6e..6650652c9 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -14,7 +14,8 @@ import os, sys CIMEROOT = os.environ.get("CIMEROOT") if CIMEROOT is None: raise SystemExit("ERROR: must set CIMEROOT environment variable") -sys.path.append(os.path.join(CIMEROOT, "scripts", "Tools")) +_LIBDIR = os.path.join(CIMEROOT, "CIME", "Tools") +sys.path.append(_LIBDIR) # Path for mizuRoute/route/settings for both a mizuRoute standalone checkout as well as a CESM checkout sys.path.append(os.path.join(CIMEROOT, "..", "route", "settings")) sys.path.append(os.path.join(CIMEROOT, "..", "components", "mizuRoute", "route", "settings")) @@ -22,6 +23,7 @@ sys.path.append(os.path.join(CIMEROOT, "..", "components", "mizuRoute", "route", from standard_script_setup import * from CIME.case import Case from CIME.nmlgen import NamelistGenerator +from CIME.XML.files import Files from CIME.utils import expect, safe_copy from CIME.buildnml import create_namelist_infile, parse_input from mizuRoute_control import mizuRoute_control @@ -30,7 +32,7 @@ logger = logging.getLogger(__name__) # pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements #################################################################################### -def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, nmlgen, ctl, data_list_path): +def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, nmlgen, ctl): #################################################################################### """Write out the input configuration file for mizuRoute @@ -180,7 +182,7 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, #---------------------------------------------------- # Initialize namelist defaults #---------------------------------------------------- - nmlgen.init_defaults(infile, config) + nmlgen.init_defaults(infile, config, skip_default_for_groups="data_files",) #---------------------------------------------------- # Check for incompatible options. @@ -202,6 +204,7 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, ctl.set( "input_dir", rundir+"/" ) ctl.set( "ancil_dir", ancil_dir ) ctl.set( "fname_ntopOld", fname_ntopOld ) + nmlgen.set_value( "fname_ntopold", value=os.path.join( ancil_dir, fname_ntopOld ) ) ctl.set( "dt_qsim", str(dt_qsim) ) ctl.set( "dname_sseg", dname_sseg ) ctl.set( "dname_nhru", dname_nhru ) @@ -239,6 +242,8 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, fname_state_in = "empty" ctl.set( "fname_state_in", fname_state_in ) + if fname_state_in is not "empty": + nmlgen.set_value( "fname_state_in", value=os.path.join( ancil_dir, fname_ntopOld ) ) # Read in the user control file for the case and change settings to it file_src = "user_nl_mizuroute_control" @@ -257,17 +262,18 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, #---------------------------------------------------- control_file = os.path.join(confdir, "mizuRoute.control") nml_file = os.path.join(confdir, "mizuRoute_in") - write_nml_in_file(case, nmlgen, confdir, nml_file) + write_nml_in_file(case, nmlgen, confdir, nml_file ) ctl.write( control_file ) ############################################################################### def write_nml_in_file(case, nmlgen, confdir, nml_file): ############################################################################### - data_list_path = os.path.join(case.get_case_root(), "Buildconf", "rof.input_data_list") + data_list_path = os.path.join(case.get_case_root(), "Buildconf", "mizuroute.input_data_list") if os.path.exists(data_list_path): os.remove(data_list_path) + namelist_file = os.path.join(confdir, nml_file) - nmlgen.write_output_file(namelist_file, data_list_path ) + nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=["SLOPE", "IRF_UG", "KWT"]) ############################################################################### def buildnml(case, caseroot, compname): @@ -294,13 +300,6 @@ def buildnml(case, caseroot, compname): ctl = mizuRoute_control() ctl.read( sampleFile ) - #---------------------------------------------------- - # Clear out old data. - #---------------------------------------------------- - data_list_path = os.path.join(case.get_case_root(), "Buildconf", "mizuRoute.input_data_list") - if os.path.exists(data_list_path): - os.remove(data_list_path) - #---------------------------------------------------- # Do some checking #---------------------------------------------------- @@ -322,12 +321,15 @@ def buildnml(case, caseroot, compname): create_namelist_infile(case, user_nl_file, infile) control_infile = [infile] + # NOTE: User definition *replaces* existing definition. + files = Files(comp_interface="nuopc") + # Create the namelist generator object - independent of instance - definition_files = [srcroot + "/cime_config/namelist_definition_mizuRoute.xml"] - nmlgen = NamelistGenerator(case, definition_files) + definition_files = [os.path.join( srcroot, "cime_config/namelist_definition_mizuRoute.xml") ] + nmlgen = NamelistGenerator(case, definition_files, files=files) # create control files - _create_control_files(case, caseroot, srcroot, confdir, inst_string, control_infile, nmlgen, ctl, data_list_path) + _create_control_files(case, caseroot, srcroot, confdir, inst_string, control_infile, nmlgen, ctl) # copy control files to rundir if os.path.isdir(rundir): @@ -343,7 +345,7 @@ def buildnml(case, caseroot, compname): def _main_func(): caseroot = parse_input(sys.argv) - with Case(caseroot) as case: + with Case(case_root=caseroot) as case: buildnml(case, caseroot, "mizuRoute") if __name__ == "__main__": diff --git a/cime_config/namelist_definition_mizuRoute.xml b/cime_config/namelist_definition_mizuRoute.xml index d93cfcfed..25b4bd464 100644 --- a/cime_config/namelist_definition_mizuRoute.xml +++ b/cime_config/namelist_definition_mizuRoute.xml @@ -122,4 +122,27 @@ + + + + + char + datasets + abs + data_files + + River network description file + + + + + char + datasets + abs + data_files + + Initial conditions file + + + diff --git a/cime_config/test/env_case.xml b/cime_config/test/env_case.xml index 352ed9644..df4f44193 100644 --- a/cime_config/test/env_case.xml +++ b/cime_config/test/env_case.xml @@ -13,8 +13,8 @@ char file containing specification of component specific definitions and values(for documentation only - DO NOT EDIT) - $CIMEROOT/config/xml_schemas/entry_id.xsd - $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + $CIMEROOT/CIME/data/config/xml_schemas/entry_id.xsd + $CIMEROOT/CIME/data/config/xml_schemas/entry_id_version3.xsd @@ -22,10 +22,10 @@ Component set long name (for documentation only - DO NOT EDIT) - + char Root directory of the case river runoff model component - $CIMEROOT/config/xml_schemas/config_compsets.xsd + $CIMEROOT/CIME/data/config/xml_schemas/config_compsets.xsd @@ -34,11 +34,20 @@ Name of river component - + char full pathname of source root directory + + char + Machine name + + + char + Machines directory location + + char case name diff --git a/cime_config/test/env_run.xml b/cime_config/test/env_run.xml index 04ca7e8e5..5cc1ee51b 100644 --- a/cime_config/test/env_run.xml +++ b/cime_config/test/env_run.xml @@ -11,7 +11,7 @@ Sample env_run.xml file that allows buildnml to be run for testing in this direc --> - + diff --git a/cime_config/test/runbuildnml b/cime_config/test/runbuildnml index cc72df55d..f5d4542ab 100755 --- a/cime_config/test/runbuildnml +++ b/cime_config/test/runbuildnml @@ -1,9 +1,12 @@ #!/bin/bash -cd ../../cime >& /dev/null +# Run the buildnmal for mizuRoute, assing it's under a CTSM or CESM checkout +cd ../../../../cime >& /dev/null if [ $? != 0 ]; then - cd ../../../../cime + echo "cime directory does not exist where expected" + exit -1 fi export CIMEROOT=`pwd` +echo "CIMEROOT = $CIMEROOT" cd - cp ../user_nl_* . @@ -22,6 +25,8 @@ if [ $? != 0 ] ; then else echo "Cat the results...." cat Buildconf/mizurouteconf/mizuRoute* + echo "input_data_list..." + cat Buildconf/mizuroute.input_data_list fi rm -rf user_* run/* Buildconf/mizurouteconf/* Buildconf/* CaseDocs echo "Successfully ran test" From 9f3e9d63bfdc8fbc76ff7240446c378a21e8bb26 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 3 Jun 2023 01:04:20 -0600 Subject: [PATCH 05/52] Update dataset to one that's actually CDF5 so can save it to it can be imported --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 6650652c9..a271b7b31 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -126,7 +126,7 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, varname_downSegId = "Tosegment" varname_pfafCode = "pfaf" elif ( config['rof_grid'] == "USGS_GFmz" ): - fname_ntopOld = "ntopo_USGS-GFmz_Conus_cdf5_c20201008.nc" + fname_ntopOld = "ntopo_USGS-GFmz_Conus_cdf5_c20230602.nc" varname_area = "Basin_Area" varname_length = "Length" varname_slope = "Slope" From c063cd8fc9301d436980442b438c4ef27f3be352 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 3 Jun 2023 14:56:02 -0600 Subject: [PATCH 06/52] Remove nvhpc on izumi because not available in older ccs_config versions and pgi not on the machine, remove izumi_nag non-DEBUG tests as they don't build in CTSM --- cime_config/testdefs/testlist_mizuRoute.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index a0f0fc009..6505c16f4 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -96,7 +96,9 @@ + @@ -162,8 +164,6 @@ - - From bdf4d463b204e4b4c604d2180098d9711383188f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 3 Jun 2023 15:07:01 -0600 Subject: [PATCH 07/52] Correct names of namelists, make sure order is correct --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index a271b7b31..1b09150ef 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -273,7 +273,7 @@ def write_nml_in_file(case, nmlgen, confdir, nml_file): os.remove(data_list_path) namelist_file = os.path.join(confdir, nml_file) - nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=["SLOPE", "IRF_UG", "KWT"]) + nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=["HSLOPE", "IRF_UH", "KWT"]) ############################################################################### def buildnml(case, caseroot, compname): From 4addd321b2e06360e41ab0b4c03be157815e622d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 4 Jun 2023 15:00:15 -0600 Subject: [PATCH 08/52] Do not do the swap if the index is the same -- fixing #397 --- route/build/src/nr_utils.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/route/build/src/nr_utils.f90 b/route/build/src/nr_utils.f90 index 5d33dda48..203c4ab87 100644 --- a/route/build/src/nr_utils.f90 +++ b/route/build/src/nr_utils.f90 @@ -108,7 +108,7 @@ SUBROUTINE indexx(arr,index) jstack=jstack-2 else k=(l+r)/2 - call swap(index(k),index(l+1)) + if ( k /= l+1 ) call swap(index(k),index(l+1)) call icomp_xchg(index(l),index(r)) call icomp_xchg(index(l+1),index(r)) call icomp_xchg(index(l),index(l+1)) @@ -126,7 +126,7 @@ SUBROUTINE indexx(arr,index) if (arr(index(j)) <= a) exit end do if (j < i) exit - call swap(index(i),index(j)) + if ( i /= j ) call swap(index(i),index(j)) end do index(l+1)=index(j) index(j)=indext From a4f8badd40194e717c934174291c35278c72b67f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 4 Jun 2023 22:22:44 -0600 Subject: [PATCH 09/52] Comment out freeDecomp calls when files are closed this allows the code to run fixing #399, also make sure FileStatus is explicitly initialized to FALSE, and use fileOpen method explicitly in historyFile.f90 --- route/build/src/historyFile.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/route/build/src/historyFile.f90 b/route/build/src/historyFile.f90 index 0a6da0422..c9b567368 100644 --- a/route/build/src/historyFile.f90 +++ b/route/build/src/historyFile.f90 @@ -79,6 +79,7 @@ FUNCTION constructor(fname, pioSys, gageOutput) RESULT(instHistFile) type(iosystem_desc_t), optional, intent(in) :: pioSys instHistFile%fname = fname + instHistFile%fileStatus = .false. if (present(gageOutput)) then instHistFile%gageOutput = gageOutput @@ -374,7 +375,7 @@ SUBROUTINE closeNC(this) implicit none class(histFile), intent(inout) :: this - if (this%fileStatus) then + if (this%fileOpen() ) then call closeFile(this%pioFileDesc, this%fileStatus) endif END SUBROUTINE closeNC @@ -403,7 +404,7 @@ SUBROUTINE cleanup_hru(this) implicit none class(histFile), intent(inout) :: this - call freeDecomp(this%pioFileDesc, this%ioDescHruFlux) + !call freeDecomp(this%pioFileDesc, this%ioDescHruFlux) END SUBROUTINE cleanup_hru @@ -414,7 +415,7 @@ SUBROUTINE cleanup_rch(this) implicit none class(histFile), intent(inout) :: this - call freeDecomp(this%pioFileDesc, this%ioDescRchFlux) + !call freeDecomp(this%pioFileDesc, this%ioDescRchFlux) END SUBROUTINE cleanup_rch From 90b6c136f750e42b06614ce944fa406df0fd4174 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 6 Jun 2023 11:52:16 -0600 Subject: [PATCH 10/52] Remove the freeDecomp calls for restart, this allows it to run, but it might have a memory leak --- route/build/src/write_restart_pio.f90 | 52 +++++++++++++-------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index 84323aee4..ab5bef7f2 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -974,32 +974,32 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif ! clean decomposition data - call freeDecomp(pioFileDescState, iodesc_rch_double) - call freeDecomp(pioFileDescState, iodesc_rch_int) - call freeDecomp(pioFileDescState, iodesc_hist_rch_double) - if (meta_hflx(ixHFLX%basRunoff)%varFile) then - call freeDecomp(pioFileDescState, iodesc_hist_hru_double) - end if - if (doesBasinRoute==1) then - call freeDecomp(pioFileDescState, iodesc_irf_bas_double) - end if - if (onRoute(impulseResponseFunc))then - call freeDecomp(pioFileDescState, iodesc_irf_double) - call freeDecomp(pioFileDescState, iodesc_vol_double) - end if - if (onRoute(kinematicWaveTracking)) then - call freeDecomp(pioFileDescState, iodesc_wave_int) - call freeDecomp(pioFileDescState, iodesc_wave_double) - end if - if (onRoute(kinematicWave)) then - call freeDecomp(pioFileDescState, iodesc_mesh_kw_double) - end if - if (onRoute(muskingumCunge)) then - call freeDecomp(pioFileDescState, iodesc_mesh_mc_double) - end if - if (onRoute(diffusiveWave)) then - call freeDecomp(pioFileDescState, iodesc_mesh_dw_double) - end if + !call freeDecomp(pioFileDescState, iodesc_rch_double) + !call freeDecomp(pioFileDescState, iodesc_rch_int) + !call freeDecomp(pioFileDescState, iodesc_hist_rch_double) + !if (meta_hflx(ixHFLX%basRunoff)%varFile) then + !call freeDecomp(pioFileDescState, iodesc_hist_hru_double) + !end if + !if (doesBasinRoute==1) then + !call freeDecomp(pioFileDescState, iodesc_irf_bas_double) + !end if + !if (onRoute(impulseResponseFunc))then + !call freeDecomp(pioFileDescState, iodesc_irf_double) + !call freeDecomp(pioFileDescState, iodesc_vol_double) + !end if + !if (onRoute(kinematicWaveTracking)) then + !call freeDecomp(pioFileDescState, iodesc_wave_int) + !call freeDecomp(pioFileDescState, iodesc_wave_double) + !end if + !if (onRoute(kinematicWave)) then + !call freeDecomp(pioFileDescState, iodesc_mesh_kw_double) + !end if + !if (onRoute(muskingumCunge)) then + !call freeDecomp(pioFileDescState, iodesc_mesh_mc_double) + !end if + !if (onRoute(diffusiveWave)) then + !call freeDecomp(pioFileDescState, iodesc_mesh_dw_double) + !end if ! close netCDF call closeFile(pioFileDescState, restartOpen) From e73a99d209009c8ddadead508c40f66b94125834 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 6 Jun 2023 12:17:52 -0600 Subject: [PATCH 11/52] Turn mpi-serial on for 1 MPI task tests --- cime_config/testdefs/testlist_mizuRoute.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index 6505c16f4..0801f1bc4 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -115,7 +115,7 @@ - + @@ -124,7 +124,7 @@ - + @@ -135,7 +135,7 @@ - + From f032e37f3dcb9d070878c5d690fc903ea2f55316 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 21 Jun 2023 13:40:15 -0600 Subject: [PATCH 12/52] Fix typo --- cime_config/testdefs/testlist_mizuRoute.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index 0801f1bc4..337beedbf 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -8,7 +8,7 @@ - + From ae9af5a829dd5b5b35c146c26937dfad4df71a37 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 21 Jun 2023 13:41:36 -0600 Subject: [PATCH 13/52] Do cleanup after closing the file --- route/build/src/write_simoutput_pio.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/route/build/src/write_simoutput_pio.f90 b/route/build/src/write_simoutput_pio.f90 index 9d9695233..3c8c0909b 100644 --- a/route/build/src/write_simoutput_pio.f90 +++ b/route/build/src/write_simoutput_pio.f90 @@ -453,12 +453,12 @@ END SUBROUTINE get_hfilename SUBROUTINE close_all() implicit none if (hist_all_network%fileOpen()) then - call hist_all_network%cleanup() call hist_all_network%closeNC() + call hist_all_network%cleanup() end if if (hist_gage%fileOpen()) then - call hist_gage%cleanup() call hist_gage%closeNC() + call hist_gage%cleanup() end if END SUBROUTINE From a0c5e24546d985bdff1192fe481e817754a3ba33 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 22 Jun 2023 16:39:19 -0600 Subject: [PATCH 14/52] Change MODEL to COMP_NAME fixing #259 --- cime_config/buildlib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index c8670e0aa..459106d26 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -56,7 +56,7 @@ def _main_func(): complib = os.path.join(libroot,"librof.a") makefile = os.path.join(casetools, "Makefile") - cmd = "{} complib -j {} MODEL=mizuRoute COMPLIB={} -f {} {}" \ + cmd = "{} complib -j {} COMP_NAME=mizuRoute COMPLIB={} -f {} {}" \ .format(gmake, gmake_j, complib, makefile, get_standard_makefile_args(case)) rc, out, err = run_cmd(cmd) From 6633269b4d151173680bd56e699dd0edb25d8131 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 25 Jun 2023 18:39:01 -0600 Subject: [PATCH 15/52] Fix #404, receive buffer needs to be different from send buffer --- route/build/src/mpi_process.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/route/build/src/mpi_process.f90 b/route/build/src/mpi_process.f90 index fa4af1473..8a453c135 100644 --- a/route/build/src/mpi_process.f90 +++ b/route/build/src/mpi_process.f90 @@ -2883,6 +2883,8 @@ SUBROUTINE pass_global_data(comm, ierr, message) ! output: error control integer(i4b), intent(out) :: ierr character(len=strLen), intent(out) :: message ! error message + integer(i4b) :: receivemax ! Receive buffer for MAX over all tasks + ierr=0; message='pass_global_data/' ! send scalars @@ -2892,7 +2894,8 @@ SUBROUTINE pass_global_data(comm, ierr, message) ! output: error control call MPI_BCAST(calendar, strLen, MPI_CHARACTER, root, comm, ierr) call MPI_BCAST(time_units,strLen, MPI_CHARACTER, root, comm, ierr) - CALL MPI_ALLREDUCE(maxtdh, maxtdh, 1, MPI_INTEGER, MPI_MAX, comm, ierr) + CALL MPI_ALLREDUCE(maxtdh, receivemax, 1, MPI_INTEGER, MPI_MAX, comm, ierr) + maxtdh = receivemax END SUBROUTINE pass_global_data From 657221af44f2f150048f5ae4d92cad2204bdf2e4 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 25 Jun 2023 18:41:35 -0600 Subject: [PATCH 16/52] Add debug log output level to default coupled-control file --- route/settings/SAMPLE-coupled.control | 1 + 1 file changed, 1 insertion(+) diff --git a/route/settings/SAMPLE-coupled.control b/route/settings/SAMPLE-coupled.control index 2a753bcde..968fab677 100644 --- a/route/settings/SAMPLE-coupled.control +++ b/route/settings/SAMPLE-coupled.control @@ -21,6 +21,7 @@ monthly ! time frequency used for temporal aggregation of output variables - numeric or daily, monthyly, or yearly 86400 ! coupling time interval of the forcing [sec] F ! logical; T-> append output in existing history files. F-> write output in new history file + F ! debug verbosity level; T -> extra log output. F-> normal log output ! **************************************************************************************************************************** ! DEFINE DIRECTORIES ! -------------------------- From 79638d622172dd23f3dc302d24ed3aced3339e76 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 25 Jun 2023 23:22:43 -0600 Subject: [PATCH 17/52] Replace shr_sys_flush statements with FORTRAN-2003 flush keyword --- route/build/src/mpi_utils.f90 | 3 +-- route/build/src/water_balance.f90 | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/route/build/src/mpi_utils.f90 b/route/build/src/mpi_utils.f90 index f89def15a..43c24ceed 100644 --- a/route/build/src/mpi_utils.f90 +++ b/route/build/src/mpi_utils.f90 @@ -9,7 +9,6 @@ MODULE mpi_utils USE globalData, ONLY: masterproc USE public_var, ONLY: root USE public_var, ONLY: iulog - USE shr_sys_mod, ONLY: shr_sys_flush implicit none @@ -1014,7 +1013,7 @@ SUBROUTINE mpi_handle_err(ierr,pid) ! finalize MPI call MPI_FINALIZE(jerr) - call shr_sys_flush(6) + flush(6) stop endif diff --git a/route/build/src/water_balance.f90 b/route/build/src/water_balance.f90 index 644a2718e..cfe7cf918 100644 --- a/route/build/src/water_balance.f90 +++ b/route/build/src/water_balance.f90 @@ -7,7 +7,6 @@ MODULE water_balance ! global parameters USE public_var, ONLY: iulog ! i/o logical unit number USE public_var, ONLY: dt ! simulation time step -USE shr_sys_mod, ONLY: shr_sys_flush implicit none @@ -201,7 +200,7 @@ SUBROUTINE comp_global_wb(ixRoute, verbose, ierr, message) if (abs(wb_error) > 1._dp) then ! tolerance is 1 [m3] write(iulog,'(A,1PG15.7,1X,A)') ' WARNING: global WB error [m3] = ', wb_error, '> 1.0 [m3]' end if - call shr_sys_flush(iulog) + flush(iulog) CONTAINS From 1b196e0cd126e7f14003fcf4d76559a966ace842 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 25 Jun 2023 23:42:00 -0600 Subject: [PATCH 18/52] Remove the shr_sys_system statement to remove the old file, and make sure the create on the file clobbers the previous one, by using a bitwise OR of clobber and file format --- route/build/src/init_model_data.f90 | 4 ---- route/build/src/write_streamSeg.f90 | 3 ++- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/route/build/src/init_model_data.f90 b/route/build/src/init_model_data.f90 index 565c8494f..3ff9e0513 100644 --- a/route/build/src/init_model_data.f90 +++ b/route/build/src/init_model_data.f90 @@ -490,7 +490,6 @@ SUBROUTINE init_ntopo(nHRU_out, nRch_out, USE process_ntopo, ONLY: check_river_properties ! check if river network data is physically valid USE ncio_utils, ONLY: get_var_dims USE process_ntopo, ONLY: augment_ntopo ! compute all the additional network topology (only compute option = on) - USE shr_sys_mod, ONLY: shr_sys_system implicit none ! Argument variables @@ -577,9 +576,6 @@ SUBROUTINE init_ntopo(nHRU_out, nRch_out, ! --> users can modify the hard-coded parameter "maxUpstreamFile" if desired if(tot_upstream > maxUpstreamFile) tot_upstream=0 - call shr_sys_system('rm -f '//trim(ancil_dir)//trim(fname_ntopNew), ierr) - if(ierr/=0)then; message=trim(message)//trim("Error in system call to remove fil"); return; endif - call writeData(& ! input trim(ancil_dir)//trim(fname_ntopNew), & ! input: file name diff --git a/route/build/src/write_streamSeg.f90 b/route/build/src/write_streamSeg.f90 index 0eae9097c..b8908a761 100644 --- a/route/build/src/write_streamSeg.f90 +++ b/route/build/src/write_streamSeg.f90 @@ -180,7 +180,8 @@ subroutine createFile(fname, dimCheck, ierr,message) ! ---------- create file ---------------------------------------------------------------------------------------- ! create file - ierr = nf90_create(trim(fname), NF90_64BIT_OFFSET, ncid) + ! Clobber an existing file if it exists, and output in 64Bit offset format + ierr = nf90_create(trim(fname), (NF90_CLOBBER .or. NF90_64BIT_OFFSET), ncid) if(ierr/=0)then; message=trim(message)//trim(nf90_strerror(ierr)); return; endif ! ---------- define dimensions ---------------------------------------------------------------------------------- From 4abacaf8e2a0129493850970571071919561cd74 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 25 Jun 2023 23:50:50 -0600 Subject: [PATCH 19/52] GNU compiler requires the IOR intrinsic to be used as a function --- route/build/src/write_streamSeg.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/route/build/src/write_streamSeg.f90 b/route/build/src/write_streamSeg.f90 index b8908a761..8325036bc 100644 --- a/route/build/src/write_streamSeg.f90 +++ b/route/build/src/write_streamSeg.f90 @@ -181,7 +181,7 @@ subroutine createFile(fname, dimCheck, ierr,message) ! create file ! Clobber an existing file if it exists, and output in 64Bit offset format - ierr = nf90_create(trim(fname), (NF90_CLOBBER .or. NF90_64BIT_OFFSET), ncid) + ierr = nf90_create(trim(fname), IOR(NF90_CLOBBER, NF90_64BIT_OFFSET), ncid) if(ierr/=0)then; message=trim(message)//trim(nf90_strerror(ierr)); return; endif ! ---------- define dimensions ---------------------------------------------------------------------------------- From 713acd6fc4b99ef89ed677e38a0bbbec645c8683 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 26 Jun 2023 12:10:48 -0600 Subject: [PATCH 20/52] Comment out the isnan check as not really needed, to get this to work everyone the shr_infnan version would need to be used and the standalone build updated to build it --- route/build/src/mc_route.f90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/route/build/src/mc_route.f90 b/route/build/src/mc_route.f90 index 9579b060b..b37bd9033 100644 --- a/route/build/src/mc_route.f90 +++ b/route/build/src/mc_route.f90 @@ -250,7 +250,10 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct ! (time:0:1, loc:0:1) 0-previous time step/inlet, 1-current time step/outlet. ! Q or A(1,2,3,4): 1: (t=0,x=0), 2: (t=0,x=1), 3: (t=1,x=0), 4: (t=1,x=1) - use shr_infnan_mod, only : isnan => shr_infnan_isnan + ! -- EBK 06/26/2023 -- comment out isnan check, doesn't seem to be needed + ! Use of shr_infnan_isnan will require changes to the standalone build, and + ! this version is required to work on all compilers. + !use shr_infnan_mod, only : isnan => shr_infnan_isnan implicit none ! Argument variables type(RCHPRP), intent(in) :: rch_param ! River reach parameter @@ -370,9 +373,10 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct QoutLocal(ix) = C0* QinLocal(ix)+ C1* QinLocal(ix-1)+ C2* QoutLocal(ix-1) QoutLocal(ix) = max(0.0, QoutLocal(ix)) - if (isnan(QoutLocal(ix))) then - ierr=10; message=trim(message)//'QoutLocal is Nan; activate vodose for this segment for diagnosis';return - end if + ! -- EBK 06/26/2023 -- comment out isnan check, doesn't seem to be needed. + !if (isnan(QoutLocal(ix))) then + ! ierr=10; message=trim(message)//'QoutLocal is Nan; activate vodose for this segment for diagnosis';return + !end if if (verbose) then write(iulog,'(A,I3,1X,A,G12.5,1X,A,G12.5)') ' sub time-step= ',ix,'Courant number= ',Cn, 'Q= ',QoutLocal(ix) From 3d5c4c771437f876ce2e5c4221bfc7380e9068ac Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 26 Jun 2023 13:28:32 -0600 Subject: [PATCH 21/52] Fix some spelling errors, and make sure higher resolution tests on izumi are with DEBUG off, and Small pe-layout --- cime_config/testdefs/testlist_mizuRoute.xml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index 337beedbf..b5f199bee 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -3,7 +3,7 @@ - + @@ -13,10 +13,10 @@ - + - + @@ -157,7 +157,7 @@ - + @@ -189,7 +189,7 @@ - + @@ -212,7 +212,7 @@ - + @@ -223,7 +223,7 @@ - + From f5d547fc21da363b26e4a482943f3ee4e143b4f6 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 26 Jun 2023 16:40:42 -0600 Subject: [PATCH 22/52] Remove the higher resolution grids from izumi testing --- cime_config/testdefs/testlist_mizuRoute.xml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index b5f199bee..67f5562a8 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -162,8 +162,6 @@ - - @@ -193,7 +191,6 @@ - @@ -216,7 +213,6 @@ - @@ -228,8 +224,6 @@ - - From 66ae3c5b661bc965c4b4083dcf452388f58aa84f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 26 Jun 2023 17:15:03 -0600 Subject: [PATCH 23/52] Add expected fail for the izumi serial ERS test --- cime_config/testdefs/ExpectedTestFails.xml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 63e219615..15cd54237 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -48,6 +48,12 @@ #390 + + + FAIL + #390 + + FAIL From 17e8a7ee0c3757a0484630063cb6a532f3c27e06 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 26 Jun 2023 21:10:03 -0600 Subject: [PATCH 24/52] The ERI test is working now --- cime_config/testdefs/ExpectedTestFails.xml | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 15cd54237..333570da6 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -54,15 +54,5 @@ #390 - - - FAIL - #388 - - - FAIL - #388 - - From 84fe6a16780014f3632211b364a353ac938ed9a3 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 5 Jul 2023 14:34:07 -0600 Subject: [PATCH 25/52] Add h_gauge files to history archive --- cime_config/config_archive.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index 39974b3df..bd33d9c76 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -2,6 +2,7 @@ r h.*\.nc$ + h_gauge.*\.nc$ unset rpointer.rof From dc4e282a3e22a2932a672db28ea489e8de48a169 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 5 Jul 2023 14:36:18 -0600 Subject: [PATCH 26/52] Add ERS test for 5x5_amazon_r05 test case so it's similar to the ERP test --- cime_config/testdefs/testlist_mizuRoute.xml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index 67f5562a8..78c7d3153 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -115,6 +115,15 @@ + + + + + + + + + From a1345d1381643f3c2dc6c3406b1b5fa5e1c2dd41 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 5 Jul 2023 17:50:40 -0600 Subject: [PATCH 27/52] Add history filenames variable name to add to restart file --- cime_config/config_archive.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index bd33d9c76..7d6d3f213 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -3,7 +3,7 @@ r h.*\.nc$ h_gauge.*\.nc$ - unset + restart_history_filenames rpointer.rof ./$CASE.mizuroute.r.$DATENAME.nc From 351fecdd039e220a0addcf077a2a478274cfc465 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Jul 2023 14:10:51 -0600 Subject: [PATCH 28/52] Start adding writing of history files to restart file, something still not right though, not working --- route/build/src/pio_utils.f90 | 40 +++++++++++++++++++++++++++ route/build/src/popMetadat.f90 | 2 ++ route/build/src/var_lookup.f90 | 4 ++- route/build/src/write_restart_pio.f90 | 35 +++++++++++++++++++---- 4 files changed, 74 insertions(+), 7 deletions(-) diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 062122bb6..762847a7b 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -3,6 +3,7 @@ MODULE pio_utils USE mpi USE nrtype USE pio + USE public_var, only : iulog implicit none @@ -52,6 +53,7 @@ MODULE pio_utils END INTERFACE INTERFACE write_netcdf + module procedure write_char1D module procedure write_array1D module procedure write_array2D END INTERFACE @@ -656,6 +658,44 @@ SUBROUTINE write_scalar_netcdf(pioFileDesc, & END SUBROUTINE write_scalar_netcdf + ! --------------------------------------------------------------- + ! write global character vector into 1D variable + SUBROUTINE write_char1D(pioFileDesc, & + vname, & ! input: variable name + length, & ! Input: length of strings + array, & ! input: variable data + iStart, & ! input: start index + iCount, & ! input: length of vector + ierr, message) ! output: error control + implicit none + ! Argument variables: + type(file_desc_t), intent(inout) :: pioFileDesc ! pio file handle + character(len=*), intent(in) :: vname ! variable name + integer(i4b), intent(in) :: length ! length of strings + character(len=*), intent(in) :: array(:) ! variable data + integer(i4b), intent(in) :: iStart(:) ! start index + integer(i4b), intent(in) :: iCount(:) ! length of vector + integer(i4b), intent(out) :: ierr + character(*), intent(out) :: message ! error message + ! local variables + type(var_desc_t) :: pioVarId + + ierr=0; message='write_char1D/' + + if ( any(len_trim(array(:)) > length) )then + ierr = -100 + message=trim(message)//'ERROR: string length is greater than allowed size' + return + end if + ierr = pio_inq_varid(pioFileDesc, trim(vname), pioVarId) + if(ierr/=0)then; message=trim(message)//'ERROR: getting variable id'; return; endif + + ierr = pio_put_var(pioFileDesc, pioVarId, iStart, iCount, array) + if(ierr/=pio_noerr)then; message=trim(message)//'cannot write data'; return; endif + + END SUBROUTINE write_char1D + + ! --------------------------------------------------------------- ! write global integer vector into 1D variable SUBROUTINE write_array1D(pioFileDesc, & diff --git a/route/build/src/popMetadat.f90 b/route/build/src/popMetadat.f90 index ba4f65317..099b73294 100644 --- a/route/build/src/popMetadat.f90 +++ b/route/build/src/popMetadat.f90 @@ -104,6 +104,8 @@ subroutine popMetadat(err,message) meta_stateDims(ixStateDims%mol_dw ) = dim_info('mol_dw', integerMissing, integerMissing) ! dw finite difference computing nodes meta_stateDims(ixStateDims%tdh_irf ) = dim_info('tdh_irf', integerMissing, integerMissing) ! future time steps for irf routing meta_stateDims(ixStateDims%tdh ) = dim_info('tdh', integerMissing, integerMissing) ! future time steps for bsasin irf routing + meta_stateDims(ixStateDims%nchars ) = dim_info('nchars', integerMissing, 300) ! number of characters for strings + meta_stateDims(ixStateDims%hist_fil) = dim_info('hist_fil',integerMissing, integerMissing) ! number of history files on restart file meta_qDims(ixQdims%time ) = dim_info('time', integerMissing, integerMissing) ! time meta_qDims(ixQdims%tbound ) = dim_info('tbound', integerMissing, 2) ! time bound (always 2 - start and end) diff --git a/route/build/src/var_lookup.f90 b/route/build/src/var_lookup.f90 index 435068bf6..62944a5ef 100644 --- a/route/build/src/var_lookup.f90 +++ b/route/build/src/var_lookup.f90 @@ -46,6 +46,8 @@ MODULE var_lookup integer(i4b) :: mol_dw = integerMissing ! 9. kw finite difference computational molecule integer(i4b) :: tdh_irf = integerMissing ! 10. irf routed future channel flow in a segment integer(i4b) :: tdh = integerMissing ! 11. uh routed future overland flow + integer(i4b) :: nchars = integerMissing ! 12. number of characters + integer(i4b) :: hist_fil = integerMissing ! 13. history filenames endtype iLook_stateDims ! For river discharge variables type, public :: iLook_qDims @@ -263,7 +265,7 @@ MODULE var_lookup type(iLook_struct) ,public,parameter :: ixStruct = iLook_struct ( 1, 2, 3, 4, 5) type(iLook_dims) ,public,parameter :: ixDims = iLook_dims ( 1, 2, 3, 4, 5, 6, 7) type(iLook_stateDims),public,parameter :: ixStateDims = iLook_stateDims( 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & - 11) + 11, 12, 13) type(iLook_qDims) ,public,parameter :: ixQdims = iLook_qDims ( 1, 2, 3, 4, 5) type(iLook_HRU) ,public,parameter :: ixHRU = iLook_HRU ( 1) type(iLook_HRU2SEG) ,public,parameter :: ixHRU2SEG = iLook_HRU2SEG ( 1, 2, 3, 4) diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index d6a27f668..5792ccf4b 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -274,14 +274,16 @@ SUBROUTINE define_state_nc(fname, & ! input: filename integer(i4b), allocatable :: compdof_rch(:) ! integer(i4b), allocatable :: compdof_hru(:) ! integer(i4b) :: jDim ! loop index for dimension - integer(i4b) :: ixDim_common(4) ! custom dimension ID array + integer(i4b) :: ixDim_common(6) ! custom dimension ID array character(len=strLen) :: cmessage ! error message of downwind routine ierr=0; message='define_state_nc/' - associate(dim_seg => meta_stateDims(ixStateDims%seg)%dimId, & - dim_ens => meta_stateDims(ixStateDims%ens)%dimId, & - dim_tbound => meta_stateDims(ixStateDims%tbound)%dimId) + associate(dim_seg => meta_stateDims(ixStateDims%seg)%dimId, & + dim_ens => meta_stateDims(ixStateDims%ens)%dimId, & + dim_tbound => meta_stateDims(ixStateDims%tbound)%dimId, & + dim_nchars => meta_stateDims(ixStateDims%nchars)%dimId, & + dim_hist_fil => meta_stateDims(ixStateDims%hist_fil)%dimId) ! ---------------------------------- ! Create file @@ -290,7 +292,7 @@ SUBROUTINE define_state_nc(fname, & ! input: filename if(ierr/=0)then; message=trim(cmessage)//'cannot create state netCDF'; return; endif ! For common dimension/variables - seg id, time, time-bound ----------- - ixDim_common = [ixStateDims%seg, ixStateDims%hru, ixStateDims%ens, ixStateDims%tbound] + ixDim_common = [ixStateDims%seg, ixStateDims%hru, ixStateDims%ens, ixStateDims%tbound, ixStateDims%nchars, ixStateDims%hist_fil] ! ---------------------------------- ! Define dimensions @@ -326,6 +328,9 @@ SUBROUTINE define_state_nc(fname, & ! input: filename call def_var(pioFileDescState, 'time_bound', ncd_float, ierr, cmessage, pioDimId=[dim_tbound], vdesc='time bound at last time step', vunit='sec') if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif + call def_var(pioFileDescState, 'hist_fil', ncd_char, ierr, cmessage, pioDimId=[dim_nchars, dim_hist_fil], vdesc='history files that need to be read with this restart file', vunit='-') + if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif + end associate ! previous-time step hru inflow into reach @@ -492,7 +497,7 @@ SUBROUTINE define_state_nc(fname, & ! input: filename SUBROUTINE set_dim_len(ixDim, ierr, message1) ! populate state netCDF dimension size - USE public_var, ONLY: MAXQPAR + USE public_var, ONLY: MAXQPAR, outputAtGage USE globalData, ONLY: nMolecule USE globalData, ONLY: maxtdh ! maximum unit-hydrogrph future time USE globalData, ONLY: FRAC_FUTURE ! To get size of q future for basin IRF @@ -517,6 +522,12 @@ SUBROUTINE set_dim_len(ixDim, ierr, message1) case(ixStateDims%mol_mc); meta_stateDims(ixStateDims%mol_mc)%dimLength = nMolecule%MC_ROUTE case(ixStateDims%mol_dw); meta_stateDims(ixStateDims%mol_dw)%dimLength = nMolecule%DW_ROUTE case(ixStateDims%wave); meta_stateDims(ixStateDims%wave)%dimLength = MAXQPAR + case(ixStateDims%hist_fil) + if (outputAtGage) then + meta_stateDims(ixStateDims%hist_fil)%dimLength = 2 + else + meta_stateDims(ixStateDims%hist_fil)%dimLength = 1 + end if case default; ierr=20; message1=trim(message1)//'unable to identify dimension variable index'; return end select @@ -841,6 +852,7 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name USE public_var, ONLY: kinematicWave USE public_var, ONLY: muskingumCunge USE public_var, ONLY: diffusiveWave + USE public_var, ONLY: outputAtGage USE globalData, ONLY: onRoute ! logical to indicate which routing method(s) is on USE globalData, ONLY: RCHFLX_trib ! tributary reach fluxes (ensembles, reaches) USE globalData, ONLY: NETOPO_main ! mainstem reach topology @@ -850,6 +862,8 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name USE globalData, ONLY: nRch_mainstem ! number of mainstem reaches USE globalData, ONLY: nTribOutlet ! USE globalData, ONLY: reachID ! reach ID in network + USE globalData, ONLY: hfileOut ! Output history file + USE globalData, ONLY: hfileOut_gage ! Output history file for gaguges USE globalData, ONLY: nNodes ! number of MPI tasks USE globalData, ONLY: nRch ! number of reaches in network USE globalData, ONLY: TSEC ! beginning/ending of simulation time step [sec] @@ -923,6 +937,15 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name call write_netcdf(pioFileDescState, 'time_bound', TSEC, [1], [2], ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif + if ( outputAtGage )then + call write_netcdf(pioFileDescState, 'hist_fil', length=300, array=[ hfileOut, hfileOut_gage ], & + iStart=[1], iCount=[2], ierr=ierr, message=cmessage) + else + call write_netcdf(pioFileDescState, 'hist_fil', length=300, array=[ hfileOut ], & + iStart=[1], iCount=[1], ierr=ierr, message=cmessage) + end if + if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif + call write_basinQ_state(ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif From 947cfc26ac4d2b181a282dd41fdd61c403c87c48 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Jul 2023 14:11:28 -0600 Subject: [PATCH 29/52] Update name of the history filenames on the restart file --- cime_config/config_archive.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index 7d6d3f213..fcbf7f659 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -3,7 +3,7 @@ r h.*\.nc$ h_gauge.*\.nc$ - restart_history_filenames + hist_fil rpointer.rof ./$CASE.mizuroute.r.$DATENAME.nc From 52f235f7cc88a6a432eca060a95e231d41cdce2d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 8 Jul 2023 01:16:23 -0600 Subject: [PATCH 30/52] Get writing of history filenames to restart file working correctly --- route/build/src/pio_utils.f90 | 49 +++++++++++++++++++++++++++ route/build/src/write_restart_pio.f90 | 10 +++--- 2 files changed, 54 insertions(+), 5 deletions(-) diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 762847a7b..59f8c0227 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -53,6 +53,7 @@ MODULE pio_utils END INTERFACE INTERFACE write_netcdf + module procedure write_char0D module procedure write_char1D module procedure write_array1D module procedure write_array2D @@ -658,6 +659,54 @@ SUBROUTINE write_scalar_netcdf(pioFileDesc, & END SUBROUTINE write_scalar_netcdf + ! --------------------------------------------------------------- + ! write global character vector into 1D variable + SUBROUTINE write_char0D(pioFileDesc, & + vname, & ! input: variable name + string, & ! input: variable data + iStart, & ! input: start index + ierr, message) ! output: error control + implicit none + ! Argument variables: + type(file_desc_t), intent(inout) :: pioFileDesc ! pio file handle + character(len=*), intent(in) :: vname ! variable name + character(len=*), intent(in) :: string ! variable data + integer(i4b), intent(in) :: iStart ! start index + integer(i4b), intent(out) :: ierr + character(*), intent(out) :: message ! error message + ! local variables + type(var_desc_t) :: pioVarId + integer(i4b) :: m ! Index + integer(i4b) :: var_id + integer(i4b) :: start(2) + integer(i4b) :: icount(2) + character(len=1) :: tmpString(300) ! temp for manipulating output string + + ierr=0; message='write_char0D/' + + if ( len(string) > size(tmpString) )then + ierr = 1 + message=trim(message)//'ERROR: length of string being written is larger than tmpString' + return + end if + ierr = pio_inq_varid(pioFileDesc, trim(vname), pioVarId) + if(ierr/=0)then; message=trim(message)//'ERROR: getting variable id'; return; endif + + + do m = 1,len(string) + tmpString(m:m) = string(m:m) + end do + start(1) = iStart + start(2) = 1 + icount(1) = len(string) + icount(2) = 1 + var_id = pioVarId%varid + ierr = pio_put_var(pioFileDesc, var_id, start, icount, ival=tmpString) + if(ierr/=pio_noerr)then; message=trim(message)//'cannot write data'; return; endif + + END SUBROUTINE write_char0D + + ! --------------------------------------------------------------- ! write global character vector into 1D variable SUBROUTINE write_char1D(pioFileDesc, & diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index 5792ccf4b..a1220c56f 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -937,12 +937,12 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name call write_netcdf(pioFileDescState, 'time_bound', TSEC, [1], [2], ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif + call write_netcdf(pioFileDescState, 'hist_fil', hfileOut, & + iStart=1, ierr=ierr, message=cmessage) + if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif if ( outputAtGage )then - call write_netcdf(pioFileDescState, 'hist_fil', length=300, array=[ hfileOut, hfileOut_gage ], & - iStart=[1], iCount=[2], ierr=ierr, message=cmessage) - else - call write_netcdf(pioFileDescState, 'hist_fil', length=300, array=[ hfileOut ], & - iStart=[1], iCount=[1], ierr=ierr, message=cmessage) + call write_netcdf(pioFileDescState, 'hist_fil', hfileOut_gage, & + iStart=2, ierr=ierr, message=cmessage) end if if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif From 8949241904576d91b7873fef00eef77212f0638b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 8 Jul 2023 01:20:25 -0600 Subject: [PATCH 31/52] Change size of history filenames from 300 to 199 as that is what is being done in CTSM --- route/build/src/globalData.f90 | 6 +++--- route/build/src/historyFile.f90 | 2 +- route/build/src/pio_utils.f90 | 2 +- route/build/src/popMetadat.f90 | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/route/build/src/globalData.f90 b/route/build/src/globalData.f90 index 6123f530e..7fd247a55 100644 --- a/route/build/src/globalData.f90 +++ b/route/build/src/globalData.f90 @@ -116,9 +116,9 @@ MODULE globalData integer(i4b), public :: nEns=1 ! number of ensemble integer(i4b), public :: maxtdh ! maximum unit-hydrograph future time steps type(cMolecule), public :: nMolecule ! number of computational molecule (used for KW, MC, DW) - character(300), public :: hfileout=charMissing ! history output file name - character(300), public :: hfileout_gage=charMissing ! gage-only history output file name - character(300), public :: rfileout=charMissing ! restart output file name + character(199), public :: hfileout=charMissing ! history output file name + character(199), public :: hfileout_gage=charMissing ! gage-only history output file name + character(199), public :: rfileout=charMissing ! restart output file name logical(lgt), public :: initHvars=.false. ! status of history variable data initialization logical(lgt), public :: isColdStart=.true. ! initial river state - cold start (T) or from restart file (F) diff --git a/route/build/src/historyFile.f90 b/route/build/src/historyFile.f90 index 3f4667b4b..f555c8a79 100644 --- a/route/build/src/historyFile.f90 +++ b/route/build/src/historyFile.f90 @@ -30,7 +30,7 @@ MODULE historyFile type :: histFile private - character(300) :: fname ! netCDF name + character(199) :: fname ! netCDF name integer(i4b) :: iTime=0 ! time step in output netCDF logical(lgt) :: fileStatus=.false. ! flag to indicate history output netcdf is open logical(lgt) :: gageOutput=.false. ! flag to indicate this is at-gage-only output (== output subset of reaches) diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 59f8c0227..82b331913 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -680,7 +680,7 @@ SUBROUTINE write_char0D(pioFileDesc, & integer(i4b) :: var_id integer(i4b) :: start(2) integer(i4b) :: icount(2) - character(len=1) :: tmpString(300) ! temp for manipulating output string + character(len=1) :: tmpString(199) ! temp for manipulating output string ierr=0; message='write_char0D/' diff --git a/route/build/src/popMetadat.f90 b/route/build/src/popMetadat.f90 index 099b73294..d7636b98c 100644 --- a/route/build/src/popMetadat.f90 +++ b/route/build/src/popMetadat.f90 @@ -104,7 +104,7 @@ subroutine popMetadat(err,message) meta_stateDims(ixStateDims%mol_dw ) = dim_info('mol_dw', integerMissing, integerMissing) ! dw finite difference computing nodes meta_stateDims(ixStateDims%tdh_irf ) = dim_info('tdh_irf', integerMissing, integerMissing) ! future time steps for irf routing meta_stateDims(ixStateDims%tdh ) = dim_info('tdh', integerMissing, integerMissing) ! future time steps for bsasin irf routing - meta_stateDims(ixStateDims%nchars ) = dim_info('nchars', integerMissing, 300) ! number of characters for strings + meta_stateDims(ixStateDims%nchars ) = dim_info('nchars', integerMissing, 199) ! number of characters for strings meta_stateDims(ixStateDims%hist_fil) = dim_info('hist_fil',integerMissing, integerMissing) ! number of history files on restart file meta_qDims(ixQdims%time ) = dim_info('time', integerMissing, integerMissing) ! time From e20dc41b73346ecb383f1fe10d8522227d18e3fb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 8 Jul 2023 10:22:18 -0600 Subject: [PATCH 32/52] change name of restart history filename variable so it's not the same as the dimension name --- cime_config/config_archive.xml | 2 +- route/build/src/write_restart_pio.f90 | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index fcbf7f659..67fef6747 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -3,7 +3,7 @@ r h.*\.nc$ h_gauge.*\.nc$ - hist_fil + history_file rpointer.rof ./$CASE.mizuroute.r.$DATENAME.nc diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index a1220c56f..506569851 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -328,7 +328,7 @@ SUBROUTINE define_state_nc(fname, & ! input: filename call def_var(pioFileDescState, 'time_bound', ncd_float, ierr, cmessage, pioDimId=[dim_tbound], vdesc='time bound at last time step', vunit='sec') if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif - call def_var(pioFileDescState, 'hist_fil', ncd_char, ierr, cmessage, pioDimId=[dim_nchars, dim_hist_fil], vdesc='history files that need to be read with this restart file', vunit='-') + call def_var(pioFileDescState, 'history_file', ncd_char, ierr, cmessage, pioDimId=[dim_nchars, dim_hist_fil], vdesc='history files that need to be read with this restart file', vunit='-') if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif end associate @@ -937,11 +937,11 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name call write_netcdf(pioFileDescState, 'time_bound', TSEC, [1], [2], ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif - call write_netcdf(pioFileDescState, 'hist_fil', hfileOut, & + call write_netcdf(pioFileDescState, 'history_file', hfileOut, & iStart=1, ierr=ierr, message=cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif if ( outputAtGage )then - call write_netcdf(pioFileDescState, 'hist_fil', hfileOut_gage, & + call write_netcdf(pioFileDescState, 'history_file', hfileOut_gage, & iStart=2, ierr=ierr, message=cmessage) end if if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif From 2f9c1260e716a917477f30073bb496e589e5e7f5 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Jul 2023 16:04:38 -0600 Subject: [PATCH 33/52] Comment out lins where rpointer file is overwritten. This doesn't need to be done. --- route/build/src/write_simoutput_pio.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/route/build/src/write_simoutput_pio.f90 b/route/build/src/write_simoutput_pio.f90 index 0d9d58623..98f61b50e 100644 --- a/route/build/src/write_simoutput_pio.f90 +++ b/route/build/src/write_simoutput_pio.f90 @@ -108,8 +108,8 @@ SUBROUTINE main_new_file(ierr, message) end if ! update history files - call io_rpfile('w', ierr, cmessage) - if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif + !call io_rpfile('w', ierr, cmessage) + !if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif END SUBROUTINE main_new_file From c9ddf13f338fcc41e9927a73e685d60cb563a88a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Jul 2023 16:26:43 -0600 Subject: [PATCH 34/52] Add an explicit log of the file that is being opened and explicitly check if the file exists and abort if not --- route/build/src/pio_utils.f90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 82b331913..0ca4a5938 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -327,12 +327,22 @@ SUBROUTINE openFile(pioIoSystem, pioFileDesc, fname, netcdf_type, mode, fileOpen ! local variable integer(i4b) :: iotype ! netcdf type ID character(len=strLen) :: cmessage ! error message from subroutine + logical(lgt) :: lexist ! IF file exists or not ierr=0; message='openFile/' iotype = iotype_id(netcdf_type, ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif + inquire(file=trim(fname), exist=lexist) + write(iulog,*) ' opening file: ', trim(fname) + flush(iulog) + if ( .not. lexist )then + ierr = 10 + message=trim(message)//'file does NOT exist'//trim(fname) + return + end if + ierr = pio_openfile(pioIoSystem, pioFileDesc, iotype, trim(fname), mode) if(ierr/=pio_noerr)then; message=trim(message)//'Could not open netCDF'; return; endif From 7fc6cda9252a1c5dfbac8ef424b33dbe47d92302 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Jul 2023 16:39:37 -0600 Subject: [PATCH 35/52] Add expected fail, clarify comment --- cime_config/testdefs/ExpectedTestFails.xml | 6 ++++++ cime_config/testdefs/testlist_mizuRoute.xml | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 333570da6..9d56fd5f2 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -54,5 +54,11 @@ #390 + + + FAIL + #390 + + diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index 78c7d3153..2c21c6335 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -121,7 +121,7 @@ - + From 46cab0bf68bac409afbcb89d231091ad997568b4 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Jul 2023 16:52:39 -0600 Subject: [PATCH 36/52] Flush and write to iulog rather than 6 or * --- route/build/src/mpi_utils.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/route/build/src/mpi_utils.f90 b/route/build/src/mpi_utils.f90 index 43c24ceed..99ff2cddf 100644 --- a/route/build/src/mpi_utils.f90 +++ b/route/build/src/mpi_utils.f90 @@ -975,7 +975,7 @@ SUBROUTINE shr_mpi_abort(message, ierr, comm) integer(i4b) :: jerr write(iulog,*) trim(subName),trim(message) - flush(6) + flush(iulog) if (present(comm)) then call MPI_ABORT(comm, ierr, jerr) @@ -1009,11 +1009,11 @@ SUBROUTINE mpi_handle_err(ierr,pid) if(errLen>strLen)errMsg='errorMessageLengthTooLong' ! include process ID - write(*,'(a,1x,i4)') 'FATAL ERROR (MPI): '//trim(errMsg)//' for process ID ', pid + write(iulog,'(a,1x,i4)') 'FATAL ERROR (MPI): '//trim(errMsg)//' for process ID ', pid ! finalize MPI call MPI_FINALIZE(jerr) - flush(6) + flush(iulog) stop endif From 680273b2a885256ec061011a741ac26db10dbfe1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Jul 2023 17:02:45 -0600 Subject: [PATCH 37/52] Remove some variables not being used --- route/build/cpl/RtmTimeManager.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/route/build/cpl/RtmTimeManager.F90 b/route/build/cpl/RtmTimeManager.F90 index 59ac9414d..513e8e025 100644 --- a/route/build/cpl/RtmTimeManager.F90 +++ b/route/build/cpl/RtmTimeManager.F90 @@ -19,14 +19,12 @@ MODULE RtmTimeManager !-------------------------------------------------------------------------- ! Input from CESM driver - integer :: nelapse = integerMissing, & ! number of timesteps (or days if negative) to extend a run - start_ymd = integerMissing, & ! starting date for run in yearmmdd format + integer :: start_ymd = integerMissing, & ! starting date for run in yearmmdd format start_tod = 0, & ! starting time of day for run in seconds stop_ymd = integerMissing, & ! stopping date for run in yearmmdd format stop_tod = 0, & ! stopping time of day for run in seconds ref_ymd = integerMissing, & ! reference date for time coordinate in yearmmdd format ref_tod = 0 ! reference time of day for time coordinate in seconds - logical :: tm_first_restart_step = .false. ! true for first step of a restart or branch run CONTAINS From 28d3d689f2d47fc12b12b1551b219621902e8e35 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Jul 2023 17:04:49 -0600 Subject: [PATCH 38/52] Remove commented out line --- route/build/src/ascii_utils.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/route/build/src/ascii_utils.f90 b/route/build/src/ascii_utils.f90 index 090c8d3bf..8e0a509f2 100644 --- a/route/build/src/ascii_utils.f90 +++ b/route/build/src/ascii_utils.f90 @@ -207,7 +207,6 @@ SUBROUTINE get_vlines(unt,vlines,err,message) nullify(previous) end do nullify(list) - !if(associated(list)) nullify(list) END SUBROUTINE get_vlines ! ********************************************************************************************** From c2f38afcdcf63a853cca3a3f699275c8c1c44f8f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 11 Jul 2023 22:26:26 -0600 Subject: [PATCH 39/52] Reverse order of type definitions so one used first is defined first, this allows it to compile on izumi with nag compiler --- route/build/src/base_route.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/route/build/src/base_route.f90 b/route/build/src/base_route.f90 index aab4092ee..409285b49 100644 --- a/route/build/src/base_route.f90 +++ b/route/build/src/base_route.f90 @@ -10,12 +10,6 @@ MODULE base_route public:: base_route_rch ! base (abstract) reach routing method class (to be extended to specific) public:: routeContainer ! a holder of instantiated reach routing method object - ! --- routing method container - ! This container (holder) include instantiated reach routing method - type :: routeContainer - class(base_route_rch), allocatable :: rch_route - end type - ! --- base (abstract or template) reach routing method type, abstract :: base_route_rch @@ -23,6 +17,13 @@ MODULE base_route procedure(sub_route_rch), deferred :: route end type + ! --- routing method container + ! This container (holder) include instantiated reach routing method + type :: routeContainer + class(base_route_rch), allocatable :: rch_route + end type + + ABSTRACT INTERFACE SUBROUTINE sub_route_rch(this, & ! object to bound the procedure From ecfc3e4a26ebd465f01b2ad3e9c6a785aebe3693 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 12 Jul 2023 22:22:04 -0600 Subject: [PATCH 40/52] Have PIO free decomp use the PIO System rather than the PIO file descriptor --- route/build/src/historyFile.f90 | 4 ++-- route/build/src/pio_utils.f90 | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/route/build/src/historyFile.f90 b/route/build/src/historyFile.f90 index f555c8a79..8b60c67d4 100644 --- a/route/build/src/historyFile.f90 +++ b/route/build/src/historyFile.f90 @@ -351,7 +351,7 @@ SUBROUTINE cleanup_hru(this) implicit none class(histFile), intent(inout) :: this - !call freeDecomp(this%pioFileDesc, this%ioDescHruFlux) + call freeDecomp(this%pioSys, this%ioDescHruFlux) END SUBROUTINE cleanup_hru @@ -362,7 +362,7 @@ SUBROUTINE cleanup_rch(this) implicit none class(histFile), intent(inout) :: this - !call freeDecomp(this%pioFileDesc, this%ioDescRchFlux) + call freeDecomp(this%pioSys, this%ioDescRchFlux) END SUBROUTINE cleanup_rch diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 0ca4a5938..47403c865 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -367,16 +367,16 @@ SUBROUTINE closeFile(pioFileDesc, fileOpen) END SUBROUTINE closeFile !----------------------------------------------------------------------- - SUBROUTINE freeDecomp(pioFileDesc, iodesc) + SUBROUTINE freeDecomp(pioIOsystem, iodesc) ! !DESCRIPTION: ! Free decomposition ! implicit none ! ARGUMENTS: - type(file_desc_t), intent(inout) :: pioFileDesc ! PIO file handle to close + type(iosystem_desc_t),intent(inout) :: pioIOsystem ! type(io_desc_t), intent(inout) :: iodesc - call pio_freedecomp(pioFileDesc, ioDesc) + call pio_freedecomp(pioIOsystem, ioDesc) END SUBROUTINE freeDecomp From e01af9f8a67b3cae1a001b51097ad3b66b629447 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 12 Jul 2023 22:36:15 -0600 Subject: [PATCH 41/52] Move file close for restart to before free PIO decomp calls, and uncomment the PIO free decomp calls --- route/build/src/write_restart_pio.f90 | 56 +++++++++++++-------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index 506569851..3c2a609a1 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -982,37 +982,37 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name call write_history_state(ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif - ! clean decomposition data - !call freeDecomp(pioFileDescState, iodesc_rch_double) - !call freeDecomp(pioFileDescState, iodesc_rch_int) - !call freeDecomp(pioFileDescState, iodesc_hist_rch_double) - !if (meta_hflx(ixHFLX%basRunoff)%varFile) then - !call freeDecomp(pioFileDescState, iodesc_hist_hru_double) - !end if - !if (doesBasinRoute==1) then - !call freeDecomp(pioFileDescState, iodesc_irf_bas_double) - !end if - !if (onRoute(impulseResponseFunc))then - !call freeDecomp(pioFileDescState, iodesc_irf_double) - !call freeDecomp(pioFileDescState, iodesc_vol_double) - !end if - !if (onRoute(kinematicWaveTracking)) then - !call freeDecomp(pioFileDescState, iodesc_wave_int) - !call freeDecomp(pioFileDescState, iodesc_wave_double) - !end if - !if (onRoute(kinematicWave)) then - !call freeDecomp(pioFileDescState, iodesc_mesh_kw_double) - !end if - !if (onRoute(muskingumCunge)) then - !call freeDecomp(pioFileDescState, iodesc_mesh_mc_double) - !end if - !if (onRoute(diffusiveWave)) then - !call freeDecomp(pioFileDescState, iodesc_mesh_dw_double) - !end if - ! close netCDF call closeFile(pioFileDescState, restartOpen) + ! clean decomposition data + call freeDecomp(pioSystem, iodesc_rch_double) + call freeDecomp(pioSystem, iodesc_rch_int) + call freeDecomp(pioSystem, iodesc_hist_rch_double) + if (meta_hflx(ixHFLX%basRunoff)%varFile) then + call freeDecomp(pioSystem, iodesc_hist_hru_double) + end if + if (doesBasinRoute==1) then + call freeDecomp(pioSystem, iodesc_irf_bas_double) + end if + if (onRoute(impulseResponseFunc))then + call freeDecomp(pioSystem, iodesc_irf_double) + call freeDecomp(pioSystem, iodesc_vol_double) + end if + if (onRoute(kinematicWaveTracking)) then + call freeDecomp(pioSystem, iodesc_wave_int) + call freeDecomp(pioSystem, iodesc_wave_double) + end if + if (onRoute(kinematicWave)) then + call freeDecomp(pioSystem, iodesc_mesh_kw_double) + end if + if (onRoute(muskingumCunge)) then + call freeDecomp(pioSystem, iodesc_mesh_mc_double) + end if + if (onRoute(diffusiveWave)) then + call freeDecomp(pioSystem, iodesc_mesh_dw_double) + end if + CONTAINS SUBROUTINE write_basinQ_state(ierr, message1) From b5c3623e46e8d33deda133ebec17cc46a8a646e1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 12 Jul 2023 23:10:17 -0600 Subject: [PATCH 42/52] Increase filename size from 199 to 300 --- route/build/src/globalData.f90 | 6 +++--- route/build/src/historyFile.f90 | 2 +- route/build/src/pio_utils.f90 | 2 +- route/build/src/popMetadat.f90 | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/route/build/src/globalData.f90 b/route/build/src/globalData.f90 index 06ba2fe4b..805b9e01c 100644 --- a/route/build/src/globalData.f90 +++ b/route/build/src/globalData.f90 @@ -119,9 +119,9 @@ MODULE globalData integer(i4b), public :: nEns=1 ! number of ensemble integer(i4b), public :: maxtdh ! maximum unit-hydrograph future time steps type(cMolecule), public :: nMolecule ! number of computational molecule (used for KW, MC, DW) - character(199), public :: hfileout=charMissing ! history output file name - character(199), public :: hfileout_gage=charMissing ! gage-only history output file name - character(199), public :: rfileout=charMissing ! restart output file name + character(300), public :: hfileout=charMissing ! history output file name + character(300), public :: hfileout_gage=charMissing ! gage-only history output file name + character(300), public :: rfileout=charMissing ! restart output file name logical(lgt), public :: initHvars=.false. ! status of history variable data initialization logical(lgt), public :: isColdStart=.true. ! initial river state - cold start (T) or from restart file (F) diff --git a/route/build/src/historyFile.f90 b/route/build/src/historyFile.f90 index 8b60c67d4..dbe7e0e2c 100644 --- a/route/build/src/historyFile.f90 +++ b/route/build/src/historyFile.f90 @@ -30,7 +30,7 @@ MODULE historyFile type :: histFile private - character(199) :: fname ! netCDF name + character(300) :: fname ! netCDF name integer(i4b) :: iTime=0 ! time step in output netCDF logical(lgt) :: fileStatus=.false. ! flag to indicate history output netcdf is open logical(lgt) :: gageOutput=.false. ! flag to indicate this is at-gage-only output (== output subset of reaches) diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 47403c865..571fecb81 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -690,7 +690,7 @@ SUBROUTINE write_char0D(pioFileDesc, & integer(i4b) :: var_id integer(i4b) :: start(2) integer(i4b) :: icount(2) - character(len=1) :: tmpString(199) ! temp for manipulating output string + character(len=1) :: tmpString(300) ! temp for manipulating output string ierr=0; message='write_char0D/' diff --git a/route/build/src/popMetadat.f90 b/route/build/src/popMetadat.f90 index d7636b98c..099b73294 100644 --- a/route/build/src/popMetadat.f90 +++ b/route/build/src/popMetadat.f90 @@ -104,7 +104,7 @@ subroutine popMetadat(err,message) meta_stateDims(ixStateDims%mol_dw ) = dim_info('mol_dw', integerMissing, integerMissing) ! dw finite difference computing nodes meta_stateDims(ixStateDims%tdh_irf ) = dim_info('tdh_irf', integerMissing, integerMissing) ! future time steps for irf routing meta_stateDims(ixStateDims%tdh ) = dim_info('tdh', integerMissing, integerMissing) ! future time steps for bsasin irf routing - meta_stateDims(ixStateDims%nchars ) = dim_info('nchars', integerMissing, 199) ! number of characters for strings + meta_stateDims(ixStateDims%nchars ) = dim_info('nchars', integerMissing, 300) ! number of characters for strings meta_stateDims(ixStateDims%hist_fil) = dim_info('hist_fil',integerMissing, integerMissing) ! number of history files on restart file meta_qDims(ixQdims%time ) = dim_info('time', integerMissing, integerMissing) ! time From 3181ea9191cfa80b7bd22b9d5c98a6586f0c7297 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 12 Jul 2023 23:28:44 -0600 Subject: [PATCH 43/52] Fix expected fail --- cime_config/testdefs/ExpectedTestFails.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 9d56fd5f2..c3cd5199b 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -48,13 +48,13 @@ #390 - + FAIL #390 - + FAIL #390 From 8e175b50df33dec173603203afeaf0187830b6ae Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 12 Jul 2023 23:44:49 -0600 Subject: [PATCH 44/52] Change file string length to a parameter --- route/build/src/globalData.f90 | 6 +++--- route/build/src/historyFile.f90 | 2 +- route/build/src/nrtype.f90 | 1 + route/build/src/pio_utils.f90 | 2 +- route/build/src/popMetadat.f90 | 2 +- 5 files changed, 7 insertions(+), 6 deletions(-) diff --git a/route/build/src/globalData.f90 b/route/build/src/globalData.f90 index 805b9e01c..ad8c839a9 100644 --- a/route/build/src/globalData.f90 +++ b/route/build/src/globalData.f90 @@ -119,9 +119,9 @@ MODULE globalData integer(i4b), public :: nEns=1 ! number of ensemble integer(i4b), public :: maxtdh ! maximum unit-hydrograph future time steps type(cMolecule), public :: nMolecule ! number of computational molecule (used for KW, MC, DW) - character(300), public :: hfileout=charMissing ! history output file name - character(300), public :: hfileout_gage=charMissing ! gage-only history output file name - character(300), public :: rfileout=charMissing ! restart output file name + character(FileStrLen), public :: hfileout=charMissing ! history output file name + character(FileStrLen), public :: hfileout_gage=charMissing ! gage-only history output file name + character(FileStrLen), public :: rfileout=charMissing ! restart output file name logical(lgt), public :: initHvars=.false. ! status of history variable data initialization logical(lgt), public :: isColdStart=.true. ! initial river state - cold start (T) or from restart file (F) diff --git a/route/build/src/historyFile.f90 b/route/build/src/historyFile.f90 index dbe7e0e2c..414bc8e2f 100644 --- a/route/build/src/historyFile.f90 +++ b/route/build/src/historyFile.f90 @@ -30,7 +30,7 @@ MODULE historyFile type :: histFile private - character(300) :: fname ! netCDF name + character(FileStrLen) :: fname ! netCDF name integer(i4b) :: iTime=0 ! time step in output netCDF logical(lgt) :: fileStatus=.false. ! flag to indicate history output netcdf is open logical(lgt) :: gageOutput=.false. ! flag to indicate this is at-gage-only output (== output subset of reaches) diff --git a/route/build/src/nrtype.f90 b/route/build/src/nrtype.f90 index 370f46b3d..dc89c5393 100644 --- a/route/build/src/nrtype.f90 +++ b/route/build/src/nrtype.f90 @@ -11,4 +11,5 @@ MODULE nrtype integer, parameter :: LGT = KIND(.true.) ! common variables integer(i4b),parameter :: strLen=256 ! string length + integer(i4b),parameter :: FileStrLen=300 ! File string length END MODULE nrtype diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 571fecb81..1bd905191 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -690,7 +690,7 @@ SUBROUTINE write_char0D(pioFileDesc, & integer(i4b) :: var_id integer(i4b) :: start(2) integer(i4b) :: icount(2) - character(len=1) :: tmpString(300) ! temp for manipulating output string + character(len=1) :: tmpString(FileStrLen) ! temp for manipulating output string ierr=0; message='write_char0D/' diff --git a/route/build/src/popMetadat.f90 b/route/build/src/popMetadat.f90 index 099b73294..afc1a85a2 100644 --- a/route/build/src/popMetadat.f90 +++ b/route/build/src/popMetadat.f90 @@ -104,7 +104,7 @@ subroutine popMetadat(err,message) meta_stateDims(ixStateDims%mol_dw ) = dim_info('mol_dw', integerMissing, integerMissing) ! dw finite difference computing nodes meta_stateDims(ixStateDims%tdh_irf ) = dim_info('tdh_irf', integerMissing, integerMissing) ! future time steps for irf routing meta_stateDims(ixStateDims%tdh ) = dim_info('tdh', integerMissing, integerMissing) ! future time steps for bsasin irf routing - meta_stateDims(ixStateDims%nchars ) = dim_info('nchars', integerMissing, 300) ! number of characters for strings + meta_stateDims(ixStateDims%nchars ) = dim_info('nchars', integerMissing, FileStrLen) ! number of characters for strings meta_stateDims(ixStateDims%hist_fil) = dim_info('hist_fil',integerMissing, integerMissing) ! number of history files on restart file meta_qDims(ixQdims%time ) = dim_info('time', integerMissing, integerMissing) ! time From 507aace972934c6ce3e57fe71c3430e8b944bc6a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 13 Jul 2023 00:18:03 -0600 Subject: [PATCH 45/52] Remove some of the character options known to NOT work --- route/build/src/pio_utils.f90 | 41 ----------------------------------- 1 file changed, 41 deletions(-) diff --git a/route/build/src/pio_utils.f90 b/route/build/src/pio_utils.f90 index 1bd905191..e4deac4fb 100644 --- a/route/build/src/pio_utils.f90 +++ b/route/build/src/pio_utils.f90 @@ -54,7 +54,6 @@ MODULE pio_utils INTERFACE write_netcdf module procedure write_char0D - module procedure write_char1D module procedure write_array1D module procedure write_array2D END INTERFACE @@ -662,8 +661,6 @@ SUBROUTINE write_scalar_netcdf(pioFileDesc, & ierr = pio_put_var(pioFileDesc, pioVarId, [scalar]) type is (real(dp)) ierr = pio_put_var(pioFileDesc, pioVarId, [scalar]) - type is (character(len=*)) - ierr = pio_put_var(pioFileDesc, pioVarId, [scalar]) end select if(ierr/=pio_noerr)then; message=trim(message)//'cannot write data'; return; endif @@ -717,44 +714,6 @@ SUBROUTINE write_char0D(pioFileDesc, & END SUBROUTINE write_char0D - ! --------------------------------------------------------------- - ! write global character vector into 1D variable - SUBROUTINE write_char1D(pioFileDesc, & - vname, & ! input: variable name - length, & ! Input: length of strings - array, & ! input: variable data - iStart, & ! input: start index - iCount, & ! input: length of vector - ierr, message) ! output: error control - implicit none - ! Argument variables: - type(file_desc_t), intent(inout) :: pioFileDesc ! pio file handle - character(len=*), intent(in) :: vname ! variable name - integer(i4b), intent(in) :: length ! length of strings - character(len=*), intent(in) :: array(:) ! variable data - integer(i4b), intent(in) :: iStart(:) ! start index - integer(i4b), intent(in) :: iCount(:) ! length of vector - integer(i4b), intent(out) :: ierr - character(*), intent(out) :: message ! error message - ! local variables - type(var_desc_t) :: pioVarId - - ierr=0; message='write_char1D/' - - if ( any(len_trim(array(:)) > length) )then - ierr = -100 - message=trim(message)//'ERROR: string length is greater than allowed size' - return - end if - ierr = pio_inq_varid(pioFileDesc, trim(vname), pioVarId) - if(ierr/=0)then; message=trim(message)//'ERROR: getting variable id'; return; endif - - ierr = pio_put_var(pioFileDesc, pioVarId, iStart, iCount, array) - if(ierr/=pio_noerr)then; message=trim(message)//'cannot write data'; return; endif - - END SUBROUTINE write_char1D - - ! --------------------------------------------------------------- ! write global integer vector into 1D variable SUBROUTINE write_array1D(pioFileDesc, & From dd6bfb35a0452947dba99d53858ce657532f3895 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 13 Jul 2023 13:19:29 -0600 Subject: [PATCH 46/52] Fully remove the bit about updating the restart pointer file when the history file is updated, this should only happen when the restart files are updated --- route/build/src/write_simoutput_pio.f90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/route/build/src/write_simoutput_pio.f90 b/route/build/src/write_simoutput_pio.f90 index 98f61b50e..62a259415 100644 --- a/route/build/src/write_simoutput_pio.f90 +++ b/route/build/src/write_simoutput_pio.f90 @@ -107,10 +107,6 @@ SUBROUTINE main_new_file(ierr, message) end if - ! update history files - !call io_rpfile('w', ierr, cmessage) - !if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif - END SUBROUTINE main_new_file ! ********************************************************************* From c5780d377ccf83fc42e898a7ded484abff34956d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Jul 2023 13:57:13 -0600 Subject: [PATCH 47/52] Always start simulations at current time, this fixes #391, for startup start and current time will be the same, for branch and hybrid you need current time rather than start, and for continue you always need current time --- route/build/cpl/nuopc/rof_comp_nuopc.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/route/build/cpl/nuopc/rof_comp_nuopc.F90 b/route/build/cpl/nuopc/rof_comp_nuopc.F90 index 9d7a3cad6..3b761e692 100644 --- a/route/build/cpl/nuopc/rof_comp_nuopc.F90 +++ b/route/build/cpl/nuopc/rof_comp_nuopc.F90 @@ -447,11 +447,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,start_ymd) - if (trim(starttype) == trim('continue') ) then - call shr_timeStr( currTime, simStart ) - else - call shr_timeStr( startTime, simStart ) - endif + ! Always have simulation start at current time + call shr_timeStr( currTime, simStart ) call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return From befdfa67027596723cd217968af98c42f604c158 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Jul 2023 14:36:24 -0600 Subject: [PATCH 48/52] Add some more ERI tests --- cime_config/testdefs/testlist_mizuRoute.xml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index 2c21c6335..ea99dd765 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -115,6 +115,16 @@ + + + + + + + + + + @@ -239,6 +249,15 @@ + + + + + + + + + From b6713425f8f4e1f06b1cbbcd94e51ef8d461b02d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Jul 2023 20:56:36 -0600 Subject: [PATCH 49/52] Add to expected fails --- cime_config/testdefs/ExpectedTestFails.xml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index c3cd5199b..57daff7b8 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -48,6 +48,16 @@ #390 + + + FAIL + #390 + + + FAIL + #390 + + FAIL From 18ea762b4301858a00564762d74e3c892a20dfbe Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Jul 2023 21:23:41 -0600 Subject: [PATCH 50/52] Add expected fail --- cime_config/testdefs/ExpectedTestFails.xml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 57daff7b8..04a1ebe32 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -48,6 +48,12 @@ #390 + + FAIL + #390 + + FAIL From a582644c30340081664f4ef8947da6a7bddf4a2f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Jul 2023 21:25:21 -0600 Subject: [PATCH 51/52] Change ERI test on izumi to gnu compiler since nag without DEBUG doesn't work --- cime_config/testdefs/testlist_mizuRoute.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index ea99dd765..e3f0da5a5 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -118,7 +118,7 @@ - + From 030479e703fcb1bd380aea41da7e6c4a34f29ddb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Jul 2023 21:54:02 -0600 Subject: [PATCH 52/52] Add an expected fail for izumi_gnu for ERI --- cime_config/testdefs/ExpectedTestFails.xml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 04a1ebe32..49abf98a1 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -54,7 +54,17 @@ #390 - + + + FAIL + #390 + + + FAIL + #390 + + + FAIL #390