Some fixes so can run on izumi

route/build/cpl/RtmMod.F90

@@ -337,7 +337,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)

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)//'<time_units>= '//trim(time_units)//': <time_units> must be seconds, minutes, hours or days.'; return
+ ierr=20
+ message=trim(message)//'<time_units>= '//trim(time_units)// &
+ ': <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

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

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
 
  ! **********************************************************************************************

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

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

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
 

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

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