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) diff --git a/cime_config/buildnml b/cime_config/buildnml index 774dd1f34..f55e5f6a0 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -52,6 +52,10 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, logger.debug(" mizuRoute lnd grid is %s ", config['lnd_grid']) logger.debug(" mizuRoute rof grid is %s ", config['rof_grid']) #---------------------------------------------------- + # Create dictionary of files that will be read in + #---------------------------------------------------- + files = {} + #---------------------------------------------------- # Settings that depend on the resolution #---------------------------------------------------- if ( config['rof_grid'] == "HDMAmz" ): @@ -95,7 +99,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_c20220427.nc" varname_area = "Basin_Area" varname_length = "Length" varname_slope = "Slope" @@ -175,6 +179,8 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, ctl.set( "varname_downSegId", varname_downSegId ) ctl.set( "varname_pfafCode", varname_pfafCode ) + files['fname_ntopold'] = os.path.join( ctl.get('ancil_dir'), ctl.get('fname_ntopOld') ) + #---------------------------------------------------- # Set the restart file depending on start type #---------------------------------------------------- @@ -189,6 +195,7 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, filename = "%s.mizuRoute.r.%s-%s.nc" %(run_refcase, run_refdate, run_tod) ctl.set( "fname_state_in", filename ) + files['fname_state_in'] = ctl.get('fname_state_in') elif fname_state_in.strip() == '': fname_state_in = "empty" @@ -199,7 +206,7 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, ctl.set( "fname_state_in", fname_state_in ) # Read in the user control file for the case and change settings to it - file_src = "user_ctl_mizuroute" + file_src = "user_nl_mizuroute_ctl" user_ctl_file = os.path.join(caseroot, file_src + inst_string) if ( not os.path.exists( user_ctl_file ) ): safe_copy( os.path.join( srcroot, "cime_config", file_src), user_ctl_file ) @@ -207,7 +214,7 @@ def _create_control_files(case, caseroot, srcroot, confdir, inst_string, infile, usrctl.read( user_ctl_file, allowEmpty=True ) for element in usrctl.get_elmList(): value = ctl.get( element ) - expect( value != "UNSET", "Element in the user_ctl_mizuroute file is NOT in the control file: "+element ) + expect( value != "UNSET", "Element in the user_nl_mizuroute_ctl file is NOT in the control file: "+element ) ctl.set( element, usrctl.get( element ) ) #---------------------------------------------------- @@ -215,15 +222,23 @@ 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, data_list_path) ctl.write( control_file ) + #---------------------------------------------------- + # Append list of files needed to file list file + #---------------------------------------------------- + print( data_list_path ) + fileslist = open( data_list_path, "a" ) + print( files ) + for datafile in files: + print( datafile ) + fileslist.write( datafile + " = " + files[datafile] + "\n" ) + + fileslist.close() ############################################################################### -def write_nml_in_file(case, nmlgen, confdir, nml_file): +def write_nml_in_file(case, nmlgen, confdir, nml_file, data_list_path): ############################################################################### - data_list_path = os.path.join(case.get_case_root(), "Buildconf", "rof.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 ) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 834397d6c..d977011ae 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -30,22 +30,16 @@ - + FAIL - #227 + PGI problems with the nuopc driver FAIL - ESMCI/cime#143 - - - - - FAIL - #227 + #273 @@ -60,6 +54,18 @@ #226 + + + FAIL + #280 + + + + + FAIL + ESCOMP/CDEPS/#161 + + FAIL diff --git a/cime_config/testdefs/testlist_mizuRoute.xml b/cime_config/testdefs/testlist_mizuRoute.xml index 8a05cf4b3..2beedd5cf 100644 --- a/cime_config/testdefs/testlist_mizuRoute.xml +++ b/cime_config/testdefs/testlist_mizuRoute.xml @@ -3,16 +3,17 @@ - + - + + @@ -46,6 +47,7 @@ + @@ -56,7 +58,6 @@ - @@ -80,7 +81,6 @@ - @@ -104,31 +104,29 @@ - + - - - - + + - + - + + + + - - - - + diff --git a/cime_config/testdefs/testmods_dirs/mizuroute/default/user_ctl_mizuroute b/cime_config/testdefs/testmods_dirs/mizuroute/default/user_nl_mizuroute_ctl similarity index 100% rename from cime_config/testdefs/testmods_dirs/mizuroute/default/user_ctl_mizuroute rename to cime_config/testdefs/testmods_dirs/mizuroute/default/user_nl_mizuroute_ctl diff --git a/cime_config/testdefs/testmods_dirs/mizuroute/monthly/user_ctl_mizuroute b/cime_config/testdefs/testmods_dirs/mizuroute/monthly/user_nl_mizroute_ctl similarity index 100% rename from cime_config/testdefs/testmods_dirs/mizuroute/monthly/user_ctl_mizuroute rename to cime_config/testdefs/testmods_dirs/mizuroute/monthly/user_nl_mizroute_ctl diff --git a/cime_config/user_ctl_mizuroute b/cime_config/user_nl_mizuroute_ctl similarity index 100% rename from cime_config/user_ctl_mizuroute rename to cime_config/user_nl_mizuroute_ctl diff --git a/route/build/cpl/RtmTimeManager.F90 b/route/build/cpl/RtmTimeManager.F90 index a938c142c..699035e5b 100644 --- a/route/build/cpl/RtmTimeManager.F90 +++ b/route/build/cpl/RtmTimeManager.F90 @@ -82,7 +82,9 @@ 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 @@ -122,7 +124,11 @@ SUBROUTINE init_time(ierr, message) end if ! 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 @@ -132,8 +138,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(iTime) @@ -158,7 +166,7 @@ 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,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') yy,'-',mm,'-',dd,' ',hr,':',mn,':',sec END SUBROUTINE shr_timeStr diff --git a/route/build/src/accum_runoff.f90 b/route/build/src/accum_runoff.f90 index 6b99df886..dd1ca2545 100644 --- a/route/build/src/accum_runoff.f90 +++ b/route/build/src/accum_runoff.f90 @@ -164,13 +164,13 @@ SUBROUTINE accum_qupstream(iEns, & ! input: index of runoff ensemble to write(fmt1,'(A,I5,A)') '(A,1X',nUps,'(1X,I10))' write(fmt2,'(A,I5,A)') '(A,1X',nUps,'(1X,F20.7))' write(*,'(2a)') new_line('a'),'** Check upstream discharge accumulation **' - write(*,'(a,x,I10,x,I10)') ' Reach index & ID =', segIndex, NETOPO_in(segIndex)%REACHID + write(*,'(a,1x,I10,1x,I10)') ' Reach index & ID =', segIndex, NETOPO_in(segIndex)%REACHID write(*,'(a)') ' * upstream reach index (NETOPO_in%UREACH) and discharge (uprflux) [m3/s] :' write(*,fmt1) ' UREACHK =', (NETOPO_in(segIndex)%UREACHK(iUps), iUps=1,nUps) write(*,fmt2) ' prflux =', (RCHFLX_out(iens,NETOPO_in(segIndex)%UREACHI(iUps))%ROUTE(idxSUM)%REACH_Q, iUps=1,nUps) write(*,'(a)') ' * local area discharge (RCHFLX_out%BASIN_QR(1)) and final discharge (RCHFLX_out%ROUTE(idxSUM)%REACH_Q) [m3/s] :' - write(*,'(a,x,F15.7)') ' RCHFLX_out%BASIN_QR(1) =', RCHFLX_out(iEns,segIndex)%BASIN_QR(1) - write(*,'(a,x,F15.7)') ' RCHFLX_out%ROUTE(idxSUM)%REACH_Q =', RCHFLX_out(iens,segIndex)%ROUTE(idxSUM)%REACH_Q + write(*,'(a,1x,F15.7)') ' RCHFLX_out%BASIN_QR(1) =', RCHFLX_out(iEns,segIndex)%BASIN_QR(1) + write(*,'(a,1x,F15.7)') ' 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/ascii_util.f90 b/route/build/src/ascii_util.f90 index 11867f012..f080f2308 100644 --- a/route/build/src/ascii_util.f90 +++ b/route/build/src/ascii_util.f90 @@ -205,7 +205,6 @@ SUBROUTINE get_vlines(unt,vlines,err,message) previous=>current; current=>current%next deallocate(previous) end do - if(associated(list)) nullify(list) END SUBROUTINE get_vlines ! ********************************************************************************************** diff --git a/route/build/src/dfw_route.f90 b/route/build/src/dfw_route.f90 index 6cca777e8..a39ed2151 100644 --- a/route/build/src/dfw_route.f90 +++ b/route/build/src/dfw_route.f90 @@ -181,10 +181,10 @@ 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 @@ -197,12 +197,12 @@ SUBROUTINE dfw_rch(iEns, segIndex, & ! input: index of runoff ensemble to be pro doCheck, & ! 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(doCheck)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 END SUBROUTINE dfw_rch @@ -322,14 +322,14 @@ SUBROUTINE diffusive_wave(rch_param, & ! input: river parameter data structu dt = T1-T0 if (doCheck) then - write(iulog,'(4(A,X,G15.4))') ' length [m] =',rch_param%RLENGTH,'slope [-] =',rch_param%R_SLOPE,'channel width [m] =',rch_param%R_WIDTH,'manning coef =',rch_param%R_MAN_N + write(iulog,'(4(A,1X,G15.4))') ' length [m] =',rch_param%RLENGTH,'slope [-] =',rch_param%R_SLOPE,'channel width [m] =',rch_param%R_WIDTH,'manning coef =',rch_param%R_MAN_N end if ! time-step adjustment so Courant number is less than 1 dTsub = dt/ntSub if (doCheck) 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) @@ -442,7 +442,7 @@ SUBROUTINE diffusive_wave(rch_param, & ! input: river parameter data structu endif if (doCheck) then - write(iulog,'(A,X,G12.5)') ' Qout(t) =', rflux%ROUTE(idxDW)%REACH_Q + write(iulog,'(A,1X,G12.5)') ' Qout(t) =', rflux%ROUTE(idxDW)%REACH_Q endif END SUBROUTINE diffusive_wave diff --git a/route/build/src/domain_decomposition.f90 b/route/build/src/domain_decomposition.f90 index 5a30fa53c..0c13057bd 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/init_model_data.f90 b/route/build/src/init_model_data.f90 index cab2a7999..8d45ecd8b 100644 --- a/route/build/src/init_model_data.f90 +++ b/route/build/src/init_model_data.f90 @@ -493,6 +493,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 ! share system call implicit none ! Argument variables @@ -579,7 +580,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)//' problem deleting fname_ntopNew'; return; endif call writeData(& ! input diff --git a/route/build/src/irf_route.f90 b/route/build/src/irf_route.f90 index d8f744a13..4694727ee 100644 --- a/route/build/src/irf_route.f90 +++ b/route/build/src/irf_route.f90 @@ -217,12 +217,12 @@ 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(*,'(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,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,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 END SUBROUTINE irf_rch diff --git a/route/build/src/kwe_route.f90 b/route/build/src/kwe_route.f90 index 82ee74aff..b6003d0b1 100644 --- a/route/build/src/kwe_route.f90 +++ b/route/build/src/kwe_route.f90 @@ -185,10 +185,10 @@ 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,G15.4)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps),RCHFLX_out(iens, iRch_ups)%ROUTE(idxKW)%REACH_Q + write(iulog,'(A,1X,I12,1X,G15.4)') ' 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 @@ -201,11 +201,11 @@ SUBROUTINE kw_rch(iEns, segIndex, & ! input: index of runoff ensemble to be proc doCheck, & ! 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(doCheck)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 END SUBROUTINE kw_rch @@ -291,8 +291,8 @@ SUBROUTINE kinematic_wave(rch_param, & ! input: river parameter data structu Q(1,0) = q_upstream if (doCheck) then - write(iulog,'(3(A,X,G12.5))') ' R_SLOPE=',rch_param%R_SLOPE,' R_WIDTH=',rch_param%R_WIDTH,' R_MANN=',rch_param%R_MAN_N - 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,'(3(A,1X,G12.5))') ' R_SLOPE=',rch_param%R_SLOPE,' R_WIDTH=',rch_param%R_WIDTH,' R_MANN=',rch_param%R_MAN_N + 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 ! ---------- @@ -333,7 +333,7 @@ SUBROUTINE kinematic_wave(rch_param, & ! input: river parameter data structu endif if (doCheck) 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 else ! if head-water @@ -343,7 +343,7 @@ SUBROUTINE kinematic_wave(rch_param, & ! input: river parameter data structu if (doCheck) then write(iulog,'(A)') ' This is headwater ' - 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) endif endif diff --git a/route/build/src/kwt_route.f90 b/route/build/src/kwt_route.f90 index d1a2791f5..024f15f2b 100644 --- a/route/build/src/kwt_route.f90 +++ b/route/build/src/kwt_route.f90 @@ -242,11 +242,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 ! RCHFLX_out(IENS,JRCH)%TAKE=0.0_dp ! initialize take from this reach @@ -290,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,F20.7)') RCHFLX_out(IENS,JRCH)%ROUTE(idxKWT)%REACH_Q + write(iulog,'(1x,F20.7)') RCHFLX_out(IENS,JRCH)%ROUTE(idxKWT)%REACH_Q end if return ! no upstream reaches (routing for sub-basins done using time-delay histogram) endif @@ -523,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,F15.7)') ' Qtake =', Qtake - write(*,'(a,x,F15.7)') ' totQ =', totQ - write(*,'(a,x,F15.7)') ' Qabs =', Qabs + write(*,'(a,1x,F15.7)') ' Qtake =', Qtake + write(*,'(a,1x,F15.7)') ' totQ =', totQ + write(*,'(a,1x,F15.7)') ' Qabs =', Qabs end if ! modify wave speed at modified wave discharge and re-compute exit time @@ -670,7 +670,7 @@ subroutine getusq_rch(IENS,JRCH,LAKEFLAG,T0,T1,ixDesire, & ! input if (JRCH == ixDesire) then write(fmt1,'(A,I5,A)') '(A,1X',ND,'(1X,F15.7))' write(*,'(a)') ' * After qexmul_rch: # of routed wave from upstreams (ND) and wave discharge (QD) [m2/s]:' - write(*,'(A,x,I5)') ' ND=', ND + write(*,'(A,1x,I5)') ' ND=', ND write(*,fmt1) ' QD=', (QD(iw), iw=1,ND) end if end if @@ -853,7 +853,7 @@ 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 @@ -1393,7 +1393,7 @@ SUBROUTINE kinwav_rch(JRCH,T_START,T_END,ixDesire, & ! input: loca if(jRch==ixDesire) then write(fmt1,'(A,I5,A)') '(A,1X',NN,'(1X,F15.7))' 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,'(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 @@ -1453,7 +1453,7 @@ SUBROUTINE kinwav_rch(JRCH,T_START,T_END,ixDesire, & ! input: loca if(jRch==ixDesire) then write(fmt1,'(A,I5,A)') '(A,1X',NN,'(1X,F15.7))' write(iulog,'(a)') ' * After wave merge: wave celertiy (wc) [m/s]:' - write(iulog,'(a,x,I3)') ' Number of wave =', NN + write(iulog,'(a,1x,I3)') ' Number of wave =', NN write(iulog,fmt1) ' wc=', (wc(iw), iw=1,NN) end if diff --git a/route/build/src/mc_route.f90 b/route/build/src/mc_route.f90 index f3e5d6c7f..a093009a7 100644 --- a/route/build/src/mc_route.f90 +++ b/route/build/src/mc_route.f90 @@ -183,10 +183,10 @@ 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,I6,X,G12.5)') ' UREACHK, uprflux=',NETOPO_in(segIndex)%UREACHK(iUps),RCHFLX_out(iens, iRch_ups)%ROUTE(idxMC)%REACH_Q + write(iulog,'(A,1X,I6,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 @@ -199,11 +199,11 @@ SUBROUTINE mc_rch(iEns, segIndex, & ! input: index of runoff ensemble to be proc doCheck, & ! 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(doCheck)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 END SUBROUTINE mc_rch @@ -232,6 +232,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct ! state array: ! (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 @@ -289,8 +290,8 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct Q(1,0) = q_upstream if (doCheck) then - write(iulog,'(4(A,X,G12.5))') ' length [m] =',rch_param%RLENGTH,'slope [-] =',rch_param%R_SLOPE,'channel width [m] =',rch_param%R_WIDTH,'manning coef =',rch_param%R_MAN_N - write(iulog,'(3(A,X,G12.5))') ' Qin(t-1) Q(0,0)=',Q(0,0),' Qin(t) Q(0,1)=',Q(0,1),' Qout(t-1) Q(1,0)=',Q(1,0) + write(iulog,'(4(A,1X,G12.5))') ' length [m] =',rch_param%RLENGTH,'slope [-] =',rch_param%R_SLOPE,'channel width [m] =',rch_param%R_WIDTH,'manning coef =',rch_param%R_MAN_N + write(iulog,'(3(A,1X,G12.5))') ' Qin(t-1) Q(0,0)=',Q(0,0),' Qin(t) Q(0,1)=',Q(0,1),' Qout(t-1) Q(1,0)=',Q(1,0) end if ! first, using 3-point average in computational molecule, check Cournat number is less than 1, otherwise subcycle within one time step @@ -308,7 +309,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct dTsub = dt/ntSub end if if (doCheck) 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) @@ -341,7 +342,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct end if if (doCheck) 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 @@ -367,7 +368,7 @@ SUBROUTINE muskingum_cunge(rch_param, & ! input: river parameter data struct rflux%ROUTE(idxMC)%REACH_Q = Q(1,1)+rflux%BASIN_QR(1) if (doCheck) 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/mpi_utils.f90 b/route/build/src/mpi_utils.f90 index 8a49a1f5f..8b96fd0c9 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 @@ -786,7 +787,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) @@ -824,7 +825,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/nr_utility.f90 b/route/build/src/nr_utility.f90 index 7fa124419..cc6e2d80e 100644 --- a/route/build/src/nr_utility.f90 +++ b/route/build/src/nr_utility.f90 @@ -124,7 +124,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 @@ -157,9 +157,11 @@ END SUBROUTINE indexx SUBROUTINE swap(a,b) INTEGER(I4B), INTENT(INOUT) :: a,b INTEGER(I4B) :: dum - dum=a - a=b - b=dum + if ( a /= b )then + dum=a + a=b + b=dum + end if END SUBROUTINE swap ! ************************************************************************************************ diff --git a/route/build/src/read_control.f90 b/route/build/src/read_control.f90 index 8f6131785..e8a7db090 100644 --- a/route/build/src/read_control.f90 +++ b/route/build/src/read_control.f90 @@ -94,7 +94,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 ! populate variables diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index 700a263d6..abce51db4 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -220,7 +220,7 @@ SUBROUTINE restart_fname(fname, timeStamp, ierr, message) type(datetime) :: restartTimeStamp ! datetime corresponding to file name time stamp character(len=strLen) :: cmessage ! error message of downwind routine 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 52c220bb1..5ed823198 100644 --- a/route/build/src/write_simoutput_pio.f90 +++ b/route/build/src/write_simoutput_pio.f90 @@ -92,7 +92,7 @@ SUBROUTINE new_file_alarm(newFileAlarm, ierr, message) ! print progress if (masterproc) then - write(iulog,'(a,I4,4(x,I4))') new_line('a'), simDatetime(1)%year(), simDatetime(1)%month(), simDatetime(1)%day(), simDatetime(1)%hour(), simDatetime(1)%minute() + write(iulog,'(a,I4,4(1x,I4))') new_line('a'), simDatetime(1)%year(), simDatetime(1)%month(), simDatetime(1)%day(), simDatetime(1)%hour(), simDatetime(1)%minute() endif ! check need for the new file