Merge from 2012rev681

Author: crazyzlj

VERSIONS

@@ -1,3 +1,3 @@
 VERSION_MAJOR 2012
-VERSION_MINOR 670
+VERSION_MINOR 681
 VERSION_PATCH

src/apex_day.f

@@ -119,7 +119,7 @@ subroutine apex_day
 !!    changes for Mike Winchell if apex.swt files has a different start date than the SWAT run
       if (ifirsta(inum1) == 1) then
         do 
-          read (112+inum1,*) idapa(inum1), iypa(inum1), flodaya(inum1),
+          read (400+inum1,*) idapa(inum1), iypa(inum1), flodaya(inum1),
      & seddaya(inum1), orgndaya(inum1), orgpdaya(inum1), no3daya(inum1),
      & minpdaya(inum1)
 	    if(idapa(inum1) == id1 .and. iypa(inum1) == iyr) exit
@@ -149,7 +149,7 @@ subroutine apex_day
          varoute(21,ihout) = 0.0      
          varoute(22,ihout) = 0.0 
          if (curyr /= nbyr .and. iida /= idal) then
-           read (112+inum1,*) idapa(inum1), iypa(inum1), flodaya(inum1),
+           read (400+inum1,*) idapa(inum1), iypa(inum1), flodaya(inum1),
      & seddaya(inum1), orgndaya(inum1), orgpdaya(inum1), no3daya(inum1),
      & minpdaya(inum1)
          endif

src/carbon_new.f

@@ -238,7 +238,7 @@ real*8 Function fnetmin(poold, R1, R2, hc, dummy, poolm, xinorg, cc1)
         else
           NPsoil = (sol_mass * sol_n(k,j) / 100.)/ sol_orgp(k,j)
         end if
-        sol_orgp(k,j) = dmin1(sol_orgp(k,j), 25.)
+        !sol_orgp(k,j) = dmin1(sol_orgp(k,j), 25.)  !commented 110118 Armen K
         CPsoil = CNsoil * NPsoil
 
         if (sol_rsd(k,j) > 0.00001) then

src/command.f

@@ -169,7 +169,7 @@ subroutine command
           case (13) 
             call apex_day
           case (14)
-            call saveconc
+            if (curyr > nyskip) call saveconc
           case (17)
             call routeunit
             call sumhyd

src/filter.f

@@ -313,7 +313,7 @@ subroutine filter
 	if (remove1 > 100.) remove1 = 100.
 	if (remove1 < 0.) remove1 = 0.
 
-	remove21 = 29.3 + 0.51 * surq_remove2
+	remove2 = 29.3 + 0.51 * surq_remove2
 	if (remove2 > 100.) remove2 = 100.
 	if (remove2 < 0.) remove2 = 0.
 

src/hhnoqual.f

@@ -157,7 +157,8 @@ subroutine hhnoqual
          cbodcon = 0.
          o2con = 0.
          wtrtot = wtrin + hrchwtr(ii)
-         if (ii == 1) then
+         if (wtrtot > 0.01) then
+          if (ii == 1) then
          algcon = (algin * wtrin + algae(jrch) * hrchwtr(ii)) / wtrtot
          orgncon = (orgnin * wtrin + organicn(jrch) * hrchwtr(ii))      
      &                                                          / wtrtot
@@ -185,9 +186,10 @@ subroutine hhnoqual
          solpcon = (dispin * wtrin + hsolp(ii-1) * hrchwtr(ii)) / wtrtot
          cbodcon = (cbodin * wtrin + hbod(ii-1) * hrchwtr(ii)) / wtrtot
          o2con = (disoxin * wtrin + hdisox(ii-1) * hrchwtr(ii)) / wtrtot
+          end if
          end if
 
-         if (algcon < 1.e-6) algon = 0.0
+         if (algcon < 1.e-6) algcon = 0.0
          if (orgncon < 1.e-6) orgncon = 0.0
          if (nh3con < 1.e-6) nh3con = 0.0
          if (no2con < 1.e-6) no2con = 0.0

src/hhwatqual.f

@@ -241,7 +241,7 @@ subroutine hhwatqual
        wtrin = 0.
        wtrin = hhvaroute(2,inum2,ii) * (1. - rnum1)
 
-       if (hrtwtr(ii) / (idt * 60.) > 0.01) then
+       if (hrtwtr(ii) / (idt * 60.) > 0.01.and.hdepth(ii) > 0.01) then
 !! concentrations
          !! initialize inflow concentrations
          chlin = 0.
@@ -275,7 +275,7 @@ subroutine hhwatqual
          if (ammoin < 1.e-6) ammoin = 0.0
          if (nitritin < 1.e-6) nitritin = 0.0
          if (nitratin < 1.e-6) nitratin = 0.0
-         if (orgnpin < 1.e-6) orgnpin = 0.0
+         if (orgpin < 1.e-6) orgpin = 0.0
          if (dispin < 1.e-6) dispin = 0.0
          if (cbodin < 1.e-6) cbodin = 0.0
          if (disoxin < 1.e-6) disoxin = 0.0
@@ -292,7 +292,8 @@ subroutine hhwatqual
          cbodcon = 0.
          o2con = 0.
          wtrtot = wtrin + hrchwtr(ii)
-         if (ii == 1) then
+         if (wtrtot > 0.01) then
+          if (ii == 1) then
          algcon = (algin * wtrin + algae(jrch) * hrchwtr(ii)) / wtrtot
          orgncon = (orgnin * wtrin + organicn(jrch) * hrchwtr(ii))      
      &                                                          / wtrtot
@@ -320,8 +321,8 @@ subroutine hhwatqual
          solpcon = (dispin * wtrin + hsolp(ii-1) * hrchwtr(ii)) / wtrtot
          cbodcon = (cbodin * wtrin + hbod(ii-1) * hrchwtr(ii)) / wtrtot
          o2con = (disoxin * wtrin + hdisox(ii-1) * hrchwtr(ii)) / wtrtot
-         end if
-
+          end if
+         endif
          if (algcon < 1.e-6) algcon = 0.0
          if (orgncon < 1.e-6) orgncon = 0.0
          if (nh3con < 1.e-6) nh3con = 0.0

src/hmeas.f

@@ -103,8 +103,9 @@ subroutine hmeas
 	  end do
 
       return
-! 5200 format (7x,300f8.3)
-! 5300 format (i4,i3,300f8.3)
- 5200 format (7x,1800f8.3)
- 5300 format (i4,i3,1800f8.3)
+
+ !5200 format (7x,1800f8.3)
+ !5300 format (i4,i3,1800f8.3)
+ 5200 format (7x,1900f8.3)             !! for Pouya
+ 5300 format (i4,i3,1900f8.3)          !! for Pouya
       end

src/main.f

@@ -47,10 +47,10 @@ program main
 
       use parm
       implicit none
-      prog = "SWAT Sep 7    VER 2018/Rev 670"
+      prog = "SWAT May 26   VER 2020/Rev 681"
       write (*,1000)
- 1000 format(1x,"               SWAT2018               ",/,             
-     &          "               Rev. 670               ",/,             
+ 1000 format(1x,"               SWAT2020               ",/,             
+     &          "               Rev. 681               ",/,             
      &          "      Soil & Water Assessment Tool    ",/,             
      &          "               PC Version             ",/,             
      &          " Program reading from file.cio . . . executing",/)
@@ -77,6 +77,8 @@ program main
       call std2
       call openwth
       call headout
+      
+      !call sw_init
 
       !! convert integer to string for output.mgt file
       subnum = ""

src/nrain.f

@@ -69,7 +69,7 @@ subroutine nrain
            no3pcp = .01 * rcn_d(hru_sub(j)) * precipday
            sol_nh3(2,j) = sol_nh3(2,j) + nh3pcp  + 
      &             drydep_nh4_d(hru_sub(j))
-           sol_no3(2,j) = sol_no3(2,j) + no2pcp +
+           sol_no3(2,j) = sol_no3(2,j) + no3pcp +
      &             drydep_no3_d(hru_sub(j))
       end select
 

src/openwth.f

@@ -93,19 +93,19 @@ subroutine openwth
 
         if (slrfile /= '             ') then
    !!       open (137,file=slrfile,recl=800)
-          open (137,file=slrfile,recl=15000)
+          open (137,file=slrfile,recl=16000)
           read (137,5000) titldum
         end if
 
         if (rhfile /= '             ') then
   !!        open (138,file=rhfile,recl=800)
-          open (138,file=rhfile,recl=15000)
+          open (138,file=rhfile,recl=16000)
           read (138,5000) titldum
         end if
 
         if (wndfile /= '             ') then
    !!       open (139,file=wndfile,recl=800)
-          open (139,file=wndfile,recl=15000)
+          open (139,file=wndfile,recl=16000)
           read (139,5000) titldum
         end if
 

src/potholehr.f

@@ -444,7 +444,7 @@ subroutine potholehr()
           if (iprint==3) then
 		  write (125,2000)i,j,curyr,k,pot_vol(j),potsa(j),spillo,potsep,   
      &       potev,sol_sw(j),potpcpmm,potflwi(j) / cnv,               
-     &       potsedi(j) / hru_ha(j),potflow,potsedo / hru_ha(j)
+     &       potsedi(j) / hru_ha(j),potflwo,potsedo / hru_ha(j)
           endif
 		  
         if (pot_vol(j) > 1.e-6) then

src/readatmodep.f

@@ -43,7 +43,7 @@ subroutine readatmodep
       if (atmofile /= '             ') then
         open (127,file=atmofile)
           do iii = 1, 5
-            read (127,*) titldum
+            read (127,5101) titldum
           end do
       else
       !!    no filename present in file.cio - set defaults
@@ -89,6 +89,6 @@ subroutine readatmodep
 !1001  format (3i6)
 !1002  format (1200f10.3)  
 !1000  format (8x,4f10.3)
-!5101  format (a80)
+5101  format (a80)
       return
       end

src/readfig.f

@@ -325,9 +325,9 @@ subroutine readfig
 	      call caps(apex_in)
       !      i = 0
       !      i = inum1s(idum)
-            open (112+inum1s(idum),file=apex_in,recl=350)
-	      do ii = 1, 10 
-              read (112+inum1s(idum),5200) titldum
+            open (400+inum1s(idum),file=apex_in,recl=350)
+	      do ii = 1, 9 
+              read (400+inum1s(idum),5200) titldum
             end do
 !! code to read from apex output file
 

src/readops.f

@@ -95,7 +95,7 @@ subroutine readops
           do
           mon = 0
           day = 0
-          year = 0.
+          iyear = 0.
           mgt_op = 0
           mgt1i = 0
           mgt2i = 0
@@ -203,7 +203,7 @@ subroutine readops
           ro_bmp_flos(iops,ihru) = mgt10  !! Flow
 		ro_bmp_seds(iops,ihru) = mgt11  !! Sediment
 		ro_bmp_pps(iops,ihru) = mgt12   !! Particulate P
-		ro_bmp_sps(iops,ihru) = mg13    !! Soluble P
+		ro_bmp_sps(iops,ihru) = mgt13    !! Soluble P
 		ro_bmp_pns(iops,ihru) = mgt14   !! Particulate N
 		ro_bmp_sns(iops,ihru) = mgt15   !! Soluble N
 		ro_bmp_bacs(iops,ihru) = mgt16  !! Bacteria

src/readpnd.f

@@ -276,7 +276,7 @@ subroutine readpnd
       read (104,5100,iostat=eof) titldum
       if (eof < 0) exit
       if (titldum == '             '.or.titldum == 'Inputs used in')then 
-        vselsetlpnd = 10.0
+        velsetlpnd = 10.0
       else
         backspace 104
         read (104,*,iostat=eof) pnd_d50

src/rechour.f

@@ -195,6 +195,9 @@ subroutine rechour
       varoute(27,ihout) = varoute(27,ihout) + sedhr * 0.   ! lag
       varoute(28,ihout) = 0.                    ! gravel
 
+      
+      QHY(ii,ihout,IHX(1)) = hhvaroute(2,ihout,ii) / (dthy * 3600.) !added by Jaehak for subdaily routing, 2019
+
       end do
 
       return

src/route.f

@@ -136,6 +136,7 @@ subroutine route
       if (ievent > 0) then
         do ii = 1, nstep
           hrtwtr(ii) = hrtwtr(ii) + qdbank / dfloat(nstep)
+          hsdti(ii) = max(0.,hrtwtr(ii) / (dthy * 3600.)) !m3 -> m3/s
         end do
       end if
 

src/rtday.f

@@ -159,13 +159,9 @@ subroutine rtday
         !! calculate volume of water leaving reach on day
         scoef = 0.
  	  rtwtr = 0.
-        !scoef = 2. * det / (2. * rttime + det)
         scoef =  det / (rttime + det)
         if (scoef > 1.) scoef = 1.
         rtwtr = scoef * (wtrin + rchstor(jrch))
-        !new storage coefficient replacement
-        rtwtr = vc * rcharea * 86400.
-        rtwtr = dmin1 (rtwtr, wtrin)
 
 !! calculate amount of water in channel at end of day
       rchstor(jrch) = rchstor(jrch) + wtrin - rtwtr

src/rthmusk.f

@@ -124,6 +124,7 @@ subroutine rthmusk
 
       jrch = 0
       jrch = inum1
+      hrtevp = 0
 
  !! Compute storage time constant for reach
       xkm = 0.