Version 692

main.f - date change of revision;

The following changes were made to fix the rooting depth issue that was found in the HAWQS simulations.
(Email notes: We found that the limitation (example 2000.0 printed in the ‘input.std’ file when it was actually 2030.0 in the *.sol file) was coming from the ‘rdmx’ (max rooting depth; input in meters) in ‘plants.plt’.
Jeff wasn’t satisfied with the coding of this and has made a few changes in the SWAT code.

plantop.f -
These statements were commented:
!nly = sol_nly(j)
!sol_zmx(ihru) = sol_z(nly,j)
!plt_zmx = 1000. * rdmx(idplt(j))
!sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx)

readsol.f -
These statements were comments:
!if (sol_zmx(ihru) <= 0.001) sol_zmx(ihru) = sol_z(nly,ihru)
!plt_zmx = 0.
!if (idplt(ihru) > 0) then
! if (idc(idplt(ihru)) > 0) then
! plt_zmx = 1000. * rdmx(idplt(ihru))
! end if
!end if
!if (sol_zmx(ihru) > 1. .and. plt_zmx > 1.) then
! sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx)
!else
...
! sol_zmx(ihru) = Max(sol_zmx(ihru),plt_zmx)
!end if

swu.f - This whole section of code edited for the root depth problem;
real :: rdmax
...
if (idplt(j) > 0) then
rdmax = min (sol_zmx(j), 1000. * rdmx(idplt(j)))
else
rdmax = sol_zmx(j)
end if
...
sol_rd = 2.5 * phuacc(j) * rdmax
if (sol_rd > rdmax) sol_rd = rdmax
...
sol_rd = rdmax

routres.f - commented line change - mispelled reservoir;

Version 691

Summary of changes:
main.f - date of version change;

subbasin.f - change in computing the pet_day/ppet variable:

surface.f - correction in the argument in the following line (k should have been kk);

old: if (hrnopcp(sb,k) > 96) then ! four days
new: if (hrnopcp(sb,kk) > 96) then ! four days

Version 690

This version contains all the suggestions Doctor Fortran suggested
when Srin's staff found that the debug and release versions of
the model were not matching. The main culprit was with the EXPO
function, which was deleted and recoded with the EXP function. (NS - emails including subject 'Intel Fortran Compiler Optimization Difficulties' for more information and lists on suggestions).

allocate_parms.f - PPET for tropical growth added (Rev 689)

The following subroutines were edited to remove the EXPO function and an additional check was included in each occurrence (see notes):
alph.f
eiusle.f
etact.f
pgenhr.f
pkq.f

command.f - the input variable added in the ‘basins.bsn’ file for Srini’s simulations to read in previous run that SAVEed daily output in the fig.fig file.
input code variable name is : ISUB_SAV and if == 0, the model executes the subbasin command in fig.fig. If ISUB_SAV ==1, it does not.

hruallo.f - extended the number of management operations in the *.mgt file from 1000 to 2000;

modparm.f - added ISUB_SAV as integer;
deleted the function expo source code;

readbsn.f - added the read for new input variable in 'basins.bsn' file named ISUB_SAV; default == 0;

readfig.f - edited to be able to have unlimited save commands in the fig.fig file;
The unit numbers had to be changed to prevent affecting other files;

save.f - edit for unlimited number of save commands in fig.fig; previous limit was 10 commands;

virtual.f - changed function amax1 to max

    surqno3(j) = max(1.d-12,surqno3(j))
    latno3(j) = max(1.d-12,latno3(j))
    no3gw(j) = max(1.d-12,no3gw(j))
    surqsolp(j) = max(1.d-12,surqsolp(j))
    minpgw(j) = max(1.d-12,minpgw(j))
    sedorgn(j) = max(1.d-12,sedorgn(j))
    sedorgp(j) = max(1.d-12,sedorgp(j))
    sedminpa(j) = max(1.d-12,sedminpa(j))
    sedminps(j) = max(1.d-12,sedminps(j))

VERSIONS

@@ -1,3 +1,3 @@
 VERSION_MAJOR 2012
-VERSION_MINOR 689
+VERSION_MINOR 692
 VERSION_PATCH

src/allocate_parms.f

@@ -65,6 +65,8 @@ subroutine allocate_parms
       do ihru = 1, mhru
         allocate (ppet(ihru)%precip(ppet(ihru)%ndays))
         allocate (ppet(ihru)%pet(ppet(ihru)%ndays))
+        ppet(ihru)%precip = 0.
+        ppet(ihru)%pet = 0.
       end do
 
 !! Srini 11_1_22

src/alph.f

@@ -62,7 +62,7 @@ subroutine alph(iwave)
 !!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
 
 !!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
-!!    SWAT: Expo, Atri
+!!    SWAT: Exp, Atri
 
 !!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
 
@@ -101,7 +101,8 @@ subroutine alph(iwave)
           endif
 
           ajp = 0.
-          ajp = 1. - Expo(-125. / (preceff + 5.))
+          xx = (-125. / (preceff + 5.))
+          ajp = 1. - Exp(xx)
           if (ised_det == 0) then
           al5 = Atri(ab, amp_r(i_mo,hru_sub(j)), ajp, rndseed(idg(6),j))
           else
@@ -153,7 +154,8 @@ subroutine alph(iwave)
             endif
 
             ajp = 0.
-            ajp = 1. - Expo(-125. / (preceff + 5.))
+            xx = (-125. / (preceff + 5.))
+            ajp = 1. - Exp(xx)
             if (ised_det == 0) then
               al5 = Atri(ab, amp_r(i_mo,hru_sub(j)), ajp,               
      &                                                rndseed(idg(6),j))

src/command.f

@@ -129,8 +129,10 @@ subroutine command
           case (0)
             return
           case (1)
-            call subbasin
-            call print_hyd
+            if (isub_sav == 0) then
+              call subbasin
+              call print_hyd
+            end if
           case (2) 
             call route
             if (dtp_onoff(inum1)==1) call bmp_det_pond  !route detention pond J.Jeong feb 2010

src/eiusle.f

@@ -42,7 +42,7 @@ subroutine eiusle
 
 !!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
 !!    Intrinsic: Log, Log10
-!!    SWAT: Expo, Atri
+!!    SWAT: Exp, Atri
 
 !!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
 
@@ -63,7 +63,8 @@ subroutine eiusle
 
       preceff = precipday   !- snomlt - ovrlnd(j)
       if (preceff > 1.e-4) then
-        ajp = 1. - Expo(-125. / preceff)
+        xx = (-125. / preceff)
+        ajp = 1. - Exp(xx)
         xa = Atri(ab, amp_r(i_mo,hru_sub(j)), ajp, rndseed(idg(4),j))
         xb = -2. * Log(1. - xa)
         pkrf30 = 2. * preceff * xa

src/etact.f

@@ -102,7 +102,7 @@ subroutine etact
 
 !!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
 !!    Intrinsic: Exp, Min, Max
-!!    SWAT: Expo
+!!    SWAT: Exp
 
 !!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
 
@@ -263,7 +263,7 @@ subroutine etact
           evzp = evz
           if (sol_st(ly,j) < sol_fc(ly,j)) then
             xx =  2.5 * (sol_st(ly,j) - sol_fc(ly,j)) / sol_fc(ly,j)
-            sev = sev * Expo(xx)
+            sev = sev * Exp(xx)
           end if
           sev = Min(sev, sol_st(ly,j) * etco)
 

src/hruallo.f

@@ -113,7 +113,8 @@ subroutine hruallo
           read (10,6000) titldum
         end do
 
-        do kk = 1, 1000
+!!        do kk = 1, 1000
+        do kk = 1, 2000    !!!!!!!  nbs 8/25/23
           read (10,6300,iostat=eof) mgt_op, mgt1i
           if (eof < 0) exit
           if (mgt_op == 1) then

src/main.f

@@ -47,11 +47,10 @@ program main
 
       use parm
       implicit none
-      !prog = "SWAT Dec 1   VER 2022/Merge Rev 663/Rev 687"
-      prog = "SWAT May 10   VER 2023/Rev 689"
+      prog = "SWAT Nov 14  VER 2023/Rev 692"
       write (*,1000)
  1000 format(1x,"               SWAT2022               ",/,             
-     &          "               Rev. 688               ",/,             
+     &          "               Rev. 692               ",/,             
      &          "      Soil & Water Assessment Tool    ",/,             
      &          "               PC Version             ",/,             
      &          " Program reading from file.cio . . . executing",/)

src/modparm.f

@@ -11,8 +11,8 @@ module parm
         integer :: curday_mon = 0                     !!      |current day into the monsoon period
         integer :: ndays = 30                         !!      |number of days for precip/pet moving average
         real :: trig = 0.5                            !!mm/mm |precip/pet ratio to trigger plant/restart
-        real :: precip_sum                            !!mm    |sum of precip during moving average period
-        real :: pet_sum                               !!mm    |sum of pet during moving average period
+        real :: precip_sum = 0.                       !!mm    |sum of precip during moving average period
+        real :: pet_sum = 0.                          !!mm    |sum of pet during moving average period
         real, dimension (:), allocatable :: precip    !!mm    |precip dimensioned by ndays 
         real, dimension (:), allocatable :: pet       !!mm    |pet dimensioned by ndays 
         real :: rto = 0                               !!      |sum of precip/sum of pet
@@ -26,6 +26,7 @@ module parm
       real*8, dimension (:), allocatable :: tmp_win1, tmp_win2, 
      & tmp_sum1, tmp_sum2, tmp_spr1, 
      & tmp_spr2, tmp_fal1, tmp_fal2
+      integer :: isub_sav
 
       real*8 :: wtmp
       real*8, dimension (12) :: pcpmm        
@@ -1037,11 +1038,6 @@ real*8 function ee(tk) result (r_ee)
       real*8, intent (in) :: tk
       end
       
-      function expo (xx) result (r_expo)
-      real*8 :: xx
-      real*8 :: r_expo
-      end function
-      
 	real*8 Function fcgd(xx)
         real*8, intent (in) :: xx
       End function

src/pgenhr.f

@@ -65,7 +65,7 @@ subroutine pgenhr(jj)
 
 !!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
 !!    Intrinsic: Log
-!!    SWAT: Atri, Expo
+!!    SWAT: Atri, Exp
 
 !!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
 
@@ -81,14 +81,16 @@ subroutine pgenhr(jj)
       ab = 0.02083
       ajp = 0.
       al5 = 0.
-      ajp = 1. - Expo(-125. / (subp(jj) + 5.))
+      xx = (-125. / (subp(jj) + 5.))
+      ajp = 1. - Exp(xx)
       al5 = Atri(ab, amp_r(i_mo,hru_sub(jj)), ajp, rndseed(10,jj))
 
       !! need peak rainfall rate 
       !! calculate peak rate using same method as that for peak runoff
       altc = 0.
       pkrr = 0.
-      altc = 1. - Expo(2. * tconc(jj) * Log(1. - al5))
+      xx = (2. * tconc(jj) * Log(1. - al5))
+      altc = 1. - Exp(xx)
       pkrr = altc * subp(jj) / tconc(jj)           !! mm/h
 
 

src/pkq.f

@@ -39,7 +39,7 @@ subroutine pkq(iwave)
 !!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
 
 !!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
-!!    Intrinsic: Log, Expo
+!!    Intrinsic: Log, Exp
 
 !!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
 
@@ -56,12 +56,14 @@ subroutine pkq(iwave)
 
       if (iwave > 0) then
         !! subbasin sediment calculations
-        altc = 1. - Expo(2. * sub_tc(iwave) * Log(1. - al5))
+        xx = (2. * sub_tc(iwave) * Log(1. - al5))
+        altc = 1. - Exp(xx)
         peakr = altc * (sub_qd(iwave) + sub_tran(iwave)) / sub_tc(iwave) !! mm/h
         peakr = peakr * sub_km(iwave) / 3.6                              !! m^3/s
       else
         !! HRU sediment calculations
-        altc = 1. - Expo(2. * tconc(j) * Log(1. - al5))
+        xx = (2. * tconc(j) * Log(1. - al5))
+        altc = 1. - Exp(xx)
         peakr = altc * qday / tconc(j)           !! mm/h
         peakr = peakr * hru_km(j) / 3.6          !! m^3/s
       end if

src/plantop.f

@@ -90,10 +90,10 @@ subroutine plantop
       endif
 
       !! compare maximum rooting depth in soil to maximum rooting depth of plant
-      nly = sol_nly(j)
-      sol_zmx(ihru) = sol_z(nly,j)
-      plt_zmx = 1000. * rdmx(idplt(j))
-      sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx)
+      !nly = sol_nly(j)
+      !sol_zmx(ihru) = sol_z(nly,j)
+      !plt_zmx = 1000. * rdmx(idplt(j))
+      !sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx)
 
       !! reset curve number if given in .mgt file
       if (cnop > 0.) call curno(cnop,j)

src/readbsn.f

@@ -381,6 +381,7 @@ subroutine readbsn
       eof = 0
       escobsn = 0.
       epcobsn = 0.
+      isub_sav = 0
       r2adj_bsn = 0.  !D. Moriasi 4/8/2014
       wwqfile = ""
       numlu=1
@@ -606,8 +607,11 @@ subroutine readbsn
       read (103,*,iostat=eof) sfsedmean
       if (eof < 0) exit   
       read (103,*,iostat=eof) sfsedstdev
+      if (eof < 0) exit
       read (103,*,iostat=eof) salt_num
       if (eof < 0) exit
+      read (103,*,iostat=eof) isub_sav
+      if (eof < 0) exit
       exit
 !!    Drainmod input variables - 01/2006
       end do

src/readfig.f

@@ -282,19 +282,19 @@ subroutine readfig
               day_in = ""
               read (102,5100) day_in
               call caps(day_in)
-              if (inum1s(idum) <= 10 .and. inum1s(idum) > 0) then
-                open (40+inum1s(idum),file=day_in,recl=350)
+              !if (inum1s(idum) <= 10 .and. inum1s(idum) > 0) then
+                open (30000+inum1s(idum),file=day_in,recl=350)
                 if (inum3s(idum) == 0) then
-                  write (40+inum1s(idum),5400) title
-                  write (40+inum1s(idum),5500)
+                  write (30000+inum1s(idum),5400) title
+                  write (30000+inum1s(idum),5500)
                 else
                   iida = 0
                   iida = idaf
                   call xmon
-                  write (40+inum1s(idum),5501) iyr, i_mo,               
+                  write (30000+inum1s(idum),5501) iyr, i_mo,               
      &                                              (iida - ndays(i_mo))
                 end if
-              end if
+              !end if
 
             case (10) !! icode = 10  RECDAY command: read in daily values
                       !! with water in cms and rest in tons

src/readfile.f

@@ -693,6 +693,15 @@ subroutine readfile
           write (142,4998)
  4998    format(t17,'AVE WATER',/,t3,'Day',t7,'Year',t18,'DEPTH(m)')
       end if
+
+!!!!!open Srin/Arun new output file from subbasin.f (monsoon_plt.out)      
+      open (144, file="monsoon_plt.out", recl=600)
+         write (144, 1999)
+1999     format(2x,'Sub',2x,'Hru',2x,'Year',3x,'Mon',3x,'Day',
+     *'   AREAkm2', 13x,'CPNM', 4x, "      PLANT", 
+     *'   PRECIPD ', '  PET_DAY ', '      RTO', ' PRECIPSUM', '   PET_SUM ',
+     *'   SOL_SW',/,70x,'     (mm)  ','    (mm)  ',10x,'  (mm)    ', '    (mm) ','     (mm)  ')
+ !!!!!open Srin/Arun new output file from subbasin.f
 
 !! Code for output.mgt file
 !  0=no print 1=print

src/readpnd.f

@@ -599,9 +599,9 @@ subroutine readpnd
       read (104,*,iostat=eof) (lid_lus(k),k=1,mudb)
       if (eof < 0) exit
 	nlid(i)=1
-      do while (is_numeric(lid_lus(nlid(i))) .eqv. .TRUE.)
+      !do while (is_numeric(lid_lus(nlid(i)))== .TRUE.)
  		nlid(i)=nlid(i) + 1
-      END DO
+      !END DO
 	nlid(i) = nlid(i) - 1
 	backspace(104)
 	backspace(104)

src/readsol.f

@@ -188,19 +188,19 @@ subroutine readsol
 
 !!    compare maximum rooting depth in soil to maximum rooting depth of
 !!    plant
-      if (sol_zmx(ihru) <= 0.001) sol_zmx(ihru) = sol_z(nly,ihru)
-      plt_zmx = 0.
-	if (idplt(ihru) > 0) then
-	   if (idc(idplt(ihru)) > 0) then
-           plt_zmx = 1000. * rdmx(idplt(ihru))
-	   end if
-      end if
-      if (sol_zmx(ihru) > 1. .and. plt_zmx > 1.) then
-         sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx)
-      else
+      !if (sol_zmx(ihru) <= 0.001) sol_zmx(ihru) = sol_z(nly,ihru)
+      !plt_zmx = 0.
+	!if (idplt(ihru) > 0) then
+	!   if (idc(idplt(ihru)) > 0) then
+      !     plt_zmx = 1000. * rdmx(idplt(ihru))
+	!   end if
+      !end if
+      !if (sol_zmx(ihru) > 1. .and. plt_zmx > 1.) then
+      !   sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx)
+      !else
          !! if one value is missing it will set to the one available
-         sol_zmx(ihru) = Max(sol_zmx(ihru),plt_zmx)
-      end if
+      !   sol_zmx(ihru) = Max(sol_zmx(ihru),plt_zmx)
+      !end if
 
 !! create a layer boundary at maximum rooting depth (sol_zmx)
       !if (sol_zmx(i) > 0.001.and.sol_zmx(ihru)/=sol_z(nly,ihru)) then

src/routres.f

@@ -48,7 +48,7 @@ subroutine routres
 !!    res_seci(:) |m             |secchi-disk depth
 !!    res_sub(:)  |none          |number of subbasin reservoir is in
 !!    res_vol(:)  |m^3 H2O       |reservoir volume
-!!    reschlao    |kg chl-a      |amount of chlorophyll-a leaving reaservoir
+!!    reschlao    |kg chl-a      |amount of chlorophyll-a leaving reservoir
 !!                               |on day
 !!    resev       |m^3 H2O       |evaporation from reservoir on day
 !!    resflwi     |m^3 H2O       |water entering reservoir on day