!WB  THIS IS THE LATEST VERSION OF THE LARGE WATERSHED MODEL
!WB  AS OF 19 AUG 1999 FWB.  IT IS INTENDED TO BE IDENTICAL TO THE 
!WB  STANDARD MODEL EXCEPT THAT IT HAS THE CAPABILITY TO SIMULATE
!WB  35000 CELLS, 30 SOIL TYPES, AND 40 RAINGAGES WITH 100 VALUES
!WB  PER GAGE.  IT IS A BETA RELEASE!
!WB  THIS VERSION INCLUDES CRITICAL SHEAR DETACHMENT COMPONENTS FOR 
!WB  FLOW DETACHMENT, AN UPDATED RAINFALL DETACHMENT COMPONENT, AND
!WB  A CHANNEL EROSION COMPONENT.  30 SOIL TYPES ARE AVAILABLE TO 
!WB  ACCOMODATE THE INCLUSION OF CHANNEL SOILS.
*
!WB	19 AUG 1999 UPDATES THE HYDROGRAPH TO INCLUDE ALL NUTRIENT 
!WB	SPECIES IN SEDIMENT-BOUND AND DISSOLVED FORM, OUTPUT IN PPM.
*
!WB	14 AUG 1999 REINSTATES THE HYDROGRAPH PRINT OPTION.
*
!WB	8 AUG 1999 FIXES THE FOLLOWING LINE (LINE # 1817 AT THE TIME)
!WB	IF(FIL.LT.0) FIL=0.0, THE LINE ORIGINALLY STATED THAT IF 
!WB	(FIL.LT.O), OR LT THE LETTER O
!WB	ALSO, IN SUBROUTINE RAINFA, THE NCHAN VAR WASN'T DEFINED
!WB	BEFORE IT WAS USED, AND SO THE ARGUMENT NCHAN WAS ADDED TO
!WB	THE SUBROUTINE CALL
*
*
!WB	27 JULY 1999 FIXES THE RILLWID GT RILLSPACING ERROR MESSAGE
!WB	PREVIOUSLY IT DIDN'T CONTAIN THE CELL #, RILLWID, RILLSPACING
*
*
!WB  7/14/99 RELEASE FIXES A LT/GE ERROR IN THE SDR CALCULATION
!WB  FOR PARTICLES LT 0.002 AND RR GT 150


*THIS VERSION INCLUDES SEDIMENT BOUND ORGANIC NITROGEN
* AND SEDIMENT BOUND AND SOLUBLE AMMONIUM

** NRZ (7/22/94)
*  THIS VERSION ELIMINATES P,PH,RALPHA,RBETA, AND RGAMA FROM THE INPUT
*  FILE.  P(20), RALPHA(20), AND RGAMA(20) ARE ALSO REMOVED FROM THEIR 
*  RESPECTIVE COMMON STATEMENTS. RBETA IS STILL USED.
*
*  9/11/94
*  THIS VERSION HAS THE ABILITY TO ACCEPT MULTIPLE CHANNEL NETWORKS
*  IN THE INPUT FILE AND PRODUCES AN OUTPUT FILE FOR EACH CHANNEL.
*
*  (11/3/94)
*  THIS VERSION CONTAINS AN OPTION TO ENTER SATURATED HYDRAULIC 
*  CONDUCTIVITY AS AN INDEPENDENT INPUT.  THE INPUT FILE HAS BEEN
*  REVISED TO ACCOMODATE THIS FEATURE.
*
*  THIS VERSION UTILIZES A SEPARATE INPUT FILE FOR FERTILIZER
*  APPLICATIONS.  AN ADDITIONAL INPUT FILE HAS BEEN ADDED AND THE MAIN
*  INPUT FILE HAS BEEN MODIFIED.
*
*  A MODIFIED SCREEN OUTPUT INDICATES CALENDAR MONTH AND DAY, RAIN
*  EVENTS, AND FERTILIZER APPLICATIONS
*
*  10/12/94
*  THIS VERSION CONTAINS A CORRECTION TO THE NITRIFICATION ALGORITHM
*  TO ACCOUNT FOR FERTILIZER APPLICATIONS LESS THAN 20 DAYS BEFORE A
*  ROTATION.
*
*  THIS VERSION CONTAINS AN OPTION TO PLACE AN IMPOUNDMENT AT THE END
*  OF ANY CHANNEL NETWORK.  THE NECESSARY STRUCTURAL DATA MUST BE 
*  INCLUDED IN THE INPUT FILE.
*
*  THIS VERSION ALLOWS THE USER TO ENTER A MEASURED VALUE OF SATURATED
*  HYDRAULIC CONDUCTIVITY.
*
*  7/29/95
*  THIS VERSION ADDS THE CAPABILITY TO INCLUDE 28 ROTATION END DATES AS
*  OPPOSED TO THE PREVIOUS 20
* 

C***********************************************************************
C***********************************************************************
C***********************************************************************
C*****                                                            ******
C*****                                                            ******
C*****                      A N S W E R S                         ******
C*****                                                            ******
C*****            (AREAL NONPOINT SOURCE WATERSHED                ******
C*****            ENVIRONMENT RESPONSE SIMULATION)                ******
C*****                                                            ******
C*****                                                            ******
C*****  DISTRIBUTED PARAMETER MATHEMATICAL MODEL OF A RAINFALL    ******
C*****  EVENT ON A CATCHMENT, WITH EROSION AND DEPOSITION AS A    ******
C*****  FUNCTION OF  PARTICLE SIZE.                               ******
C*****                                                            ******
C*****                                                            ******
C*****  AUTHORS:  D. B. BEASLEY, L. F. HUGGINS, AND J. R. BURNEY  ******
C*****                                                            ******
C*****   AGRICULTURAL ENGINEERING DEPARTMENT, PURDUE UNIVERSITY   ******
C*****             WEST LAFAYETTE, INDIANA  47907                 ******
C*****                                                            ******
C*****                                                            ******
C*****  AUTHORS: THEO DILLAHA                                     ******
C*****           DEVELOPMENT OF EXTENDED SEDIMENT MODEL           ******
C*****           LAST MODIFY DATE: SEPTEMBER 1, 1981              ******
C*****                                                            ******
C*****           INCORPORATION OF EXTENDED SEDIMENT MODEL BY      ******
C*****           DILLAHA INTO CURRENT ANSWERS MODEL FOR FORTRAN   ******
C*****           77 COMPILER FOR VIRGINIA TECH SYSTEM.            ******
C*****           FEBRUARY 17, 1986.                               ******
C*****                                                            ******
C*****     AGRICULTURAL ENGINEERING DEPARTMENT, VIRGINIA TECH     ******
C*****          BLACKSBURG, VIRGINIA  24061  540-961-6813         ******
C*****                                                            ******
C*****                                                            ******
C*****                                                            ******
C*****                                                            ******
C***********************************************************************
C***********************************************************************
C***********************************************************************
C*****                                                            ******
C*****                                                            ******
C*****                                                            ******
C*****    THIS VERSION OF ANSWERS CONTAINS:                       ******
C*****                                                            ******
C*****    1) 35000 CELL CAPABILITY                                ******
C*****    2) 3-PER-PASS ALGORITHM                                 ******
C*****    3) IMPROVED DATA VERIFICATION DIAGNOSTICS               ******
C*****    4) STRUCTURAL PRACTICES                                 ******
C*****    5) MODIFIED INPUT FORMATS (SEE USER'S MANUAL)           ******
C*****    6) MODIFIED DETACHMENT AND TRANSPORT RELATIONSHIPS      ******
C*****    7) MODIFIED OUTPUT FORMATS                              ******
C*****                                                            ******
C***********************************************************************
C***********************************************************************
C
C
!WB***********************************************
!WB***********************************************
!WB*****	
!WB*****	When the comment indicator is !WB 
!WB*****	it indicates that the comment was 
!WB*****	inserted by Wes Byne in FALL 1998,
!WB*****  or SPRING 1999.
!WB*****
!WB***********************************************
!WB***********************************************

!TMN *********************************************
!TMN		COMMENTS INITALIZED TMN INDICATES
!TMN		ADDED BY TONE MERETE NORBDERG
!TMN		SPRING 2000
!TMN *********************************************

C ****** DISTRIBUTED PARAMETER MATHEMATICAL MODEL OF A RAINFALL
C ****** EVENT ON A CATCHMENT, WITH EROSION AND DEPOSITION.
C
      IMPLICIT DOUBLE PRECISION A-H,O-Z
C
C **** MAXIMUM NUMBER OF SOIL TYPES IS 30.
C
      
	COMMON /CSOIL/ A(30),FC(30),GWC(30)
      COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     & ,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &  CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &  THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &  CRC(30),KE(30,30),ZC(30),BD(30)
      DOUBLE PRECISION KS,LF,KE
!      COMMON /ETPES/LAI(20,11),ESU(30),LAI1(20),POTLAI(20),EDX(20)
!     &,SUMLAI(20)
      COMMON /ETPES/LAI(20,11),ESU(30),LAI1(20),POTLAI(20)
     &,SUMLAI(20)
	COMMON /EDX/ EDX(30)
      DIMENSION S1EP(35000),S2EP(35000),TTIME(35000),PEP(35000),
	1ES(35000)
      DOUBLE PRECISION LAI,LAI1
      COMMON /ASMF/ ASMBF(30),FCAP1(30),TP1(30),RESWAT(30),DF1(30)
	INTEGER DAYBEG,SIMDUR,TEMPC,SOITEM,RADI,RAITES,YERBEG,RNUT
 
      COMMON /ROT/ IROT1,IROT(20,644)
      INTEGER IROT1,IROT
 
C *** NRZ 9/15/94
C *** CHANGED DIMENSION OF SOME VARIABLES TO CORRESPOND WITH
C *** NMAX+ISTRUC+1+NCHAN

      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
 
      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)
 
 
      COMMON/NITRO2/ O0SOIL(35000),ONPT(35000,8),ONI(35050,8),
     & ONSEL(35000),ON2(8),ONCELL(35000,8),ONE(8),ON0(35000,8)

C *** NRZ 9/15/94
 
      COMMON /PLANTN/DATPLA(20),DATHAR(20),CP1(20),CP2(20),DMY(20)
     &   ,YP(20),ROTMAX(20),ROTDAY(20),RLAIMX(20)
     &   ,RES(20),RES20(20),RES90(20)
      INTEGER DATPLA,DATHAR,ROTMAX,ROTDAY
 
C **** NRZ 9/14/94
C **** CHANGE DIMENSIONS TO ACCOMODATE MULTIPLE OUTLETS
C **** AND DIMENSION OTHERS

       DIMENSION PSSI(101,10),SPSSI(101,10),ANSSI(101,10),ONSSI(101,10)
     & ,ANH4SI(101,10),ANO3SI(101,10)
       DIMENSION SIG(10),VOL(10),PSIG(10),ANSIG(10),ONSIG(10),XS(10),
     & VOL1F(10),VOL1X(10),RNO3(10),RNH4S(10),RNH4SE(10),RPHOS(10),
     & RORGN(10),RSEDP(10),SPT(10),PSPT(10)

C **** NRZ 9/14/94
	
      COMMON /CUMIN/ CUMIN1(35000),rbit0(35000),testi(35000)
     & ,timpon(35000),tpon(35000)

C **** NRZ 9/15/94 
C **** CHANGED DIMENSIONS OF SOME VARIABLES TO CORRESPOND WITH
C **** NMAX+ISTRUC+1+NCHAN

      COMMON /SOLUB/ SP2(35000),PEXT(35000),PK(30)
     & ,RBETA(30),SPI(35050),CGEN1(35000)
     & ,T13(35000),SPSP(35000)

      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)
 
      COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)

C **** NRZ 9/15/94
 
      COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL

C
C **** MAXIMUM NUMBER OF SURFACE AND CROP TYPES IS 20.
C
      COMMON /CROUGH/ ROUGH(20),HU(20),DIR(21),PIT(40,20),PER(20)
C
C **** MAXIMUM NUMBER OF RAINGAGES IS 40 WITH 200 VALUES PER GAGE.
C
	COMMON /CRGAGE/ RC(40,200),TC(40,200),R(40,21),FRA(40),JTR(40),
	1RATE(40),SR(40),NF(40),RATE2(40)
C
C .... PARAMETERS USED IN THE EXTENDED SED SUBROUTINE
C
      COMMON /ZSEDI/ NPART,NWASH,NWASH1
      COMMON /ZSEDR/ VISCOS,AGRAV,SWH2O,YALCON,SE(8),VS(35000),DIA(8),
     1SG(8),FV(8),CY1(8),CY2(8),CY4(8),DIAMM(8),EQSDIA(8),EDMM(8),
     2F(30,8),CE1,CE2,CE3,CE4,CE5,CE6
!WB	Changed F(10,8) to F(30,8) to accomodate 30 soil types
C
C **** MAXIMUM NUMBER OF OVERLAND ELEMENTS PLUS CHANNEL ELEMENTS
C **** IS 35000 = NMAX.


C ****** NRZ 9/15/94
C ****** DUE TO ADDITION OF MULTIPLE OUTLETS, SI AND QI (AS WELL AS 
C ****** OTHER ARRAYS ORIGINALLY USING THE VARIABLE NN AS AN ELEMENT
C ****** OF THE ARRAY) MUST BE DIMENSIONED TO NMAX+ISTRUC+1+NCHAN

      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
C *** NRZ
C *** ADD COMMON BLOCK FOR PERCENTAGE OF CELL AREA "LEAKING" OUTSIDE THE
C *** WATERSHED

      COMMON /LEAKY/ OUTSID

C *** NRZ 9/15/94
C
C ****** ARRAYS SI AND QI MUST BE DIMENSIONED TO A SIZE = NMAX+ISTRUC+2
C ****** TO HOLD, IN ORDER, SEDIMENT AND FLOW FROM THE WATERSHED OUTLET
C ****** ELEMENT, STRUCTURAL PRACTICES AND ANY "LEAKY" ELEMENTS.
C
      DIMENSION FILTS(35000), CWID(35000),CWIDTMP(35000)
      COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
      INTEGER SUR,TIAL(35000),RANE,SOIL      
      DIMENSION ASMVOL(35000),ASMLIM(30),SOIVOL(30)
     & ,FCVOL(30),WP(30),RATEMX(30)
c	  fert array changed from 20 to 99: JLCollado, oct-97 
!WB	CHANGED REMAINING VARIABLES TO ACCOUNT FOR 30 SOIL TYPES
      DIMENSION RNUTNI(99),RNUTAM(99),RNUTP(99)

C *** NRZ 9/12/94
C *** ADD VARIABLES FOR FERTILIZER FILE
c      dimension changed from 20 to 99 
      COMMON /FERT/ IFERT
      DIMENSION TMPNI(99),TMPAM(99),TMPP(99)

C *** ADD COMMON BLOCK FOR NITRIFICATION CORRECTION

      COMMON /YEAR/ LDYEAR

C *** ADD COMMON BLOCK FOR EXTRA OUTPUT OPTIONS

      COMMON /XPRINT/ NSBS,NPDAY(10)
      CHARACTER*7 XPFIL(10)

C *** NRZ 9/12/94
 
      COMMON /ASMP/ASMPER(35000)
      COMMON /TRANSF/POTMIN(35000),SOILN(35000),XMIN(35000),AMON(35000)
     & ,NIT(35000),DNI(35000),UPNH4(35000),UPNO3(35000),TDMN2(35000),
     & ROTR(35000),RFON(35000)
      DOUBLE PRECISION XMIN,NIT
      COMMON /TRAP/PMINP(35000),SOILP(35000),MINP(35000),PLAB(35000),
     &  UPPHOS(35000),TDMP2(35000),SORGP(35000),PSOL(35000),
     &  EDILAB(35000)
      DOUBLE PRECISION MINP
      COMMON /PARTITION/PKDA(30),PKDP(30),PSP(30)
!WB	CHANGED ARRAY SIZES TO 30 
C
C **** NUMBER OF PRINT AND PLOT POINTS IS 101 MAXIMUM.
C
C **** NRZ 9/14/94
C **** CHANGE DIMENSION OF CERTAIN VARIABLES TO ACCOUNT FOR MULTIPLE
C **** CHANNEL OUTLETS

      DIMENSION T(101),Q1(101,10),RW(101,10),SSI(101,10), 
     & SSCON(101,10),ER(8)

C **** ADDED VARIABLES FOR CHANNEL NETWORKS
 
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)
      INTEGER CHNUM,CHOUT,CHNUMBER

C **** NRZ 9/14/94



      DIMENSION PP(14), QA(30000), TT(20)
      CHARACTER*4 PP, TT
      DATA PP(1),PP(2),PP(3),PP(4),PP(5),PP(6),PP(7),PP(8),PP(9),PP(10),
     1PP(11),PP(12),PP(13),PP(14)/' IN.','/HR.',' AC.',' FT.',' LB.',
     2' PPM','/AC ','  MM','/H  ',' HA ',' M  ','  KG','MG/L','/HA '/

C **** NRZ (8/29/94)
C **** NEW VARIABLES AND COMMON BLOCKS FOR IMPOUNDMENT MODEL

      COMMON /IMPDIM/ BASE,WIDTH,SLOPE,ORIF,CI,FI,MAXHGT,NIMP
      DOUBLE PRECISION BASE(10),WIDTH(10),SLOPE(10),ORIF(10),CI(10),
     &FI(10),MAXHGT(10)

      COMMON /FWATER/ AFWEV,DFWEV

      DIMENSION SEDG(10,8),SEDH(10,101,8)

      DOUBLE PRECISION ONSEDG(10,8),ONSEDH(10,101,8),ONSEDI(10,8),
     &ONSEDO(10,8),ONSEDT(10)

      DIMENSION PSEDG(10,8),PSEDH(10,101,8),PSEDI(10,8),
     &PSEDO(10,8),PSEDT(10)

      DIMENSION ANSEDG(10,8),ANSEDH(10,101,8),ANSEDI(10,8),
     &ANSEDO(10,8),ANSEDT(10)

      DIMENSION SEDOR(10,8),SEDOT(10,8),SEDWT(10,8),DIAM(8),TSEDI(10,8)
     &,TSEDO(10,8),TTSEDO(10)
      DIMENSION DANSED(10),DNO3O(10),DNH4O(10),DONSED(10),DPHOSO(10)
     &,DPSED(10),DTSEDO(10),RUNO(10),TNO3O(10),TNH4O(10),TPHOSO(10)
     &,TRUNO(10),TRUNOM(10),RUNVOL(10),RUNOM(10)

      DIMENSION SEDZO(10,8),SEDZOT(10,8)


C **** NRZ (8/29/94)


!WB	BEGINNING OF NEW VARIABLES FOR NEW DETACHMENT ROUTINES
!WB	soil variables:
	COMMON/SOILVAR/CLAY(30),SAND(30),SILT(30),VFSPER(30),VFS(30),
	1ORGMAT(30),MASSCF(30),RANROU(30),RANROUM(30)
	DOUBLE PRECISION MASSCF

!WB	rill erodibility variables:
	COMMON/RILLVARS/KRBASE(35000),KRBR(35000),BR(20),BURRES(20),
	1KRADJHLD(35000),KRCONS(35000),KRSC(35000),KRADJ(35000)
	DOUBLE PRECISION KRBASE,KRBR,KRADJHLD,KRCONS,KRSC,KRADJ

!WB	critical shear variables:
	COMMON/CRTSHEAR/TAUCB(35000),TAURR(35000),TAUCHLD(35000),TAUCONS
	1(35000),TAUSC(35000),TAUCADJ(35000),TAUEFF
	
!WB	interrill erodibility variables:
	COMMON/IRILLVARS/KIBASE(35000),KICAN(35000),KIGRCOV(35000),KICONS
	1(35000),KISC(35000),KIADJ(35000),CANOPY(20),AUCFACT(20),HEIGHT(20),
     2MAXPLHGT(20),HGTFACT(20),GROWFACT(20)
	DOUBLE PRECISION KIBASE,KICAN,KIGRCOV,KICONS,KISC,KIADJ,MAXPLHGT
	
!WB	interrill cover common block:
	COMMON /IRILLCOV/ INRCOV(20),INRCOVI(20),INRCOVF(20),INRFACT(20),
	1LROOT(21),DROOT(21),KDROOTI(35000),KLROOTI(35000),DDROOTI(21),
	2DDROOTF(21),DDRTFAC(21),LRFAC(21),LIVEROOT(21),KDROOTR(35000),
	3KLROOTR(35000)
	
	DOUBLE PRECISION INRCOV,INRCOVI,INRCOVF,INRFACT,LROOT,KDROOTI,
	1KLROOTI,LRFAC,LIVEROOT,KDROOTR,KLROOTR

!WB	rill erosion variables:
	COMMON/RILLEROS/NORILLS,RILLSPC(20),QEFF,RILLWID,MNSOIL(21),
     1MNTOT(21),FLOWDEP,HYDRAD,DCAP,FCFRAC(30),FOFD,FPOFD,FDPOFD,
	2FLDEPOLD,MNCHNSL(35000),MNCHNTOT(35000),MNCS(30),MNCT(30),MNCSTMP
	3(35000),MNCTTMP(35000),MAXWID,NOTILL(21),NOEROS(21),DWSOIL,
	4HYDRADOLD(35000)
	DOUBLE PRECISION MNSOIL,MNTOT,MNCHNSL,MNCHNTOT,MNCS,MNCT,MNCSTMP,
	1MNCTTMP,NORILLS,MAXWID

!WB	interrill erosion variables
	COMMON /IRILLEROS/RNOFIR,SEDDR(35000,8),DIINT(35000,8),DETR(8)
	1,DETF(8),DACT(35000,8)

!WB	PLANT GROWTH VARIABLES
	COMMON /PLANTS/ DAYNOW(35000),YEARNOW(35000),DYYRNOW
	1(35000),DAYTHEN(35000),YEARTHEN(35000),DYYRTHEN(35000),
     2DAYDIFF(35000),BEGROTDT(35000)

!WB	CHANNEL BOTTOM EROSION VARIABLES	
	COMMON /CHANEROS/WIDINC(35000),DOWNRATE(35000),
	1DEPTHINC(35000),IMPERM(30),ROCKBOT(35000),RBTEMP(35000),
     2BULKDENS(30),CHNSOIL(35000),CHNSL(35000),CHNSLTMP(35000)
	3,DEPRATE(35000),DEPPREV(35000),CONSTHLD(35000),XHOLD(35000)
     4,CONSTTMP(35000),XTMP(35000)

	COMMON /ARMOUR/ARMOUR(35000),NOERODE(35000)
	1,NERODTMP(35000)

!WB	HYDROGRAPH PLOT VARIABLES
	COMMON /HYPLT/PRINHYD,IMPFLAG,QHYP(101,10),PHYP(101,10)
	1,DPHYP(101,10),A4SHYP(101,10),A4DHYP(101,10),ONHYP(101,10)
	2,A3HYP(101,10)
	CHARACTER(11) HYPNAM(10)

	DOUBLE PRECISION DIFF,RGTSID,LFTSID,IMPERM,NOERODE,NERODTMP

	INTEGER CNT,CNTER,CNTFLAG,NOTILL,INIT,NOEROS,CHNSL,CHNSOIL,
	1CHNSLTMP,PRINHYD
	

	DOUBLE PRECISION PCPANNUAL,RUNANNUAL,SEDANNUAL,NO3ANNUAL
	DOUBLE PRECISION NHWANNUAL,NHSANNUAL,PO4WANNUAL
	DOUBLE PRECISION PO4SANNUAL,TKNANNUAL,LNO3ANNUAL,LNO3DAY
	DOUBLE PRECISION CUMMULATIVE,MYQ,MYQA,STORAGE
	COMMON ANNUALOUT

!WB	Sediment Erosion routine information:  Some equations and
!WB	calculations in the sediment subroutine are not placed in the
!WB	location that will allow optimal calculation efficiency.  This is
!WB	recognized, and was done in order to ease understanding of the 
!WB	methodology at the cost of computational efficiency.

!WB	END OF NEW VARIABLES FOR NEW DETACHMENT ROUTINES

!RZ	COMMON STATEMENT FOR ATMOSPHERIC DEPOSITION ROUTINE
	COMMON /DEPOSITION/ O0ADD(35000),A0ADD(35000),P0ADD(35000)

!RZ	IRRIGATION VARIABLES
	COMMON /IRRIG/ IRRFLAG,IRRCROP,DEFLIMIT(20),STARTDAY(20),
	1ENDDAY(20),FREQ(20),IRREFF(20),IRRATE(20),DURATION(20),
     1IRRTARGET(30),LIMIT(20),IIRRI,IRRCYCLE(20),LASTIRR(20),SKIPFLAG,
     1CROPNOIRR(20),IRRFLAG2(20)
	INTEGER SKIPFLAG,STARTDAY,ENDDAY,FREQ,LIMIT,CROPNOIRR
	DOUBLE PRECISION IRREFF,IRRATE,DURATION,IRRTARGET

	COMMON /MOISTURE/ XMOI(35000)
!RZ	xmoi was changed from local to global variable on 8/9/2001 for ease of
!RZ	use in the irrigation subroutine

!RZ	URBAN BMP VARIABLES
	COMMON /BMP/ HEIGHTSED(300,8,1500),
     1SEDINPOND(300,8,1500),PHOSINPOND(300,8,1500),
     2ANITINPOND(300,8,1500),ONITINPOND(300,8,1500),
	3ORIFICEH(300),ORIFICED(300),ORIFICEN(300),
     4OUTSLOPE(300)
	
	COMMON /BMP2/ PONDAREA(300),NRO(300),H2ODEPTH(300),
	6ORAREA(300),WEIRVOL(300),ORVOL(300),ORTOP(300),
	7MAXFLOW(300),SOLP(300),SOLNH4(300),SOLNO3(300),
	8LOST(300),WLOST(300),ORBOT(300),TIPE(300),
	9PIPEN(300),PIPED(300),PIPEL(300),RISD(300),PIPEAREA(300),
	1RISH(300)
	INTEGER TIPE

	COMMON /BMP3/ POND(35000),STREAM(300),SUB(300)
	INTEGER POND,SUB

	COMMON /BMPPRINT/ TOTALIN(300),TOTALLOST(300),
	1TOTALWLOST(300),TOTALINF(300),TOTALEVAP(300),TOTALSED(300),
	2TOTALPHOS(300),TOTALANIT(300),TOTALONIT(300),TOTALDEPSED(300),
	3TOTALOUTSED(300),TOTALOUTPHOS(300),TOTALOUTANI(300),
	4TOTALOUTONI(300),TOTALDEPPHOS(300),TOTALDEPANI(300),
	5TOTALDEPONI(300),UOLD
     
      COMMON /BMPPRINT2/ TOTALSOLP(300),TOTALSOLNH4(300),
	6TOTALSOLNO3(300),TOTALLOSTSOLP(300),TOTALLOSTSOLNH4(300),
	7TOTALLOSTSOLNO3(300),TOTALINFP(300),TOTALINFNH4(300),
	8TOTALINFNO3(300)

	DOUBLE PRECISION LENGTH,MAXFLOW,LOST,PONDWIDTH,WEIRH
	INTEGER OUTLET,BMPLOC,UOLD

	DIMENSION CALLBMP(35000)
	INTEGER CALLBMP,BMPFLAG

	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB

	COMMON /BMP4/ ENDNO3SI,MYSHADOW(35000),MAXPOND
	INTEGER MAXPOND

	DIMENSION A1DUMMY(3,300,24), A2DUMMY(35000), A3DUMMY(35000),
	1A5DUMMY(3,300,2)
	INTEGER A1DUMMY, A2DUMMY

	DIMENSION CROP(20,2)

	CHARACTER*4 CDUMMY, CROP
	CHARACTER*2 A5DUMMY
	DATA CDUMMY/'    '/

	LOGICAL ARESULT,BRESULT


	CUMMULATIVE=0.0
C **** OPENING INPUT FILE--ANSWERS.INP
       OPEN (UNIT=1, FILE='ANSWERS.INP', STATUS='OLD')
       OPEN (UNIT=8, FILE='WEATHER.INP', STATUS='OLD')

C**    WDB 5/23/94
C**    OPEN A SEPARATE FILE FOR AVERAGE ANNUAL OUTPUT SENT BACK TO GIS
	OPEN (UNIT=5, FILE='ANSWGRID.OUT', STATUS='UNKNOWN')
C**    WDB 5/23/94

!TMN    4/14/00
!TMN  OPEN A SEPARATE FILE FOR ANNUAL OUTPUT 
	OPEN (UNIT=300, FILE='ANNUAL.OUT', STATUS='UNKNOWN')
!TMN    

 
C **** OPENING OUPUT FILE--ANSWERS.OUT
       OPEN (UNIT=2, FILE='ANSWERS.OUT', STATUS='UNKNOWN')
	 
!WB	OPENING RILL OUTPUT FILE
	 OPEN (UNIT=101,FILE='RILL.OUT',STATUS='UNKNOWN')
!WB	OPENING SCRATCH INTERRILL OUTPUT FILE
       OPEN (UNIT=102,FILE='IRILL.OUT',STATUS='UNKNOWN')
!RZ	OPENING FILE TO OUTPUT QA(I) VARIABLES FOR DEBUGGING
	 OPEN (UNIT=377,FILE='VARIS.OUT',STATUS='UNKNOWN')
	 OPEN (UNIT=379,FILE='VARIS2.OUT',STATUS='UNKNOWN')
***************************************************************
!RZ	****************HEADER FOR VARIABLE OUTPUT FILE**********
!	WRITE (377,338)
  338	FORMAT (1X,"M",4X,"B(M)",4X,"QA(IY)",2X,"MYQA",4X,"SSTOR",
     & 3X,"Q2",6X,"Q(M)",4X,"SS(M)",3X,"S(M)",4X,"FLINS(M)")

!WB ****	CE6 IS A CONSTANT ASSOCIATED WITH THE OLD EROSION EQNS,
!WB		BUT WAS NOT REMOVED B/C IT IS USED IN SEVERAL SUBROUTINES
      CE6=62.3174

      READ (1,280) (TT(I),I=1,19)   
!WB	Reads first line in input file
      WRITE (2,290) (TT(I),I=1,19)  
!WB	Writes first line in input file to output file
      

***********RILL & IRILL FILE HEADER*****
      WRITE (101,*) 'LDAY','    SED ','  JK ','DAYDIFF','  KRBASE',
	1'  TAUCB','   TAURR',' TAUCHLD'
      WRITE (101,*) '      KRCONS','  KRSC',' KRBR','   KRADJ',
	1'   TAUCONS',' TAUSC',' TAUCADJ',' SOIL'
	WRITE (101,*) '      KDROOTR',' KLROOTR'
	WRITE (102,*) 'LDAY ',' SED ','    JK',' DAYDIFF',' KIBASE',
	1' HEIGHT','   CANOPY',' KICAN'
      WRITE (102,*)'          INRCOV',' KIGRCOV',' KICONS',
     1' KISC','      LROOT',' DROOT'
      WRITE (102,*)'          KLROOT',' KDROOT','  KIADJ',' SOIL'
!WB	END OF OUTPUT HEADERS TO RILL/IRILL OUTPUTS

!TMN  WRITE HEADER FOR ANNUAL OUTPUT

	WRITE(300,2202)
 2202 FORMAT(///,30X,24H**** ANNUAL OUTPUT  ****,//)
      WRITE(300,3099)
	WRITE(300,3098)
 3099 FORMAT(1X,4HYEAR,1X,9H PRECIP  ,1X,9H RUNOFF  ,1X,9HSEDIMENT ,
     & 1X,9H DIS-NO3 ,1X,9H DIS-NH4 ,1X,9H SED-NH4 ,1X,9H DIS-PO4 ,
     & 1X,9H SED-PO4 ,1X,9H SED-TKN, 1X,11H  LEACH-NO3)
 3098 FORMAT(7X,1X,7H  MM   ,1X,9H   MM    ,1X,9H  KG/HA  ,
     &1X,9H   KG    ,1X,9H    KG   ,1X,9H   KG    ,
     &1X,9H   KG    ,1X,9H    KG   ,1X,9H   KG    ,1X,9H   KG/HA )


!TMN  END OF INPUT HEADER FOR ANNUAL INPUT

C
C **** READ, TRANSFORM AND RETURN INPUT INFORMATION.
C
      CALL XDATA (NDT,KPR,N,CONV,CU,SF,IT,NN,ICR,NFI,CU2,ISTRUC,SB,TMIN,
     &TMAX,NRG,DX,GRF,NEXP,DC,PP,FILTS,CWID,AREA,AREA2,DT,NMAX,CU1,
     &DAYBEG,SIMDUR,ISR,YERBEG,CLAYAV,CALLBMP,CROP)

!WB	 NDT = # lines hydrograph input, KPR = # time increment routings 
!WB	between print lines, N = number of overland flow cells,
!WB	CONV = catchment conversion, CU = conversion, SF = segment factor
!WB	 = max. projected catchment discharge, IT = unknown, 
!WB	NN = # overland flow + channel elements + 1, ICR = # cropping 
!WB	practices, NFI = max # of time increments b/t infiltration 
!WB	recalc.'s, CU2 = conversion, ISTRUC = counter for structural 
!WB	practices, SB = ave. overland flow conveyance coeff., TMIN = min. 
!WB	time value in any hyetograph, TMAX = maximum time, NRG = # rain
!WB	 gages, DX = element width, GRF = fractional rate of baseflow 
!WB	release, NEXP = unknown,  DC = tile drainage coeff., 
!WB	PP = alphanumeric unit descrip., FILTS = infil. cap. for 
!WB	element i, CWID = width of channel seg. i, AREA = catchment area 
!WB	as sum of element areas, AREA2 = element or channel area, 
!WB	DT = time increment, NMAX = max. # of elements, 
!WB	CU1 = conversion, DAYBEG = beginning day of simulation, SIMDUR =
!WB	 simulation duration, ISR = # of soil types,
!WB	YERBEG = beg. year of the simulation, CLAYAV = unknown

	CLOSE(1)
	LASTRAITES=DAYBEG
	LDAYOLD=0
!RZ	URBAN these variables are used in the ATMDEP subroutine and must be initialized

      CONFAY=DX*DX/10000. 
!WB	 (element width)^2 / 10000

      DO 5550 J=1,N 
!WB	do this loop from J = counter to # overland flow el's
!RZ	IF THE CELL IS URBAN, THEN NONE OF THESE NEEDS TO BE CALCULATED
 	
	IF (URB(J).EQ.1) GO TO 5550
      K=SOIL(J)/256 
!WB	 = soil type / 256
      ASMVOL(J)=ASMBF(K)*(TP1(K)/CU1) 
!WB	ASMBF = ASM(I)
      ASMPER(J)=ASMBF(K)  
      VOLSZ1(J)=EDI(J)*PHI(K) 
!WB	 = effective depth of interaction * porosity
      VOLSOI(J)=EDI(J)*BD(K) 
!WB	 = EDI * bulk density
      VOLSZ(J)=EDI(J)*0.001*DX*DX*PHI(K) 
!WB      = EDI * 0.001 * side length * side length * porosit 
 5550 CONTINUE
*MAX RATE OF NITRIFICATION IS 100MG/KG/WEEK
!RZ	URBAN::CONSIDER MOVING THIS EQUATION INTO THE PREVIOUS LOOP.  THE PREVIOUS LOOP
!RZ	CALCULATES ALL SORTS OF USELESS STUFF (I.E, CALCULATES STUFF SEVERAL TIMES OVER)
!RZ	FOR THE SOILS; IN FACT, MOST OF THE LOOP CONSISTS OF SOIL ASSOCIATED CALCULATIONS WHICH
!RZ	COULD BE MOVED INTO A SOIL LOOP LIKE 5551 BELOW.  DO SOMETHING ABOUT THIS.
      DO 5551 K=1,ISR 
!WB	 do this loop from counter J=1 to # of soil types
!RZ	URBAN - IF THE SOIL IS URBAN NONE OF THESE NEED TO BE CALCULATED
	IF (URBSOIL(K).EQ.1) GO TO 5551
	ASMLIM(K)=(FCAP1(K)-FC(K))*(TP1(K)/CU1)*0.25+FC(K)*(TP1(K)/CU1) 
!WB	  ASMLIM(K) = (field cap of soil K - wilting point) * (TP1 / conv.)
!WB		 * 0.25 + wilt pt * TP1 / conv.
      WP(K)=FC(K)*TP1(K)/CU1 
!WB	 = wilt pt * porosity / conversion
      FCVOL(K)=FCAP1(K)*(TP1(K)/CU1) 
!WB	 field cap (mm) = field cap as fraction of pore space * 
!WB		(porosity / conv)
	SOIVOL(K)=DF1(K)*DX*DX*BD(K) 
!WB	 soil mass of layer = depth of horizon * side length*side length
!WB	 	* bulk density of soil
      RATEMX(K)=0.0001*SOIVOL(K)/7. 
!WB	max nit. rate = 0.0001 * soil mass of soil layer / 7.
 5551 CONTINUE
 
 
       DO 5532 JK=1,ICR 
!WB	 do this loop from counter JK=1 to # of cropping practices
	IF(DATPLA(JK).GT.DATHAR(JK)) DATHAR(JK)=DATHAR(JK)+365 
!WB	if plant date > harvest date, then harvest date moves to next year
	LDATE=(DATHAR(JK)-DATPLA(JK))+1 
!WB	growth duration = (harvest date - plant date) +1
	RLENGT=(DATHAR(JK)-DATPLA(JK)+1)/10. 
!WB	unknown = ((harv. date - plant date) +1) / 10
!RZ	this appears to be the length for each stage of the growth; i.e., the 
!RZ	length of time that a particular LAI is in effect for a crop; this matches
!RZ	with the calculations in loop 5531 below.  For reference, see table 6a. in the
!RZ	input guide
!RZ	URBAN::urban 'crop' types do not have LAI, skip over following calculations
	IF (JK.LT.URBCR) GO TO 5532
	DO 5531 LL1=1,10 
!WB	do this loop 10 times?
*LDATE REPRESENT GROWTH DURATION
	POTLAI(JK)=(LAI(JK,LL1+1)+LAI(JK,LL1))*0.5*RLENGT
     &             +POTLAI(JK)
!WB	sum of potential lai from planting to harvest = 
!WB		(lai (crop practice, next count step) + 
!WB		lai (crop practice, this count step))  * 0.5 * 
!WB		((harv date - plant date) + 1) / 10 + potential 
!WB		lai from crop practice
 5531   CONTINUE
 5532  CONTINUE

!WB	RESET CHANNEL WIDTH INCREASE AT THE BEGINNING OF THE SIMULATION
	N2=NN-1
	DO LL1=N+1,N2
	WIDINC(LL1)=0.
	DEPTHINC(LL1)=0.
	DEPRATE(LL1)=0.
	DEPPREV(LL1)=0.
	INIT=0
!WB	INIT IS A FLAG/COUNTER THAT ALLOWS THE SED INITIALIZATION TO 
!WB	ONLY OCCUR ONCE, AS REDOING THE LOOP MULTIPLE TIMES CAUSES ERRORS
	END DO 

      DO 5555 IDATE=1,SIMDUR
!WB	do this loop from day of simulation up to simulation duration

*	print *,' DAY OF SIMULATION IS ',IDATE
*get leaf area index and interpolate for a specific date
*LDAY REPRESENT THE CURRRENT DAY IN JULIAN CALENDAR
C *** NRZ
C *** ADDED CORRECTION FOR LEAP YEAR

	IF(LDAY.GE.365 .AND. MOD(YERBEG,4).NE.0.) THEN
	 YERBEG=YERBEG+1
	 DAYBEG=DAYBEG-365
        ELSEIF (LDAY.GE.366 .AND. MOD(YERBEG,4).EQ.0) THEN
         YERBEG=YERBEG+1
         DAYBEG=DAYBEG-366
	ENDIF

C *** NRZ END
 
	LDAY=IDATE+DAYBEG-1 
!WB	current day = date counter + beg. day -1

       DO 5580 JK=1,ICR 
!WB	 do this loop from the counter JK=1 to # cropping practices

!RZ	URBAN:::if the crop type is urban, none of these variables need to be calculated.
!RZ	So skip to the end of the loop and do the next crop.
	IF (URBCR.LE.ICR) GO TO 5580
!RZ	URBCR is the number of urban crops, read in XDATA subroutine.

*LDATE REPRESENT GROWTH DURATION
	LDATE=(DATHAR(JK)-DATPLA(JK))+1 
!WB	growth duration = (harvest date of cropping practice 
!WB		- plant date of cropping practice) +1
	RLENGT=(DATHAR(JK)-DATPLA(JK))/10. 
!WB	unknown = (harv. date of crop practice - 
!WB		plant date of crop practice) / 10
!WB	This same line is defined differently a few lines above. !RZ See that
!RZ	definition for description of RLENGT.  This redefinition almost seems like
!RZ	a mistake, leaving out the +1, especially because ldate is defined the same.
!RZ	this doesn't even seem to be used in the program after this point.
	LMODE=IDINT(((DBLE(LDAY)-DBLE(DATPLA(JK))+1)/DBLE(LDATE))*10)+1
	IF(LMODE.GT.11) GOTO 5580
	RMODE=((DBLE(LDAY)-DBLE(DATPLA(JK))+1)/DBLE(LDATE))*10.+1.
	IF(RMODE.LT.0.) THEN
	 LMODE=IDINT(((DBLE(LDAY)-DBLE(DATPLA(JK))+366)/DBLE(LDATE))*10)+1
	 RMODE=((DBLE(LDAY)-DBLE(DATPLA(JK))+366)/DBLE(LDATE))*10.+1.
	ENDIF
	IF(LMODE.GT.10) GOTO 5580
	IF(RMODE.LT.1) GOTO 5580
!WB	LINE ADDED 1/19/99 TO PREVENT A NEGATIVE LAI1 WHEN LDAY IS LT
!WB	DATPLA.  AT THE BEG OF A ROTATION, THIS CAUSES FLOAT ERRORS.
	LAI1(JK)=(LAI(JK,LMODE+1)-LAI(JK,LMODE))*(RMODE-LMODE)
     &           +LAI(JK,LMODE)
*COMPUTING THE ROOT DEPTH FOR A GIVEN DAY
	RDAYL=DBLE(LDAY)-DBLE(DATPLA(JK))+1. 
!WB	 = (current date - plant date) + 1
	RDAYM=DBLE(DATHAR(JK))-DBLE(DATPLA(JK))+1. 
!WB	 = harvest date - plant date +1
 
	ROTDAY(JK)=ROTMAX(JK)*(0.5+0.5*SIN(3.03*(RDAYL/RDAYM)-1.47))
!WB	root depth for crop practice = max root depth for crop * 
!WB		(0.5 + 0.5*sin(3.03*(fraction of root growth)-1.47))

!WB	***** SEDIMENT SUBROUTINE HEIGHT & CANOPY FACTORS ****************
      IF (LDATE.GT.365) THEN
!WB	A GENERAL ERROR CHECK FOR LONG ROTATIONS, WHICH AREN'T HANDLED
!WB	BY THE PLANT GROWTH MODEL IN THE SEDIMENT ROUTINE
		WRITE (*,2595)
	    PAUSE
	    ENDIF
	HGTFACT(JK)=MAXPLHGT(JK)/(GROWFACT(JK)*LDATE)
!WB	This is the canopy growth factor, used in the Kican factor in the 
!WB	sed submodel.  It assumes linear growth of plant height and canopy,
!WB	during the first half of the growing period, then is equal to 
!WB	the max height during the last half of the growth period.
!WB	maxPLhgt=maximum canopy height for a crop.
	AUCFACT(JK)=(AC(JK)/100)/(GROWFACT(JK)*LDATE)
!WB	This is the Area Under Canopy factor, used in the Kican factor in
!WB	the sed submodel.  It assumes linear growth of plant canopy, and
!WB	that max canopy is obtained at halfway through the growth period. 
!WB	ERROR MESSAGES
	DDRTFAC(JK)=(DDROOTF(JK)-DDROOTI(JK))/(LDATE)
	LRFAC(JK)=(LIVEROOT(JK)/(GROWFACT(JK)*LDATE))
	INRFACT(JK)=(INRCOVF(JK)-INRCOVI(JK))/(LDATE)
	IF ((DDRTFAC(JK).LT.-1).OR.(DDRTFAC(JK).GT.1)) THEN
	WRITE (2,3050) DDRTFAC(JK), JK
	WRITE (*,2592)
	PAUSE
	STOP
	ENDIF
	IF ((LRFAC(JK).LT.0).OR.(LRFAC(JK).GT.1)) THEN
	WRITE (2,3052) LRFAC(JK),JK
	WRITE (*,2592)
	PAUSE
	STOP
	ENDIF
	IF ((GROWFACT(JK).LT.0).OR.(GROWFACT(JK).GT.1)) THEN
	WRITE (2,2582) GROWFACT(JK)
	WRITE (*,2592)
	STOP
	ENDIF
	IF ((MAXPLHGT(JK).LT.0).OR.(MAXPLHGT(JK).GT.3.0)) THEN
	WRITE (2,2584) MAXPLHGT(JK)
	WRITE (*,2592)
	STOP
	ENDIF
	IF ((HGTFACT(JK).LT.0).OR.(HGTFACT(JK).GT.1)) THEN
	WRITE (2,2586) HGTFACT(JK) 
	WRITE (*,2592) 
	STOP
	ENDIF
	IF (((AC(JK)/100).LT.0).OR.((AC(JK)/100).GT.1)) THEN
	WRITE (2,2588) AC(JK)
	WRITE (*,2592)
	STOP
	ENDIF
	IF ((AUCFACT(JK).LT.0).OR.(AUCFACT(JK).GT.1)) THEN
	WRITE (2,2590) AUCFACT(JK)
	WRITE (*,2592)
	STOP
	ENDIF
!WB	END ERROR MESSAGES
!WB	***** END SEDIMENT SUBROUTINE HEIGHT & CANOPY FACTOR *************** 
 
 5580   CONTINUE
      RAITES=0 
!WB	raintest flag, 0 = false, no storm
      RNUT=0 
!WB	nutrient application flag, 0 = no nutrient app
      DO 5581 JK1=1,ICR 
!WB	do this loop from counter JK1 up to # of cropping practices
      RNUTNI(JK1)=0. 
!WB	nitrate fertilizer applied to cropping practice
      RNUTAM(JK1)=0. 
!WB	ammonium fertilizer applied to cropping practice
      RNUTP(JK1)=0. 
!WB	P fert applied to cropping practice
 5581 CONTINUE
C *** NRZ 9/12/94
C *** MODIFIED FERTILIZER INPUT

!WB****this is where raites is read, see if-then loop #699***********

      READ(8,5560) TEMPC,SOITEM,RADI,RAITES
!WB	  TEMPC = air temp, SOITEM = soil temp, RADI = daily radiation,
!WB		 RAITES = raintest flag
      IF ((IDATE.EQ.1).AND.(IFERT.EQ.1)) THEN 
!WB	if day = first day and fert. app = 1, then
	READ (9,*) 
!WB	read from fertilizer.inp file
	READ (9,*)
	READ (9,6010) NFYEAR,NFDAY,NICR,TMPNI(NICR),
     &                TMPAM(NICR),TMPP(NICR)
!WB	 NFYEAR = year of fert. app., NFDAY = day of fertilizer app., 
!WB	NICR = crop # to which fert is app'ed., TMPNI = amt of NO3 
!WB	aplied to crop i, TMPAN = amount of NH4 fert app to crop i, 
!WB	TMPP = amt of P fert app'ed to crop i,
 5583 ENDIF
 5584 IF ((NFYEAR.EQ.YERBEG).AND.(NFDAY.EQ.LDAY)) THEN 
!WB	 if year of fert app equals beginning year and fert app day = 
!WB	 today, then
!RZ	 yerbeg is the current year, not the beginning year - it is 
!RZ	 incremented every year
        NFPR = 1 
!WB	  unknown; RZ: this is a flag to tell the output that this is a 
!RZ		fertilizer day and thus 'fertilizing...' needs to be written
!RZ		to the screen
	RNUTNI(NICR)=TMPNI(NICR)*CONFAY 
!WB	nitrate applied to crop i = amt NO3 app'ed to crop i * 
!WB		DX^2 / 10000
	RNUTAM(NICR)=TMPAM(NICR)*CONFAY 
!WB	NH4 applied to crop i = amt of NH4 app'ed to crop i * 
!WB		DX^2 / 10000
	RNUTP(NICR)=TMPP(NICR)*CONFAY 
!WB	P applied to crop i = amt of P app'ed to crop i * DX^2 / 10000
	READ (9,6010,END=5585) NFYEAR,NFDAY,NICR,TMPNI(NICR),
     &                TMPAM(NICR),TMPP(NICR)
!WB	The END statement in the read command above says to return 
!WB	control to the executable statement when the end of file record
!WB	is reached, otherwise the program will return an error message.  
!WB	This one says to read all the fert app data.    
!RZ	This only goes until the IF THEN statement at 5584 is not satisfied;
!RZ	This makes sure that if more than one crop gets applied to on one day
!RZ	the program figures it out.  Once you get an nfyear and nfday that 
!RZ	are not today, you will jump to the end if after the goto statement and 
!RZ	proceed on to the rest of the program without reading the rest of the input
!RZ	file.  Contrary to what you might think reading WB's comments, putting an 
!RZ	END= clause in your read statement does not make it a do loop.
!RZ	NFYEAR and NFDAY are stored for the next day; notice that IF THEN ending at 
!RZ	5583 is not executed except the first day of simulation; therefore, the test
!RZ	at 5584 will be executed on the last NFYEAR and NFDAY read until it is satisfied.
	    GOTO 5584
      ENDIF
C *** NRZ 9/12/94
 
 5585 PREMOI=0. 
!WB	 unknown
      PREPIV=0. 
!WB      unknown
 
*CHOOSE THE CORRECT COVER FOR THE GIVEN DAY
 
       LDYEAR=YERBEG*1000+LDAY 
!WB	 = beginning year of sim * 1000 + the day #
	 DO 5588 J=1,N 
!WB	 do this loop from the counter J until the number of overland 
!WB		flow elements
       K=MOD(SOIL(J),256) 
!WB	 K = soil - INT(SOIL / 256) * 256, this is the rotation # for 
!WB		the overland flow element
!TMN	 DO 5587 J1111=3,29,2 ! CHANGED TO 322 TO ACCOMODATE 322 ROTATION
!TMN   END DATES
      DO 5587 J1111=3,322,2
!WB	 DO 5587 J1111=3,21,2 !changed count to 29 b/c 28 rotation dates
!WB	 J1111 is a count from 3 to 21 by 2
	  IF(LDYEAR.LE.IROT(K,J1111)) THEN 
!WB	If the LDYEAR variable is less than or equal to the end date for
!WB    cover for a specific rotation (surf. type, J1111 matrix)
	   INTI=IROT(K,J1111-1) 
!WB	INTI = cover for rotation at beginning of rotation period
	   SUR(J)=K*256+IROT(K,J1111-1)
!WB	surf. type = rotation # of current element * 256 + cover for 
!WB		beginning of rotation period
		DAYNOW(J)=MOD(LDYEAR,1000)
!WB	THE JULIAN DAY TODAY=LDYEAR-INT(LDYEAR/1000)*1000
		YEARNOW(J)=INT(LDYEAR/1000)
!WB	THE YEAR NOW=INTEGER(LDYEAR/1000)
		DYYRNOW(J)=(YEARNOW(J)*365+DAYNOW(J))
!WB	THE # OF DAYS=YEAR # * 365 (DAYS/YEAR) + DAY # NOW
		IF (J1111.GT.3) THEN
!WB	IF THIS IS NOT THE FIRST INPUT ROTATION		
		BEGROTDT(J)=IROT(K,J1111-2)+1
!WB	THE END DATE OF THE PREVIOUS ROTATION (=BEG DATE OF THIS ROTATION)
		DAYTHEN(J)=MOD(BEGROTDT(J),1000.)
!WB	THE DAY # AT THE BEGINNING OF THIS CROP/COVER
		YEARTHEN(J)=INT(BEGROTDT(J)/1000.)
!WB	THE YEAR # AT THE BEGINNING OF THIS CROP/COVER	
		ELSE
		DAYTHEN(J)=DATPLA(INTI)
		IF (DAYNOW(J).GE.DATPLA(INTI)) THEN
		YEARTHEN(J)=YEARNOW(J)
		ELSE
		YEARTHEN(J)=YEARNOW(J)-1
		ENDIF
		ENDIF
		DYYRTHEN(J)=(YEARTHEN(J)*365+DAYTHEN(J))
!WB	THE # OF DAYS AT THE BEGINNING OF THIS CROP/COVER
		DAYDIFF(J)=DYYRNOW(J)-DYYRTHEN(J)
!WB	THE DIFFERENCE IN # OF DAYS (NOW-BEGINNING DATE OF CROP/COVER)

!TMN  IF (DAYDIFF(J).GT.10000) DAYDIFF(J)=0.
!TMN  CHANGED TO ALLOWED MAX ROTATION LENGTH TO BE 100 YEARS 
!TMN  (ACCOUNTED FOR LEAP YEARS)
		IF (DAYDIFF(J).GT.36525) DAYDIFF(J)=0.
!WB	THIS MAKES MAXIMUM ROTATION LENGTH FOR A SINGLE CROP 
!WB	= 27 YEARS, 145 DAYS, BUT IS INTENDED TO PREVENT AN ERROR 
!WB	OCCURRING WHEN THE FIRST ROTATION PARAMETER IS READ
		IF (DAYDIFF(J).LT.0) THEN
		WRITE (*,2594)
		STOP
		ENDIF
	  GOTO 5588
	  ENDIF
 5587    CONTINUE

 5588  CONTINUE

	 DO 6001 J=1,N
!WB	 do this one from the counter J=1 to # of overland flow elements
       K=MOD(SOIL(J),256) 
!WB	 rotation # for current element = soil type for element i - 
!WB		INT(soil type for i / 256) * 256

!TMN	 DO 6001 J1111=3,27,2 ! CHANGED TO 301 TO ACCOMODATE 301 
!TMN  ROTATION END DATES
	 DO 6001 J1111=3,301,2 
!WB     DO 6001 J1111=3,19,2 changed count to 27 to represent 28 end dates
!WB	 J1111 is a count from 3 to 19 by 2
	  IF(LDYEAR.EQ.(IROT(K,J1111)+1))  THEN 
!WB		if the LDYEAR formula equals 1st day of the next period
!WB		 of sim/cover 
		SUMLAI(IROT(K,J1111+1))=0. 
!WB		sum of LAI for the next (from J1111) cover/period is reset to 0
	    LAI1(IROT(K,J1111+1))=0. 
!WB		LAI of the next (from J1111) cover/period = 0
		INTI=IROT(K,J1111+1)
!WB		 initial cover = cover at next (from J1111) period
		INTPREV=IROT(K,J1111-1)
!WB		 previous cover = cover at previous (from J1111) period
!RZ	URBAN:: if the cover type is urban, then there is no dmy, yp, or cp1
	IF (CROP(INTPREV,1).EQ.' URB') GO TO 6002
		RES(INTI)=DMY(INTPREV)*YP(INTPREV)*CP1(INTPREV)
	1	*0.25/100.*CONFAY 
!WB		nitrogen in residue at beg of cover period = 
!WB		dry matter ratio * yield potential * exponent for nitrogen 
!WB		content * 0.25 / 100 * DX^2 / 10000
	    RES20(INTI)=RES(INTI)*0.80 
!WB		= nitrogen in residue at rotation at end of period 
!WB		 * 0.80
	    RES90(INTI)=RES(INTI)*0.10 
!WB		= nitrogen in residue at rotation at end of period
!WB		 * 0.10
!WB	    INTI=IROT(K,J1111+1)-1  
!WB	    RES(INTI+1)=DMY(INTI)*YP(INTI)*CP1(INTI)*0.25/100.*CONFAY 
!WB	    RES20(INTI+1)=RES(INTI+1)*0.80 
!WB	    RES90(INTI+1)=RES(INTI+1)*0.10 
!WB	THE PREVIOUS 4 LINES WERE REMOVED 1/6/99 AND REPLACED BY THE LINES
!WB	ABOVE.  THEY WERE REPLACED BECAUSE WHEN THE COVER # WAS A 1, THE
!WB	INTI VARIABLE RETURNED A 0, AND THE RES VARIABLE EXCEEDED ARRAY
!WB	BOUNDARIES IN THE CALCULATION.  I BELIEVE THE COVER CHOICE TO BE
!WB	ERRONEOUS AS PREVIOUSLY WRITTEN BECAUSE IT DIDN'T CALCULATE RES AT
!WB	THE PREVIOUS COVER, IT CALCULATED IT FOR CURRENT COVER # MINUS 1.
	    GOTO 6002
	  ENDIF
 6001    CONTINUE
 
 6002  J=MOD(SUR(19),256) 
!WB		J = surface type on element 19 - INT (same / 256) * 256
!RZ		surface type
       JAD=MOD(LDAY,60)  !THIS LINE IS USED NOWHERE-FWB
!WB	    = Day # - INT (Day # / 60) * 60
C      IF(JAD.EQ.0) WRITE(6,*) 'SIMULATING ', YERBEG,LDAY

C **** NRZ (11/4/94)
C **** NEW SCREEN OUTPUT

	IF (IIRRI.EQ.1) THEN
	IRRIGAT=1
	DUMMY=0.
	CALL IRRIGATE(LDAY,RAITES,YERBEG,IDATE,IRRIGAT,ICR,DUMMY,TMAX,
	1JJ,ITR,CU,N,CU1,DT)
	END IF
!RZ	call the irrigation subroutine if the irrigation flag is triggered
!RZ	in answers.inp. Set irrigat to 1 to indicate we are executing the first
!RZ	part of the subroutine.  Dummy is a placeholder for a variable not 
!RZ	defined yet but that needs to be passed at the next subroutine call.
!	WRITE (377,*) (1-PIV(1)*DT/TP1(INT(SOIL(1)/256))), LDAY
      CALL XDATE (LDAY,YERBEG,IDATE,SIMDUR,RAITES,NFPR,IRRFLAG)
!WB		LDAY = day #, YERBEG = beginning year of simulation, 
!WB		IDATE = date of simulation, SIMDUR = simulation duration, 
!WB		RAITES = raintest flag, NFPR = fertilizer flag, IRRFLAG= irrigation flag
C **** NRZ 11/4/94)
	
!WB	****** BEGINNING OF NEW SEDIMENT INITIALIZATION SCHEME **********
	IF (INIT.EQ.0) THEN
!WB	THIS LOOP IS A PAGE OR SO LONG, AND THE INIT=0 VARIABLE IS INITIAL-
!WB	IZED ABOVE WITH WIDINC & DEPTHINC.  IT IS DESIGNED TO ONLY ALLOW
!WB	THE BASELINE VALUES TO INITIALIZE ONCE.
!WB	THE ROUTINE MUST BE PLACED HERE B/C IT RELIES ON CORRECT CHOICE OF
!WB	COVER CONDITIONS FOR CALCULATION OF OTHER VAR'S.
	INIT=1
!WB	The following do loop converts the soil parameters from percentage
!WB	quantities to fractional quantities.
 	DO 9200 CNT=1,ISR
!RZ	URBAN::if the soil type is urban, these parameters do not need to be set
	IF (URBSOIL(CNT).EQ.1) GO TO 9200
	CLAY(CNT)=CL(CNT)/100
	SAND(CNT)=SA(CNT)/100
	SILT(CNT)=ST(CNT)/100
	ORGMAT(CNT)=OM(CNT)/100
	MASSCF(CNT)=WCF(CNT)/100
	VFS(CNT)=VFSPER(CNT)/100
	BULKDENS(CNT)=BD(CNT)*1000
!WB	BULKDENS=SOIL BULK DENSITY IN KG*M-3
	IF ((CLAY(CNT).LT.0).OR.(SAND(CNT).LT.0).OR.(SILT(CNT).LT.0).OR.
	1(ORGMAT(CNT).LT.0).OR.(MASSCF(CNT).LT.0).OR.(BULKDENS(CNT).LT.0)
     2.OR.(VFS(CNT).LT.0))
	3 THEN
	WRITE (2,2596) CLAY(CNT),SAND(CNT),SILT(CNT),VFS(CNT),ORGMAT
	1(CNT)
      WRITE (2,2597) MASSCF(CNT),BULKDENS(CNT),CNT
	WRITE (*,2592)
	STOP
	ENDIF
	IF ((CLAY(CNT).GT.1).OR.(SAND(CNT).GT.1).OR.(SILT(CNT).GT.1).OR.
	1(ORGMAT(CNT).GT.1).OR.(MASSCF(CNT).GT.1).OR.(VFS(CNT).GT.1).OR.
     2(BULKDENS(CNT).GT.5000)) THEN
	WRITE (2,2596) CLAY(CNT),SAND(CNT),SILT(CNT),VFS(CNT),ORGMAT
	1(CNT)
      WRITE (2,2597) MASSCF(CNT),BULKDENS(CNT),CNT
	WRITE (*,2592)
	STOP
	ENDIF
 9200	END DO

	N2=NN-1
	DO 9210 CNT=1,N2
	K=SOIL(CNT)/256
!WB	THIS EXTRACTS THE SOIL TYPE
	JK=MOD(SUR(CNT),256)
!WB	jk extracts the crop descriptor # (cover type)
	HYDRADOLD(CNT)=0.1
!WB	INITIALIZE A VAR HOLDER FOR HYDRAULIC RADIUS.  SEE SUB SED
	IF (CNT.GT.N) THEN
	JK=21
	NOTILL(JK)=1.
	ENDIF
!RZ	URBAN::if the soil type is urban, none of these calculations need to be made.  The only 
!RZ	calculation which could possibly pertain in an urban area is taurr and it is not used 
!RZ	outside of this loop.  Therefore, skip to end of loop if the soil is urban.
	IF (URBSOIL(K).EQ.1) GO TO 9210

	IF (SAND(K).GE.0.30) THEN
!WB	sand(K)=fraction of sand in upper soil layer, VFS = fraction of 
!WB	very fine sand in upper soil layer (very fine sand in WEPP 
!WB	documentation)
!WB	orgmat=fraction of organic matter in upper soil layer, clay = 
!WB	fraction of clay in the upper soil layer
		IF (VFS(K).LT.0.40) THEN
		VFSCALC=0.40
		ELSE 
		VFSCALC=VFS(K)
		ENDIF
		IF (ORGMAT(K).LT.0.0035) THEN
		OMCALC=0.0035
		ELSE
		OMCALC=ORGMAT(K)
	    ENDIF
		KRBASE(CNT)=0.00197+0.030*VFSCALC+0.03863*
	1	exp(-184*OMCALC)
!WB	Krbase = baseline rill erodibility		
		IF (CLAY(K).GE.0.40) THEN
		CLAYCALC=0.40
		ELSE
		CLAYCALC=CLAY(K)
		ENDIF
		TAUCB(CNT)=2.67+6.5*CLAYCALC-5.8*VFSCALC
!WB	taucb = baseline critical shear
	ENDIF
	IF (SAND(K).LT.0.30) THEN
		IF (CLAY(K).LT.0.10) THEN
		CLAYCALC=0.10
		ELSE
		CLAYCALC=CLAY(K)
		ENDIF
		KRBASE(CNT)=0.0069+0.134*exp(-20*CLAYCALC)
		TAUCB(CNT)=3.5
	ENDIF
	IF (KRBASE(CNT).GT.0.05) THEN
!WB	THESE ARE LIMITS SUGGESTED BY WEPP DOCUMENTATION
	WRITE (*,2598) CNT,KRBASE(CNT)
	WRITE (2,2598) CNT,KRBASE(CNT)
	KRBASE(CNT)=0.05
	PAUSE
	ENDIF
	IF (KRBASE(CNT).LT.0.002) THEN
	WRITE (*,3000) CNT,KRBASE(CNT)
	WRITE (2,3000) CNT,KRBASE(CNT)
	KRBASE(CNT)=0.002
	PAUSE
	ENDIF
	
	IF (TAUCB(CNT).GT.7.0) THEN
!WB	LIMITS SUGGESTED BY WEPP
	WRITE (*,3002) CNT,TAUCB(CNT)
	WRITE (2,3002) CNT,TAUCB(CNT)
	TAUCB(CNT)=7.0
	PAUSE
	ENDIF
	IF (TAUCB(CNT).LT.0.3) THEN
	WRITE (*,3004) CNT,TAUCB(CNT)
	WRITE (2,3004) CNT,TAUCB(CNT)
	TAUCB(CNT)=0.3
	PAUSE
	ENDIF

	IF (CNT.LE.N) THEN
!WB	SKIP THE RANDOM ROUGHNESS ADJUSTMENT IF ITS A CHANNEL CELL, B/C
!WB	THE RANROU IS A FUNCTION OF TILLAGE PROP'S
	IF ((RANROUM(JK).LT.0.00099).AND.(RANROUM(JK).NE.0)) THEN
!WB	'RANROU INPUT IN METERS' ERROR STATEMENT
	WRITE (2,3006) RANROUM(JK)
	WRITE (*,3006) RANROUM(JK), JK
	PAUSE
	ENDIF
	
	IF (RANROUM(JK).LE.0.006) RANROUM(JK)=0.006
!WB	INPUT A VALUE OF 0 FOR A PASTURE SITUATION WILL RESULT IN TAURR = 1
	TAURR(CNT)=1.0+8.0*(RANROUM(JK)-0.006)
!WB	taurr=random roughness adjustment, where ranroum = random roughness
!WB	in m
	IF (TAURR(CNT).GT.2.552) THEN
!WB	This corresponds to a random roughness in excess of 200 mm.
	WRITE (2,3008) TAURR(CNT),CNT
	WRITE (*,3008) TAURR(CNT),CNT
	PAUSE
	ENDIF
	ELSE
!WB	ELSE GOES WITH THE IF CNT.LE.N; IF ITS A CHANNEL CELL, TAURR=1
	TAURR(CNT)=1
	ENDIF
	TAUCHLD(CNT)=TAUCB(CNT)*TAURR(CNT)
!WB	tauchld(M) is a variable to "hold" the adjusted critical shear, 
!WB	where taucb is calculated

	IF (CNT.GT.N) GO TO 9205
!WB	SKIP THE BASELINE INTERRILL ERODIBILITY CALC IF THIS IS A CHANNEL
!wb	CELL
!WB	Calculate the baseline interrill erodibility parameter, Kibase
	IF (SAND(K).GE.0.30) THEN
		IF (VFS(K).GE.0.40) THEN
		VFSCALC=0.40
		ELSE
		VFSCALC=VFS(K)
		ENDIF
		KIBASE(CNT)=2728000+19210000*VFSCALC
!WB	BASELINE INTERRILL ERODIBILITY
	ENDIF
	IF (SAND(K).LT.0.30) THEN
		IF (CLAY(K).LT.0.10) THEN
		CLAYCALC=0.10
		ELSE
		CLAYCALC=CLAY(K)
		ENDIF
		KIBASE(CNT)=6054000-5513000*CLAYCALC
	ENDIF
!WB	The adjusted interrill erodibility parameter is:
!WB	Kiadj=Kibase*Kican*Kigrcov*Kisc where Kibase = baseline interrill
!WB	erodibility, Kican = canopy height adjustment, Kigrcov = ground
!WB	ground cover adjustment, Kisc = sealing and crusting adjustment.
!WB	Because these variables are expected to change throughout the season,
!WB	they are calculated on a daily basis.
 

	IF (KIBASE(CNT).GE.12000000) THEN
!WB	LIMITS SUGGESTED BY WEPP	
	WRITE (*,3010) CNT,KIBASE(CNT)
	WRITE (2,3010) CNT,KIBASE(CNT)
	KIBASE(CNT)=12000000
	PAUSE
	ENDIF
	IF (KIBASE(CNT).LT.500000) THEN
	WRITE (*,3012) CNT,KIBASE(CNT)
	WRITE (2,3012) CNT,KIBASE(CNT)
	KIBASE(CNT)=500000
	PAUSE
	ENDIF


 9205 CONTINUE
 9210	ENDDO
	ENDIF
!WB	END OF INIT=0 'LOOP'
!WB	******* END OF NEW SED SUBROUTINE INITIALIZATION ***************


***********************if then loop #699************************
	
	DO M=1,N2
		IF (POND(M).GT.0) THEN
		IF(CALLBMP(M).EQ.1) THEN
		IF(SUB(POND(M)).EQ.0) THEN
			IF((((H2ODEPTH(POND(M)).GT.ORBOT(POND(M))).AND.
	1			(TIPE(POND(M)).EQ.1))).OR.(((H2ODEPTH(POND(M)).GT.
     2			RISH(POND(M))).AND.(TIPE(POND(M)).EQ.2)))) THEN				
				BMPFLAG=1
			END IF
		END IF
		END IF
		END IF
	END DO
!RZ	URBAN::if the volume of water in a cell is greater than the orifice bottom
!RZ	(i.e., outflow to other elements may occur and must be tracked), set the 
!RZ	flag so the next if then will be satisfied and execution will continue

    !  IF (RAITES.EQ.1) THEN
!RZ	if raintest=1 then
!WB	this if then loop goes for several pages, look for program 
!WB		marker # 2611
!RZ	URBAN:: changed 8/13/01: make this loop go for irrigation days too
!RZ	or for days when the height of water in a bmp is greater than 0
	IF ((RAITES.EQ.1).OR.(IRRFLAG.EQ.1).OR.(BMPFLAG.EQ.1)) THEN
	
	IF ((RAITES.EQ.0.).AND.(BMPFLAG.EQ.1)) THEN
		WRITE(*,*) '  ...Draining Pond'
	    
		!RZ	This if-then initializes stuff to zero that rainfa would
		!RZ normally have done.
		
		AINO3(CHOUT(1))=0.
		AINH4(CHOUT(1))=0.
		SPI(CHOUT(1))=0.
		DO IC=1,NPART
			SI(CHOUT(1),IC)=0.
			PI(CHOUT(1),IC)=0.
			ANI(CHOUT(1),IC)=0.
			ONI(CHOUT(1),IC)=0.
		END DO
		DO I=1,N2
		SS(I)=0.
		SEL(I)=0.
		NO3SEL(I)=0.
		NHWSEL(I)=0.
		NHSSEL(I)=0.
		TKNSEL(I)=0.
		PO4SEL(I)=0.
		PSEL(I)=0.
		END DO
	END IF

!WB	******* BEGIN SEDIMENT SUBROUTINE DAILY CALC'S **************

!WB	The # of days since last soil disturbance is approximated by
!WB	DAYDIFF, which is the current day - the planting day
!WB	for the crop in the current rotation.
 	DO 9305 CNT=1,N2	
	K=SOIL(CNT)/256
!wb	K extracts the soil type #
	JK=MOD(SUR(CNT),256)
!WB	jk extracts the crop descriptor # (cover type)
	IF (CNT.GT.N) THEN
	JK=21
	NOTILL(JK)=1
	LRFAC(JK)=0.
	DDROOTI(JK)=0.
	DDRTFAC(JK)=0.
	ENDIF
!RZ	above sets values for channel cells and gives channel cells a crop type 21
!RZ	(which is higher than the maximum 20 crop types)

!RZ	URBAN:::following check skips the sediment calculations if the cell is urban
	IF (URB(CNT).EQ.1) THEN
!		URBAN=5
!		IDUMMY=0
!		CALL URBANIZED(URBAN,IDUMMY,IDUMMY,ADUMMY,IDUMMY,IDUMMY,IDUMMY
!!	1,IDUMMY,CNT,IDUMMY,IDUMMY,IDUMMY,DUMMY,DUMMY,ADUMMY,DUMMY,DUMMY,
!	2DUMMY,DUMMY,DUMMY,IDUMMY,IDUMMY,IDUMMY,ADUMMY,ADUMMY)
		GOTO 9304
	END IF

	IF (CNT.LE.N) THEN
!WB	SKIP THIS SECTION IF IT'S A CHANNEL CELL	
	IF (DAYDIFF(CNT).EQ.0) THEN
	IF (NOTILL(JK).EQ.0)	MAXWID=0.0000001
	ENDIF
	ENDIF	
!WB	THIS SAYS THAT IF THE DAYDIFF=0,  A ROTATION HAS JUST BEEN CHANGED,
!WB	AND THEREFORE PREVIOUS RILLS HAVE BEEN DESTROYED, AND NEW RILLS 
!WB	MUST BE TRACKED.

	KRCONS(CNT)=0.00035-0.0014*FCFRAC(K)+0.00068*SILT(K)
	1+0.0049*MASSCF(K)
!WB	This is a soil consolidation factor for use in the sealing and 
!WB	crusting adjustment equation.
	IF (FCFRAC(K).GT.1) THEN
	WRITE (2,3014) FCFRAC(K),K
	WRITE (*,2592)
	STOP
	ENDIF
	IF ((KRCONS(CNT).LT.0.).OR.(KRCONS(CNT).GT.1.)) THEN
	WRITE (2,3016) KRCONS(CNT),CNT
	WRITE (*,2592)
	STOP
	ENDIF	
	IF ((CNT.GT.N).OR.(NOTILL(JK).EQ.1)) THEN
	KRSC(CNT)=(KRCONS(CNT)/KRBASE(CNT))
	ELSE
	KRSC(CNT)=(KRCONS(CNT)/KRBASE(CNT))+(1-(KRCONS(CNT)/KRBASE(CNT)))*
	1exp(-BD(K)*DAYDIFF(CNT))
!WB	Krsc=sealing and crusting adjustment for rill erodibility.  It is 
!WB	dependent upon the # of days since soil disturbance.  The quantity
!WB	(DAYDIFF(CNT)) is the # of days since planting, which will be
!WB	the last assumed day of disturbance.
	ENDIF

	IF ((KRSC(CNT).LT.0).OR.(KRSC(CNT).GT.1)) THEN
	WRITE (2,3018) KRSC(CNT),CNT
	WRITE (*,2592)
	STOP
	ENDIF
	IF ((CNT.LE.N).OR.(NOTILL(JK).EQ.0)) THEN
!WB	IF ITS A O.F. CELL OR A CONV TILLAGE, CALC BURIED RES ADJUSTMENT
	BURRES(JK)=BR(JK)*exp(-0.010181*DAYDIFF(CNT))
!WB	THIS FACTOR BASED ON THE WORK OF BROWN, FOSTER, BEASLEY, 60%
!WB	REDUCTION OVER 90 DAY PERIOD LN 0.4 / -90 = 0.010181
	KRBR(CNT)=exp(-0.4*BURRES(JK))
!WB	Krbr = adjustment for buried residue, where br(M) is the 
!WB	mass of buried residue (kg m-2) w/in 0 to 0.15 m of the soil zone
	ENDIF
	IF ((CNT.GT.N).OR.(NOTILL(JK).EQ.1)) THEN
!WB	IF CHANNEL CELL OR NOTILL COVER, SET THE BURIED RESIDUE FACTOR=1.
	KRBR(CNT)=1.
	ENDIF
	IF ((KRBR(CNT).LT.0).OR.(KRBR(CNT).GT.1)) THEN
	WRITE (2,3005) KRBR(CNT)
	WRITE (*,2592)
	STOP
	ENDIF
	
	TAUCONS(CNT)=8.37-11.8*FCFRAC(K)-4.9*SAND(K)
!WB	This is a consolidation adjustment for the baseline critical shear.
	IF ((CNT.GT.N).OR.(NOTILL(JK).EQ.1)) THEN
	TAUSC(CNT)=(TAUCONS(CNT)/TAUCB(CNT))
	ELSE
	TAUSC(CNT)=(TAUCONS(CNT)/TAUCB(CNT))+(1-(TAUCONS(CNT)/TAUCB(CNT)))
	1*exp(-BD(K)*DAYDIFF(CNT))
!WB	tausc=sealing and crusting adjustment for critical shear.
	END IF
	
	TAUCADJ(CNT)=TAUCHLD(CNT)*TAUSC(CNT)
!WB	taucadj=adjusted critical shear calculated in the initialization of
!WB	the program * sealing and crusting adjustment.
      IF ((TAUCONS(CNT).LT.0.).OR.(TAUCADJ(CNT).GT.15)) THEN
	WRITE (*,3030) TAUCONS(CNT),CNT
	WRITE (2,3030) TAUCONS(CNT),CNT
	STOP
	ENDIF
	IF (CNT.GT.N) GO TO 9300
!WB	THIS SKIPS THE INTERRILL CALCS IF YOU ARE CALCULATING CHANNEL 
!WB	EROSION.
	HEIGHT(JK)=HGTFACT(JK)*(DAYDIFF(CNT)+1)
!WB	the height at this day = the height factor * the # of days since
!WB	planting.  The daydiff +1 is added to avoid a div by 0 error below.
	CANOPY(JK)=AUCFACT(JK)*(DAYDIFF(CNT)+1)
!WB	the canopy area at this day = canopy factor * the # of days since
!WB	planting
	IF (HEIGHT(JK).GT.MAXPLHGT(JK)) HEIGHT(JK)=MAXPLHGT(JK)
	IF (CANOPY(JK).GT.(AC(JK)/100)) CANOPY(JK)=(AC(JK)/100)
      IF ((HEIGHT(JK).GT.3.0).OR.(CANOPY(JK).GT.1.)) THEN
	WRITE (*,3032) CNT
	WRITE (2,3032) CNT
	PAUSE
	ENDIF	
!WB	IF THE HEIGHT EXCEEDS THE MAXIMUM PLANT HEIGHT, OR CANOPY EXCEEDS
!WB	ITS INPUT MAX VALUE, THEN
!WB	height=maximum height and canopy=maximum canopy
	IF (HEIGHT(JK).NE.0) THEN
!WB	ADDED TO ELIMINATE DIV BY 0
	KICAN(CNT)=1-2.941*(CANOPY(JK)/HEIGHT(JK))*
	1(1-exp(-0.34*HEIGHT(JK)))
!WB	Kican=canopy height adjustment factor.  CANOPY IS THE FRACTION OF
!WB	GROUND COVERED BY CANOPY AT THIS DAY, HEIGHT IS PLANT HEIGHT AT 
!WB	THIS DAY.  CANOPY & HEIGHT ARE LINEAR FUNCTIONS OF THEIR MAX VALUES.
	ELSE
	KICAN(CNT)=1
	ENDIF
	
	IF ((KICAN(CNT).LT.0).OR.(KICAN(CNT).GT.1)) THEN
	IF (KICAN(CNT).LT.0) THEN
	WRITE (2,3034) KICAN(CNT),CNT
	WRITE (*,2592)
	STOP
	ELSE
	IF (KICAN(CNT).GT.1) THEN
	WRITE (2,3034) KICAN(CNT),CNT
	WRITE (*,3034) KICAN(CNT),CNT
	PAUSE 
	ENDIF
	ENDIF
	ENDIF

	INRCOV(JK)=INRCOVI(JK)+(INRFACT(JK)*(DAYDIFF(CNT)+1))
!WB	inrcov=fraction of interrill area covered by ground cover
	IF (INRFACT(JK).GT.0) THEN
!WB	IF COVER INCREASES
	IF (INRCOV(JK).GT.INRCOVF(JK)) INRCOV(JK)=INRCOVF(JK)
!WB	IF THE CALC INT COV EXCEEDS THE FINAL VALUE INPUT, SET THEM EQUAL
	ELSE

!WB	IF COVER DECREASES
	IF (INRCOV(JK).LT.INRCOVF(JK)) INRCOV(JK)=INRCOVF(JK)
!WB	IF THE COVER DROPS BELOW THE FINAL VALUE, SET THEM EQUAL
	ENDIF
	IF (INRCOV(JK).GT.1) THEN
	INRCOV(JK)=1.
	WRITE (2,3036) INRCOV(JK),JK
	WRITE (*,2592) INRCOV(JK),JK
	PAUSE 
	ENDIF
	
	IF (INRCOV(JK).LT.0) THEN
	WRITE (2,3049) INRCOV(JK), JK
	WRITE (*,2592)
	PAUSE
	STOP
	ENDIF
	
		
	KIGRCOV(CNT)=exp(-2.5*INRCOV(JK))
!WB	kigrcov=ground cover adjustment factor, which is a function of crop
!WB	crop properties.  Inrcov is the fraction of interrill area covered
!WB	by ground cover.
      IF ((KIGRCOV(CNT).LT.0).OR.(KIGRCOV(CNT).GT.1)) THEN
	IF (KIGRCOV(CNT).LT.0) THEN
	WRITE (2,3038) KIGRCOV(CNT),CNT
	WRITE (*,2592)
	STOP
	ELSE
	IF (KIGRCOV(CNT).GT.1) THEN
	WRITE (2,3038) KIGRCOV(CNT),CNT
	WRITE (*,3038) KIGRCOV(CNT),CNT
	PAUSE 
	ENDIF
	ENDIF
	ENDIF
	
	KICONS(CNT)=1000*(3042-3166*SAND(K)-8816*ORGMAT(K)-2477*
	1FCFRAC(K))
!WB	Kicons=consolidation adjustment for sealing and crusting adjustment
!WB	to the interrill erodibility.
	IF (KICONS(CNT).LT.0) THEN
	WRITE (2,3040) SAND(K),ORGMAT(K),FCFRAC(K)
	WRITE (*,2592) 
	PAUSE
	STOP
	ENDIF
	IF (NOTILL(JK).EQ.1) THEN
	KISC(CNT)=(KICONS(CNT)/KIBASE(CNT))
	ELSE
	KISC(CNT)=(KICONS(CNT)/KIBASE(CNT))+(1-(KICONS(CNT)/KIBASE(CNT)))
	1*exp(-BD(K)*DAYDIFF(CNT))
!WB	Kisc=interill sealing and crusting adjustment.  DAYDIFF(CNT) is
!WB	the # of days since disturbance.
	ENDIF
	IF ((KISC(CNT).LT.0).OR.(KISC(CNT).GT.1)) THEN
	IF (KISC(CNT).LT.0) THEN
	WRITE (2,3042) KISC(CNT),CNT
	WRITE (*,2592)
	STOP
	ELSE
	IF (KISC(CNT).GT.1) THEN
	WRITE (2,3042) KISC(CNT),CNT
	WRITE (*,3042) KISC(CNT),CNT
	PAUSE 
	ENDIF
	ENDIF
	ENDIF
	
 9300	CONTINUE
!WB	AFTER THE INCLUSION OF THE DEAD AND LIVE ROOT FACTORS FOR 
!WB	RILL AND INTERRILL ERODIBILITY ADJUSTMENT, THE ADJUSTED
!WB	RILL ERODIBILITY HAD TO BE CALCULATED HERE, BECAUSE
!WB	THE LIVE AND DEAD ROOT FACTORS ARE CALCULATED HERE.
!WB	AN IF-THEN STATEMENT SKIPS THE INTERRILL ERODIBILITY ADJUSTMENT
	LROOT(JK)=LRFAC(JK)*(DAYDIFF(CNT)+1)
	IF (LROOT(JK).GT.LIVEROOT(JK)) LROOT(JK)=LIVEROOT(JK)
	KLROOTI(CNT)=EXP(-0.56*LROOT(JK))
	IF ((KLROOTI(CNT).LT.0).OR.(KLROOTI(CNT).GT.1)) THEN
	WRITE (2,3058) KLROOTI(CNT),JK,CNT
	WRITE (*,2592)
	PAUSE
	STOP
	ENDIF

	DROOT(JK)=DDROOTI(JK)+DDRTFAC(JK)*(DAYDIFF(CNT)+1)
	IF (DROOT(JK).LT.DDROOTF(JK)) THEN
	DROOT(JK)=DDROOTF(JK)
	ENDIF
	KDROOTI(CNT)=EXP(-0.56*DROOT(JK))
	IF ((KDROOTI(CNT).LT.0).OR.(KDROOTI(CNT).GT.1)) THEN
	WRITE (2,3060) KDROOTI(CNT),JK,CNT
	WRITE (*,2592)
	PAUSE
	STOP
	ENDIF

	IF (CNT.LE.N) THEN
!WB	IF IT'S AN O.F. CELL, DO THE KIADJ CALC
	KIADJ(CNT)=KIBASE(CNT)*KICAN(CNT)*KIGRCOV(CNT)*KISC(CNT)
	1*KLROOTI(CNT)*KDROOTI(CNT)
!WB	Kiadj=adjusted interrill erodibility parameter.
      IF (KIADJ(CNT).LT.0) THEN
	WRITE (2,3044) KIADJ(CNT),CNT
	WRITE (*,2592)
	STOP
	ENDIF
	ENDIF
	
	KLROOTR(CNT)=EXP(-3.5*LROOT(JK))
	IF ((KLROOTR(CNT).LT.0).OR.(KLROOTR(CNT).GT.1)) THEN
	WRITE (2,3054) KLROOTR(CNT),JK,CNT
	WRITE (*,2595)
	PAUSE
	STOP
	ENDIF
	
	KDROOTR(CNT)=EXP(-2.2*DROOT(JK))
	IF ((KDROOTR(CNT).LT.0).OR.(KDROOTR(CNT).GT.1)) THEN
	WRITE (2,3056) KDROOTR(CNT),JK,CNT
	WRITE (*,2592)
	PAUSE
	STOP
	ENDIF
	
 	KRADJ(CNT)=KRBASE(CNT)*KRSC(CNT)*KRBR(CNT)*KLROOTR(CNT)
	1*KDROOTR(CNT)
!WB	This is the adjusted rill erodibility parameter, which is 
!WB	initialized previously and recalculated here to include
!WB	consolidation with time.
      IF ((KRADJ(CNT).LT.0.).OR.(KRADJ(CNT).GT.1)) THEN
	IF (KRADJ(CNT).LT.0) THEN
	WRITE (2,3020) KRADJ(CNT),CNT
	WRITE (*,2592) 
	STOP
	ELSE
	WRITE (2,3022) KRADJ(CNT),CNT
	WRITE (*,3022) KRADJ(CNT),CNT
	PAUSE
	ENDIF	
	ENDIF






 9304 CONTINUE
 9305	END DO

!WB	******* END OF SEDIMENT SUBROUTINE DAILY CALC'S **************
!RZ	URBAN::IN THE NEXT FEW CALCULATIONS, THE PREMOI AND PREPIV ARE SUMMED UP AND THEN AFTER
!RZ	THE LOOP THEY ARE AVERAGED.  TO GIVE AN ACCURATE AVERAGE, YOU PROBABLY SHOULD NOT INCLUDE
!RZ	THE URBAN CELLS IN THE DIVISOR, AS THEY FORCE ZEROS INTO THE TOTAL.  SO, INITIALIZE A 
!RZ	VARIABLE 'L' FOR A DIVISOR AFTER LINE 6000.  
	L=0
!WB***************do loop # 717*************************	 
	 DO 6000 J=1,N
!WB	 do from counter J to # of overland flow elements
!RZ	URBAN::if the cell is urban, skip these calculations (no soil to hold moisture)
	IF (URB(J).EQ.1) GO TO 6000
       K=SOIL(J)/256
!WB	 soil factor for element
       PIV(J)=(1.-(ASMVOL(J)+RESWAT(K))*CU1/TP1(K))*TP1(K)/DT
!WB		Volume of air filled pore space in upper layer = 
!WB	    (1 - (ASMVOL(flow element)+res. water as a fraction of 
!WB		soil porosity) * conversion-mm to m^3 / soil porosity ) 
!WB	    * porosity / time increment   
   	   ASMPER(J)=ASMVOL(J)*CU1/TP1(K) 
!WB	   unknown
!RZ	this is percent of the pore spaces filled = volume of water in soil*conversion/total porosity
!RZ	(done for every overland flow element, using the asmvol from outside the loop and tp1
!RZ	dependent on soil type for the overland flow element) - as decimal
!RZ	on second thought, this is converting ASMVOL, which is in mm, to ASMPER, which is as a percent
!RZ	total porosity (like the percentages in the soil input file)

       PREMOI=ASMPER(J)+PREMOI 
!WB	 unknown
!RZ	seems to be summing up the percent moisture for each cell to
!RZ	give a pre-moisture for the watershed
       PREPIV=PREPIV+PIV(J) 
!WB	 unknown
!RZ	seems to be summing up the air-filled pore space percent for the watershed to give
!RZ	a pre-air filled pore space

!RZ	URBAN::INCREMENT THE DIVISOR (SEE NOTE ABOVE DO LOOP #717)
	L=L+1
 6000  CONTINUE
!WB***************end do loop # 717**********************
!RZ       PREMOI=PREMOI/N 
	IF (L.GT.0) THEN
	PREMOI=PREMOI/L
!RZ	URBAN:: CHANGED THIS TO PREMOI=PREMOI/L so as not to warp the percent with noncontributing
!RZ	urban cells.
!WB	 unknown
!RZ	this gives the average pre-moisture percent

!RZ	URBAN::CHANGED THIS TO PREPIV=PREPIV/L
	PREPIV=PREPIV/L
!RZ       PREPIV=PREPIV/N 
!WB	 unknown
!RZ	this gives the average pre-air filled pore space percent
	END IF
!RZ	URBAN::MAKE SURE THERE ARE VARIABLES FOR ALL THESE TO PASS FOR URBAN CELLS
	IF (RAITES.EQ.1) THEN
 5570 CALL RAINFA(NRG,FILTS,PP,N,CU1,CU2,CU,DT,TMIN,TMAX,KPR,NDT,
     1 ISTRUC,NMAX,ICR,NN,NCHAN,YERBEG,LDAY,DX,SOIVOL)
!WB		NRG = # of raingage, FILTS = infiltration cap., PP = 
!WB		alphanumeric unit descriptor, N = # overland flow elements, 
!WB		CU1 = conv. mm to m^3, CU2 = twice m^3, CU = mm/h to m^3 / s,
!WB		DT = time increment, TMIN = min time value of hyetograph, 
!WB		TMAX = max time value of hyetograph, KPR = # of time 
!WB		increment routings b/t print lines, NDT = # of lines of 
!WB		hydrograph print, ISTRUC = structural practice counter
!WB		NMAX = maximum # of cells, ICR = # of cropping practices, 
!WB		NN = N2 +1 (# of channel + # of overland flow elements + 1) 
C
C **** COMPUTE THE PIECE-WISE LINEAR SEGMENTS FOR USE IN MANNING'S
C **** EQUATION.
C
	END IF
      SC=((SF*CONV/SB)**.6)/300. 
!WB	depth incr. for segmented curve = [[seg. factor = max projected
!WB	catchment discharge * (conv mm/h to m/s / ave. overland flow 
!WB	conveyance coefficient) ] ^0.6 ] / 300

	D=0. 
!WB	depth increment = 0
!WB************************do loop # 760********************
      DO 10 I=1,300 
      QA(I)=D**1.66667 
!WB	incremental depth power values
   10 D=D+SC 
!WB	depth = depth + segmented curve depth increment
!WB************************end do loop # 760****************
      SC=1./SC 
!WB	depth increment = inverse of depth increment
	
*--*
       DX2=DX*DX 
!WB        = length of side * length of side
*--*
C
C **** INITIALIZE VARIABLES.
C **** SET RAINFALL INITIAL VALUES.
C
!WB*********************do loop # 778***********************
      DO 20 I=1,NRG 
!WB	do from counter I = 1 to number of rain gages
      JTR(I)=1 
!WB	current rainfall intensity histogram period for rain gage i
      IF (TC(I,2).EQ.TMIN) JTR(I)=2 
!WB	if time of jth histogram period for gage i = min. time , 
!WB	current rainfall int. histogram period = 2
      SR(I)=0. 
!WB	rainfall rate from prev. calculation
   20 NF(I)=NFI 
!WB	down counter = max # of time increments b/t infiltration recalculations
!WB********************end do loop # 778********************
      N1=N+1 
!WB	N1 = number of elements + 1
      N2=NN-1 
!WB	reset N2 to # overland flow + # channel elements
      CHN=N2-N 
!WB	 # channel seg's = above - # of o.f. elements
C
C **** EROSION CONSTANTS.
C
      IF (IT.LE.0) GO TO 30 
!WB	unknown
C
C **** METRIC UNITS.
C

!WB		These can all be removed, 9/29/98

* CE1 and CE2 were not corrected because they are not
* used anymore
!      CE1=9.66155E+5
!      CE2=2.0847E+1
!      CE3=6.53864E+6
*these correction are made according to the Wisconsin
*department of Natural resources, EPA final report (1986)

!WB		This can be removed also, 9/29/98

C **** NRZ 8/5/95
C **** CE3 was divided by 20. in order to examine difference in sediment
C **** output.

!      CE3=CE3/20.

!      CE4=5.25545E+1
!      CE4=CE4
!      CE5=7.7419E-4
      CE6=1.E+3
C
C **** INITIALIZE VALUES.
C
C **** NRZ 9/14/94
C **** ADD DIMENSIONS FOR MULTIPLE CHANNEL OUTLETS
   
!WB******************do loop # 836********************
   30 DO 25 NCH=1,NCHAN+1 
!WB     NCH is a channel counter, do from that until you equal the # of 
!WB	channels + 1
	VOL(NCH)=0. 
!WB	accumulated runoff depth
	SSI(1,NCH)=0. 
!WB	accumulated loss at print line i
	PSSI(1,NCH)=0.0 
!WB	accumulated sediment bound P-loss, line i for a given storm
	SPSSI(1,NCH)=0. 
!WB	accum dissolved P loss
	ANSSI(1,NCH)=0. 
!WB	accum sed-bound ammonium loss
	ANH4SI(1,NCH)=0. 
!WB	accum dissolved ammonium loss
	ONSSI(1,NCH)=0. 
!WB	accum sed. bound TKN loss
	ANO3SI(1,NCH)=0. 
!WB	accum dissolved nitrate loss
	SSCON(1,NCH)=0. 
!WB	sed conc at print line i
	RW(1,NCH)=0. 
!WB	average rainfall intensity over catchment
	Q1(1,NCH)=0.
!WB	discharge from catchment at i
   25 CONTINUE
!WB************************end do loop # 836**********************
      BMPFLAG=0
!RZ	reset the bmpflag to zero.  This was moved here from right after the 
!RZ	if raites.eq.1 test to accomodate the if then in the previous 
!RZ	do loop (loop #836) but then I cut out the if-then, but it still
!RZ	works here so I just left it here
	SDR=0. 
!WB	accum groundwater storage
      CHDR=0.
!WB	groundwater discharge into a channel segment
      RMAX=0.
!WB	MAX RAINFALL INTENSITY?
      QMAX=0. 
!WB	MAX FLOW?
      CMAX=0.
!WB	MAX SEDIMENT?
      PREC=0.
!WB	accum depth of precip
      DTM=DT/60.
!WB	sim. time increment in minutes
      T(1)=TMIN 
!WB    	= min time value on hyetograph

C **** NRZ 9/14/94

C
C .... INITILIZATION OF DATA EXTENDED SED SUBROUTINE
C
      ERG=0.
!WB	sum of all particle size classes leaving watershed
!WB********************do loop # 888*********************
      DO 31 I1=1,8 
!WB	do this for the number of particle size classes?
   31 ER(I1)=0.
!WB     amount of particle type i leaving watershed
!WB********************end do loop # 888*****************
      YALCON=0.635 
!WB	Yalin's constant = 0.635
 
*
* INITIALIZE VARIABLES FOR THE PHOSPHORUS COMPONENT
*
*
      TESPLA=0.
!WB	unknown
      TESNH4=0.
!WB	unknown
      TESNO3=0.
!WB	unknown
!RZ	above variables are used in the following loop to accumulate the nutrients
!RZ	in the EDI and then average them.


!RZ	URBAN:::variable L is used to count the number of non-urban cells - those that are 
!RZ	actually contributing to the TES variables above - so that an accurate average
!RZ	can be taken after the termination of the loop.
	L=0

!WB********************do loop # 907************************
      DO 32 M=1,N 
!WB	do from element # counter, M, to the # of overland flow elements
!RZ	URBAN:::if cell is urban, skip this entire loop to avoid several
!RZ	divide by zeros.  
	IF (URB(M).EQ.1) THEN
	URBAN=5
	DUMMY=0.
	IDUMMY=0
	CALL URBANIZED (URBAN,IDUMMY,IDUMMY,A1DUMMY,IDUMMY,IDUMMY,IDUMMY
	1,IDUMMY,M,IDUMMY,CDUMMY,IDUMMY,CDUMMY,SOIVOL,A5DUMMY,DUMMY,DUMM
	2Y,DUMMY,DUMMY,DUMMY,IDUMMY,IDUMMY,A2DUMMY,A2DUMMY,CROP)
	GO TO 32
	END IF
!RZ	Also need to have L (see below) as a dummy variable used to hold number of cells
!RZ	contributing to TESnutrient so we get an accurate average later.
       ISOIL= SOIL(M)/256 
!WB	 ISOIL = soil type of element M 
!RZ	THIS RETURNS TYPE OF SOIL

	PSSA=(P0SOIL(M)+(P0ADD(M)/SOIVOL(ISOIL)))/SSAT(ISOIL) 
!WB    	? = original P mass? / total specific surface area
*
* AMMONIUM AND ORGANIC N SEDIMENT BOUND ORIGINAL CONCENTRATION
*A0SOIL IS EXPRESSED IN KG
!RZ	I think A0 and O0 soil are in kgnutrient/kg soil
	 ANPSSA=(A0SOIL(M)+(A0ADD(M)/SOIVOL(ISOIL)))/SSAT(ISOIL) 
!WB	 = sed. bound ammonium soil conc. ?
	 ONPSSA=(O0SOIL(M)+(O0ADD(M)/SOIVOL(ISOIL)))/SSAT(ISOIL) 
!WB	 = sed. bound org-N conc. ?
 
!WB*******************do loop # 923**************************
	 DO 33 IC=1,NPART 
!WB	 do from counter NC = 1 to # of particle size classes
	 P0(M,IC)=SSA(ISOIL,IC)*PSSA/F(ISOIL,IC)
!WB	 unknown; rwz looks like phosphorus per particle size class
	 AN0(M,IC)=SSA(ISOIL,IC)*ANPSSA/F(ISOIL,IC) 
!WB	 unknown; rwz looks like nitrate per particle size class
	 ON0(M,IC)=SSA(ISOIL,IC)*ONPSSA/F(ISOIL,IC)
!WB	 unknown; rwz looks like organic nitrogen per particle size class
	 ERP(IC)=0.
!WB	 unknown; rwz not used in program; from faycal's dissertation, 
!RZ	=P enrichment ratio
	 STOLD(M,IC)=0. 
!WB	 SEDIMENT STORAGE AT PREVIOUS TIME STEP
	 STNEW(IC)=0. 
!WB	 SEDIMENT STORAGE AT THIS TIME STEP

** NRZ 9/23/94
** CORRECTION
** ADD ONPT AND ONI TO THESE INITIALIZATIONS
 

	 ANPT(M,IC)=0. 
!WB	 unknown
	 PPT(M,IC)=0. 
!WB	 unknown
	 ONPT(M,IC)=0. 
!WB	 unknown
!RZ	see faycal's dissertation: sum of the initial values of the nutrient 
!RZ	specie under consideration

	 ANI(M,IC)=0.
!WB	 unknown
	 PI(M,IC)=0.
!WB	 unknown
	 ONI(M,IC)=0.
!WB	 unknown
!RZ	seems from name like it might be inflowing value for each nutrient?

** NRZ 9/23/94

  33      CONTINUE
!WB***********************end do loop # 923***************
	 T12=0.0
	 T13(M)=0.0
 
      KK=SOIL(M)/256 
!WB	soil type of current element = 
!RZ	this is an integer, so if you look at soil(m), this gives the soil
!RZ	type because the remainder, rotation number, is truncated 
      rbit0(m)=0. 
!WB	unknown
      tpon(m)=0. 
!WB	equiv. time to ponding, time to infiltrate cum. ponding under 
!WB	ponded conditions
      timpon(m)=0. 
!WB	time to ponding (min)
      testi(m)=0.
!WB	flag indicating ponding
      TESPLA=EDILAB(M)+TESPLA 
!WB    	? = labile P in the EDI + ?
!RZ	this is just summing up the labile P in the EDI, for use later to get an average
!RZ	labile P in the EDI
      TESNH4=EDINH4(M)+TESNH4 
!WB    	? = NH4 in the EDI + ?
!RZ	this is just summing up the NH4 in the EDI, for use later to get an average
!RZ	NH4 in the EDI
      TESNO3=TESNO3+EDINO3(M) 
!WB     ? = NO3 in the EDI + ?
!RZ	this is just summing up the NO3 in the EDI, for use later to get an average
!RZ	NO3 in the EDI 

!RZ	URBAN:::L is incremented to record the number of cells actually contributing to
!RZ	the TES variables so an accurate average can be taken below.
	L=L+1
 32    CONTINUE
!WB**********************end do loop # 907***********************

!RZ	URBAN:::changed the following variables to be divided by L instead
!RZ	of N
	
	IF (L.GT.0) THEN
!RZ	TESPLA=TESPLA/N 
	TESPLA=TESPLA/L
!WB	 ? = ? / # of overland flow elements
!RZ	average (over all cells in watershed) labile P in the EDI
!RZ	TESNO3=TESNO3/N
	TESNO3=TESNO3/L 
!WB	 ? = ? / # of overland flow elements
!RZ	average (over all cells in watershed) NO3 in the EDI
!RZ	TESNH4=TESNH4/N
	TESNH4=TESNH4/L 
!WB	 ? = ? / # of overland flow elements
!RZ	average (over all cells in watershed) NH4 in the EDI
	END IF
C
C
C
C **** START COMPUTATION FOR EACH HYDROGRAPH PRINT LINE AT DT*KPR. 
!WB ***DT = time incr, KPR = # of time increment routings b/t print lines
C
***************************do loop 972***************************
      DO 220 L=2,NDT 
!WB	do from counter L = 2 to # of lines of hydrograph print
      LM1=L-1 
!WB	unknown
      T(L)=T(LM1) 
!WB	real time at counter = time at L-1
C
C **** CONTINUITY EQUATION FOR TIME INCREMENTS DT.
C
***************************do loop 982***************************
      DO 170 J=1,KPR 
!WB	do from J = 1 to # of time increment routings b/t print lines

C *** NRZ 9/15/94
C *** MODIFY ELEMENTS OF PI AND SI TO REPRESENT MULTIPLE OUTLETS
*************************do loop #988****************************
      DO 37 NCH=1,NCHAN+1 
!WB	do from NCH counter to # of channels + 1

      SPT(NCH)=0.
!WB	accum sed. loss at previous time
*
* PSPT ACCUMULATED SEDIMENT-BOUND PHOSPHORUS LOSS
      PSPT(NCH)=0.
      DO 35 IC=1,NPART 
      PSPT(NCH)=PSPT(NCH)+PI(CHOUT(NCH),IC) 
!WB    	? = ? + inflow of P
!RZ	pspt=accumulated sediment-bound phosphorus
   35 SPT(NCH)=SPT(NCH)+SI(CHOUT(NCH),IC) 
!WB     accum sed loss previous time = same + sed. inflow
   37 CONTINUE    
***************************end do loop #988******************************
C *** NRZ 9/15/94

      T(L)=T(L)+DTM 
!WB	time = time + time increment in minutes
C
C **** CALCULATE NET RAINFALL FOR EACH GAGE AND SURFACE CONDITION AND
C **** UPDATE INFILTRATION CAPACITIES WITHIN GAGE AREA ON TIME OR NET
C **** RAINFALL CHANGE.
C
***************************do loop 1014***************************
      DO 90 JJ=1,NRG 
!WB	do from counter JJ = 1 to # of rain gages

	IF (IIRRI.EQ.1) THEN
	IRRIGAT=2
	CALL IRRIGATE(LDAY,RAITES,YERBEG,IDATE,IRRIGAT,ICR,T(L),TMAX,
	1JJ,ITR,CU,N,CU1,DT)

	IF (SKIPFLAG.EQ.2) GO TO 230
	IF (SKIPFLAG.EQ.1) GO TO 60
	END IF
!	if the irrigation flag is triggered, set the irrigat variable to 2
!	(this tells the subroutine to execute the second part of the 
!	subroutine); the subroutine returns skipflag.  If skipflag is 2,
!	that indicates that there is no more rainfall or irrigation; if
!	skipflag is 1, it indicates that there is no more rainfall but
!	irrigation is not completed yet.

	DO M=1,N
	IF (POND(M).GT.0) THEN
	IF (CALLBMP(M).EQ.1) THEN
	IF ((T(L).GE.TMAX).AND.(H2ODEPTH(POND(M)).GT.0.01).AND.
	1		(T(L).LT.1440.)) THEN
		RATE(JJ)=0.
		QI(M)=0.
		GO TO 60
	END IF
	IF (RAITES.NE.1) THEN
		RATE(JJ)=0.
		QI(M)=0.
		RC(JJ,ITR)=0.
		GO TO 60
	END IF
	END IF
	END IF
	END DO
!RZ	If the depth of water in the BMP is greater than 0.01, then you need to continue
!RZ	to simulate the water loss until either the water is depleted or the next rainfall event
!RZ	occurs.

      NF(JJ)=NF(JJ)-1 
!WB	down counter from NFI = max # of time increments b/t infil. 
!WB	recalc.'s 
      ITR=JTR(JJ) 
!WB	rainfall histogram counter = current rainfall intensity histogram
!WB	for rain gage i
      ITRM1=ITR-1

      IF (T(L)-TC(JJ,ITR)) 60,60,40 
!WB	if time - jth time of rain gage i is < = > 0, 
!WB	then go to 60, 60, 40, respectively
   40 IF (T(L)-TMAX) 50,230,230 
!WB	if time - max time in hyetograph < = > 0, then go 
!WB	to 50, 230, 230, respectively.

C
C **** NEW RAINFALL RATE, ALLOW FOR DTM BRIDGING TC VALUE.
C
   50 DI=T(L)-TC(JJ,ITR) 
!WB	 = sim time - rainfall histogram change time
      ITRP1=ITR+1 
!WB	RAINFALL HIST CNTER PLUS 1 = RAINFALL HIST CNTR + 1
      RATE(JJ)=CU*(RC(JJ,ITRP1)*DI+RC(JJ,ITR)*(DTM-DI))/DTM
!WB		gage rainfall rate at gage i = conv mm/h to m^3/s * 
!WB		(rainfall intensity * time increment + prev rainfall 
!WB		intensity * (sim time increment - histogram change time))
!WB		 / sim time increment
!RZ		this determines the rainfall rate if the time increment is 
!RZ		greater than the difference between the current time and the 
!RZ		time increment from the weather file.  i.e, it allows you to 
!RZ		say that there was this much rain at this rate, then the rainfall
!RZ		rate changed and there's this much more; weight it by DI and DTM-DI
!RZ		and then divide by the total number of minutes to get in rainfall/min

      JTR(JJ)=JTR(JJ)+1 
!WB	current rainfall intensity histogram period for rain gage i = 
!WB	same + 1
      ITR=ITRP1 
!WB	rainfall histogram counter = SAME + 1
C
C **** ADD WHOLE HISTOGRAM BLOCK TO TOTAL PRECIPITATION IN
C **** PROPORTION TO WATERSHED AREA COVERED.
C
      IF ((RAITES.NE.1).AND.(RC(JJ,ITR).GT.0.)) THEN
	CONTINUE
	END IF

	PREC=PREC+RC(JJ,ITR)*(TC(JJ,ITR)-TC(JJ,ITR-1))*FRA(JJ)/60.
!WB	accum depth of precip = same + rainfall intensity * 
!WB	 (time of jth histogram for period i - same, prev period) * 
!WB	fraction of catchment area covered by i / 60
C
C **** CALCULATE NET RAINFALL FOR EACH COVER.
C
***********************do loop #1058************************************
   60 DO 70 I=1,ICR 
!WB	do from counter I = 1 to # of cropping practices
!RZ	URBAN:::rate needs to have irrigation water added to it

	IF ((RAITES.NE.1).AND.(RATE2(I).GT.0.)) THEN
		CONTINUE
	END IF

	IF ((CROPNOIRR(I).EQ.0).AND.(IRRFLAG2(I).EQ.1)) THEN
	RATE2(I)=RATE(JJ)+IRRATE(I)
	ELSE
	RATE2(I)=RATE(JJ)
	END IF

	IF ((RAITES.NE.1).AND.(RATE2(I).GT.0.)) THEN
		RATE(JJ)=0.
		RATE2(I)=0.
		CONTINUE
	END IF

!RZ	commented lines below were used to test the irrigation subroutine
!	IF (I.EQ.ICR) THEN
!	IF (LDAY.NE.INTDAY) THEN
!	WRITE (379,*) '--------------------------------------------------'
!	DO ISH=1,ICR
!	WRITE (379,1235) LDAY,YERBEG,ISH,RATE(JJ),RATE2(ISH),IRRATE(ISH)
!1235		FORMAT (1X,I3,1X,I4,1X,I2,1X,F7.5,1X,F7.5,1X,F7.5)	
!	END DO
!		INTDAY=LDAY
!	END IF

!	IF ((IRRFLAG2(I).EQ.1).AND.(I.EQ.ICR)) THEN
!	IF (LDAY.NE.INTDAY) 
!	WRITE (377,*) '--------------------------------------------------'	
!
!	WRITE (377,1234) LDAY,YERBEG,1,RATE(JJ),RATE2(I),IRRATE(I),
!	1(1-PIV(1)*DT/TP1(1)),IRRTARGET(I),DURATION(I),IRRFLAG2(I)
!1234	FORMAT (1X,I3,1X,I4,1X,I3,1X,F7.5,1X,F7.5,1X,F7.5,1X,F6.3,1X,F6.3,
!	1F8.2,1X,I1)
!
!	INTDAY=LDAY
!	END IF
!	END IF

	R(JJ,I)=RAIN(RATE2(I),PIT(JJ,I),PER(I))
!	R(JJ,I)=RAIN(RATE(JJ),PIT(JJ,I),PER(I))
!WB	Net rainfall rate, gage i, surface j = effective rainfall 
!WB	rate (rate, interception storage, fraction of area covered 
!WB	by foliage for surface type i)
      IF (R(JJ,I).EQ.SR(JJ).AND.NF(JJ).GT.0) GO TO 70 
!WB	if net rate = previous rate & down counter > 0
      SR(JJ)=R(JJ,I) 
!WB	prev rate = net rate
      NF(JJ)=-NFI 
!WB	down counter = - max of time increments b/t infil recalc.'s
   70 CONTINUE
************************end do loop #1058******************************
      RATE(JJ)=RC(JJ,ITR)*CU 
!WB	gage rate = intensity * conversion 
      IF (NF(JJ).GT.0) GO TO 90 
!WB	if downcounter > 0, go to 90
C
C **** CALCULATION OF INFILTRATION CAPACITY FOR EACH OVERLAND ELEMENT.
C
***************************do loop #1080********************************
      DO 80 M=1,N 
!WB	do from overland flow element counter M = 1 to # of overland 
!WB	flow elements
      IF (MOD(RANE(M),256).NE.JJ) GO TO 80 
!WB	 (# of rain gage applicable to i - INT (same / 256) * 256) 
!WB	NE raingage # counter
      K=MOD(SUR(M),256) 
!WB	 K=COVER type
!WB	INT(same/256)*256
      KK=SOIL(M)/256 
!WB	soil type of i = soil type of i / 256

!RZ	If the cell is urban, there is no potential infiltration; set equal
!RZ	to zero and skip over the function filt call.	
	IF (URB(M).EQ.1) THEN
	FILTS(M)=0.0
	DR(M)=0.0
	GO TO 80
	END IF

      FILTS(M)=FILT(PIV(M),FCAP1(KK),GWC(KK),DR(M),S(M),R(JJ,K)
     1,CU2,ROUGH(K),HU(K),NEXP,ASMPER(M),KE(KK,K),PSIF(KK),PHIC(KK),T(L)
     1,CU,LF(KK),KS(KK),K,kk,M,CUMIN1(M),rbit0(m),testi(m),timpon(m),
     & TPON(M),FILTS(M),DT,CU1,TP1(KK),A(KK))
!WB	FILTS = infil cap of element M, PIV = vol of air filled pore 
!WB	space, FCAP1 = field cap as fraction of pore space?, GWC = vol 
!WB	of air filled pore space at field cap., DR = vert. drain loss, 
!WB	S = storage at start of incr. i, R = net rainfall rate, CU2 = 
!WB	conv, ROUGH = surf. storage depth param for i, HU = max ht diff
!WB	on soil surface, NEXP = ?, ASMPER = ?, KE = eff. hydr. 
!WB	conductivity, PSIF = cap. pot. at infil. wetting front, PHIC = 
!WB	corrected effective porosity, T = real time, CU = conversion, 
!WB	LF = depth to wetting front, KS = sat hyd conductivity, 
!WB	K = CROP TYPE (RZ), kk = soil type, M = element no., CUMIN1 = 
!WB	cum. infiltration, rbit = ?, testi = ponding flag,
!WB	timpon = time to ponding, TPON = equil. time to ponding, FILTS = 
!WB	infil cap, DT = sim time incr (sec), CU1 = conversion, TP1 = 
!WB	porosity, A = ratio of sat. hydr. cond top layer & sat. hyd. 
!WB	cond. for underlying soil
   80 CONTINUE
************************end do loop #1080***************************
      NF(JJ)=NFI 
!WB	down counter = max # of time increments
   90 CONTINUE
	
***************************end do loop 1014*************************
C
C **** CONTINUITY EQUATION EXPLICIT SOLUTION FOR EACH ELEMENT DURING
C **** TIME INCREMENT, DT.
C
***************************do loop # 1121***************************
      DO 170 M=1,N2 
!WB	 # of overland flow + channel elements
      SSTOR=S(M)+SS(M) 
!WB	storage on element at end of time inc = storage at start + 
!WB	incremental increase in storage
       IF (SSTOR.LT.0.) SSTOR=0. 
!WB	 avail. supply for infil. < 0

      IF ((RAITES.NE.1).AND.(CALLBMP(M).EQ.1)) THEN
		IF ((SUB(POND(M)).EQ.0).AND.(H2ODEPTH(POND(M)).LT.0.01)) THEN
		GO TO 230
		END IF
	END IF
	
	IF (POND(M).GT.0) THEN
	IF (CALLBMP(M).EQ.1) THEN
	IF (SUB(POND(M)).EQ.0) THEN
		IF (RANE(M).NE.0) THEN
			BMPLOC=2
			CALL BMPS(BMPLOC,M,L,T,CU,CU1,CU2,DT,NEXP,FILTS,IDATE,
	1				SIMDUR,LDAY,KPR,NDT,J,Q(M),
     2				R(MOD(RANE(M),256),MOD(SUR(M),256)),IDUMMY,IDUMMY,
     3				RAITES)
	!		IF (ENDNO3SI.GT.0.) ANO3SI(NDT,1)=ENDNO3SI
			GO TO 170
		ELSE
			BMPLOC=2
			CALL BMPS(BMPLOC,M,L,T,CU,CU1,CU2,DT,NEXP,FILTS,IDATE,
	1				SIMDUR,LDAY,KPR,NDT,J,Q(M),		
     2				R(MOD(RANE(MYSHADOW(M)),256),
     3				MOD(SUR(MYSHADOW(M)),256)),IDUMMY,IDUMMY,
     4				RAITES)
			GO TO 170
		END IF
	ELSE 
	!RZ	The following section routes flow from non-collecting bmp cells
	!RZ	to the collecting bmp cells.  As one will recall from the user's
	!RZ	guide, a bmp that spans several cells is assigned one collecting
	!RZ	cell (which holds the pond characteristics) and the rest of the 
	!RZ	cells are just told to route flow to that collecting cell (as 
	!RZ done below).  As in the rest of the program, the flow going to the
	!RZ	receiving cell is calculated by adding the difference between the 
	!RZ	flow from last time and the flow from this time (this is necessary
	!RZ	because of multiple contributing cells, you can't just zero QI before
	!RZ	adding the new flow).
		D=QI(M)-Q(M)
		QI(NC(M))=D+QI(NC(M))
			!WB	inflow = inflow + depth increment
		SPI(NC(M))=SPI(NC(M))+SPI(M) 
			!WB	inflow of dissolved P = same + outflow
	    AINH4(NC(M))=AINH4(NC(M))+AINH4(M) 
			!WB	inflow of dissolved NH4 = same + outflow of dissolved NH4
		AINO3(NC(M))=AINO3(NC(M))+AINO3(M) 
			!WB	inflow of nitrate = same + outflow of NO3
		DO IC=1,NPART 
				!WB	do from counter IC=1 to # of particles
			PI(NC(M),IC)=PI(NC(M),IC)+PI(M,IC)
				!WB	inflow of sed. bound P = same + outflow
			PI(M,IC)=0.
			ANI(NC(M),IC)=ANI(NC(M),IC)+ANI(M,IC)
				!RZ	inflow of sediment bound ammonia
			ANI(M,IC)=0.
			ONI(NC(M),IC)=ONI(NC(M),IC)+ONI(M,IC)
				!RZ	inflow of sed. bound organic N
			ONI(M,IC)=0.
			SI(NC(M),IC)=SI(NC(M),IC)+SI(M,IC)
				!WB	rate of sed. inflow = inflow + outflow
			SI(M,IC)=0.
		END DO
		Q(M)=QI(M)
		AINO3(M)=0.
		AINH4(M)=0.
		SPI(M)=0.
		GO TO 170
	END IF
	END IF
	END IF
!RZ	flow will be routed differently if there is a bmp present; go to 
!RZ	the end of catchment check before exiting to end of loop; because
!RZ	rfl is zero for channel cells, no modifications to bmps subroutine
!RZ	need to be made to specially accomodate channel cells.

      IF (M.GT.N) GO TO 100 
!WB	if element counter greater than # of overland flow elements
C
C **** OVERLAND ELEMENT.
C
      I=MOD(RANE(M),256) 
!WB	 = # of rain gage applicable to i - INT(same/256) * 256
      K=MOD(SUR(M),256) 
!WB	 = surface type on element i - INT(same/256) * 256 = cover type
      KK=SOIL(M)/256 
!WB	soil type of i = soil type of i / 256
!RZ	all the above are divided by 256 because of the way the variable is
!RZ	set up.  See the rane(i)=,sur(i)=,soil(i)= calculations for detail

	SUPP=.5*SSTOR+QI(M)+R(I,K) 
!WB	avail. supply for infil = = 0.5*(end stor) + inflow + net rainfall
!RZ	sstor=2*(actual storage,S)/T (so must multiply by 0.5 to get s/t)

      FIL=FILTS(M) 
!WB	infil = infil cap
      IF (FIL.GT.SUPP) FIL=SUPP 
!WB	if infil > supply, then set them equal
      IF(FIL.LT.0) FIL=0.0 
!WB	if infil < 0, then set infil = 0
       if (dr(m).lt.0.) dr(m)=0. 
!WB	 if vert. drain<0, then set = 0
       CUMIN1(M)=CUMIN1(M)+(FIL/CU)*(DT/3600.) 
!WB	 cum infil = same + (infil/conv) * (time inc / 3600(sec / hr))
      CNO3(M)=CNO3(M)+(DR(M)/CU)*(DT/3600) 
!WB	accum perc during infil = same + (vert drain / conv) * 
!WB	 ( time inc / 3600)
      PIV(M)=PIV(M)+DR(M)-FIL 
!WB	vol airspace = same + vert drain - infil

	IF ((IRRCYCLE(K).EQ.1).AND.(FREQ(K).EQ.3).AND.(CROPNOIRR(K).EQ.0)) 
	1THEN
!RZ	if the crop is in its irrigation cycle and has frequency type 3 and
!RZ	is still irrigating today
		IF ((1.-PIV(M)*DT/TP1(KK)).LT.IRRTARGET(K)) THEN
!RZ	if the soil moisture (decimal percent) is less than the target value then
			DURATION(K)=1440.
			!set equal to the total number of minutes in a day; don't
			!want irrigation to last more than one day though.
		ELSE
			DURATION(K)=0.
			!set low enough that it will definitely be less than T(L) so 
			!irrigation will no longer be performed for this crop today
			CROPNOIRR(K)=1
			!crop no longer irrigates today
		END IF
	END IF

      SDR=SDR+DR(M) 
!WB	accum ground H2O storage = accum groun H2O storage + vert drain

	IF ((RAITES.NE.1).AND.(R(I,K).GT.0.)) THEN
		CONTINUE
	END IF

      FLIN=QI(M)+R(I,K)-FIL 
!WB	net rate of flow into an element less losses = inflow + net 
!WB	rainfall - infil
      GO TO 110
C
C **** CHANNEL ELEMENT.
C
  100 K=21  
!RZ	URBAN:::If it is an urban cell, then the FLIN will not include channel drainage
	IF (URB(M).EQ.1) THEN
	FLIN=QI(M)+DIN(M)
	GO TO 110
	END IF

      FLIN=QI(M)+CHDR+DIN(M) 
!WB	net rate of flow into an element less losses = inflow + ground 
!WB	water discharge + accum tile drainage rate

C
C **** COMBINE INITIAL INFLOW, OUTFLOW AND STORAGE WITH ACCUMULATED
C **** INFLOW.
C
  110 FHS=FLINS(M)+FLIN 
!WB	FHS = (storage, inflow + outflow) + net rate of flow into a 
!WB	channel element (less losses)

      IF (SSTOR.GT.DIR(K)) GO TO 130 
!WB	storage on element at end of time increment > ret. depth
C
C **** NO RUNOFF FROM ELEMENT.
C
  120 S(M)=FHS 
!WB	storage = combined water
      SS(M)=0. 
!WB	incremental increase in storage = 0 
      FLINS(M)=FLIN+FHS 
!WB	storage, inflow, and outflow = net inflow rate + total from above

!RZ	fill this back in if needed URBAN::: if the depth of water in the pond is greater than 0.01 for a 
!RZ	dry pond or infiltration trench (.gt. orbot for wet ponds), simulate
!RZ	water loss in the pond for today even if flow on element is .lt. 0.
!RZ	the wet pond stipulation was added because a wet pond should remain full
!RZ	between storms, so this way the water
!RZ	in the pond is not totally depleted between storms.

      IF (Q(M).EQ.0.) GO TO 170 
!WB	if outflow > 0
129      D=-Q(M) 
!WB	depth increment in seg. curve = - outflow
      Q(M)=0. 
!WB	outflow = 0
      GO TO 150
C
C **** DIRECT SOLUTION OF CONTINUITY EQUATION BY LINEARIZATION.
C
  130 Y=SC*(SSTOR-DIR(K)) 
!WB	seg. number on depth value = depth inc. on seg. 
!WB	curve*(storage at end of time increment - ret. depth)
      IY=Y+1. 
	!MYQ=Y+1.
!WB	seg # on discharge curve
      IF (IY.LT.300) GO TO 140 
!WB	this and next 2 lines are the formulation of an error (exceed array bounds)
      WRITE (2,330) M
	WRITE (2,*) 'FLOWDEPTH=', Y/SC
	IY=299
      STOP
  140	Y=IY-1 
!WB	Y = incremented IY -1 
!RZ	= truncated original Y (originally Y was real, this makes it an integer).

	IF (M.GT.N) THEN
	CHWID=CWID(M)+WIDINC(M)
!WB	THE CHANNEL WIDTH IS EQUAL TO ORIGINAL WIDTH + ANY WIDTH INCREASE THAT OCCURS 
!WB	DURING SIMULATION.  SEE SUBROUTINE SED FOR INFO ON THIS VARIABLE
!WB   THE CHWID VAR IS USED ONLY HERE AND THEREFORE ISN'T INCLUDED IN 
!WB	THE COMMON BLOCKS.
	B(M)=CONSTHLD(M)/MNCHNTOT(M)/XHOLD(M)*(DX/CHWID/XHOLD(M))
	1**0.6667*DSQRT(SL(M))

!WB	ADJUST CHANNEL CONVEYANCE TO ACCOMODATE CHANNEL WIDENING
	ENDIF


	MYQA=(SSTOR-DIR(K))**(5./3.)

!RZ	IF (QA(IY)>0) THEN
!RZ	WRITE (*,*) MYQA
!RZ	WRITE (*,*) MYQ,IY,QA(IY)
!RZ	END IF

	

      QL=B(M)*MYQA 
!WB	discharge at lower end of seg IY on discharge curve = 
!WB	conveyance in Manning's eqn * incr. depth power value
	QD=B(M)*(QA(IY+1)-QA(IY)) 

!RZ	QD=B(M)*(((SSTOR-DIR(K))+1./SC)**(5./3.)-MYQA) QA (IY) AND (IY+1) RESULT FILE
!WB	differential = conveyance (difference)
	SSTOR=(FHS-QL+QD*(Y+DIR(K)*SC))/(1.+QD*SC) 

!RZ	SSTOROLD=SSTOR
!RZ	SSTOR=(FHS-MYQA+B(M)*SSTOR)/(1+B(M))
!WB     storage = (combined water - curve lower discharge + 
!WB	discharge differential*(seg. # + ret. depth for crop practice i
!WB	 * depth incr) / (1+discharge differential*depth incr)
!RZ	SSTOR=FHS-QL
	  IF (SSTOR.LE.DIR(K)) GO TO 120 
!WB	  if storage at end of time increment < ret. depth
	Q2=QL+QD*((SSTOR-DIR(K))*SC-Y) 
!RZ	Q2=QL+B(M)*(SSTOR-SSTOROLD)
!WB	outflow at end of time increment = discharge at lower end + 
!WB	differential ((storage - ret) * depth incr. - seg. depth)
!RZ	Q2=QL
      D=Q2-Q(M) 
!WB	depth increment in seg. depth curve = outflow from at end of 
!WB	time increment - outflow in segment
!RZ	This is NOT the depth increment in seg. depth curve - just one of the 
!RZ	many instances in this program where one variable name is used to 
!RZ	represent completely different variables.  This appears to be
!RZ	the outflow from the element minus the inflow on the element, or
!RZ	perhaps the water on the element...something like that.
      Q(M)=Q2 
!WB	set em equal
      SS(M)=SSTOR-S(M) 
!WB	increase in storage = storage - storage at start
      S(M)=SSTOR 
!WB	reset storage at beginning equal to storage at end of increment
      FLINS(M)=FLIN+SSTOR-Q2 
!WB	storage, inflow + outflow = net inflow less losses + storage - 
!WB	outflow at end of time incre
!RZ THE FOLLOWING ARE STATEMENTS TO PRINT OUT EACH OF THE PERTINENT VARIABLES ABOVE,
!RZ IN AN ATTEMPT TO ISOLATE THE CAUSE OF AN ERROR WHEN QA IS DIRECTLY CALCULATED.
!RZ	WRITE (377,337) M,B(M),QA(IY),MYQA,SSTOR,Q2,Q(M),SS(M),S(M),
!RZ     & FLINS(M),QD
!RZ  337 FORMAT (1X,I5,F8.2,F8.3,F8.3,F8.2,F8.4,F8.4,F8.2,F8.2,F8.2,F8.2)

C
C.....SEDIMENT CALCULATION.....
C
  150 IF (M.LE.N) GO TO 156 
!WB	if element # less than # of overland flow elements, JUMP DOWN TO
!WB	DO O.F. CALCULATIONS
C
C......COMPUTE TRANSPORT/DEPOSITION FOR CHANNEL FLOW
C
	KK=SOIL(M)/256

	CALL SED(CWID(M),0.,DT,0.,M,N,KK,DX,N2)
!WB	calculate sediment movement in channel, JUMP DOWN TO THE NEXT
!WB	CALL SED STATMENT FOR DEFINITIONS OF WHAT'S BEING PASSED.
      CALL PBOUND(NPART,M)
!RZ	URBAN:::THE SOLUBLE NUTRIENTS SUBROUTINES CALCULATE PARTITIONING OF 
!RZ	NUTRIENTS FROM SEDIMENT, NOT REALLY APPLICABLE FOR IMPERVIOUS AREAS.
	IF(URB(M).EQ.1) THEN
		CALL AMMON(NPART,M)
		CALL ORGN(NPART,M)		
		URBAN=7
		IDUMMY=0
		DUMMY=0.
		CALL URBANIZED(URBAN,IDUMMY,IDUMMY,A1DUMMY,IDUMMY,IDUMMY,IDUMM
	1Y,IDUMMY,M,IDUMMY,CDUMMY,IDUMMY,CDUMMY,A3DUMMY,A5DUMMY,DUMMY,DUMMY
     2,DUMMY,DUMMY,DUMMY,IDUMMY,IDUMMY,A2DUMMY,A2DUMMY,CROP)
	ELSE 
      CALL SOLUBP(DX2,KK,M,I,K,DT,T12,L,T11,SSTOR,FIL,SE,N
     & ,CUMIN1,CU,NPART)
      CALL AMMON(NPART,M)
      CALL WATNH(SSTOR,FIL,M,DT,N,CUMIN1,CU,KK,NPART)
      CALL NO3Z(SSTOR,FIL,M,DT,N,CUMIN1,CU)
      CALL ORGN(NPART,M)
	END IF

      DO 151 IC=1,NPART 
!WB	do from this counter to the # of particles
      SI(M,IC)=0.0 
!WB	set sediment inflow back to 0
 151  CONTINUE

	IF (M.EQ.7822) THEN
		CONTINUE
	END IF
	
C
C......REMEMBER ALL CHANNEL FLOW MOVES WITH ITS "COLUMN" DESIGNATOR
C
      K=NC(M) 
!WB	set K = # of element receiving outflow from element i in a 
!WB	column direction

      QI(K)=QI(K)+D 
!WB	inflow = inflow + depth increment

      SPI(K)=SPI(K)+SP2(M) 
!WB	inflow of dissolved P = same + outflow	
 
      AINH4(K)=AINH4(K)+OUTNH4(M) 
!WB	inflow of dissolved NH4 = same + outflow of dissolved NH4
      AINO3(K)=AINO3(K)+OUTNO3(M) 
!WB	inflow of nitrate = same + outflow of NO3
*******************************do loop #1276***********************
	DO 152 IC=1,NPART 
!WB	do from counter IC=1 to # of particles
	PI(K,IC)=PI(K,IC)+PE(IC) 
!WB	inflow of sed. bound P = same + outflow
	ANI(K,IC)=ANI(K,IC)+ANE(IC) 
!WB	 ?
!RZ	inflow of sediment bound ammonia
	ONI(K,IC)=ONI(K,IC)+ONE(IC) 
!WB    ?
!RZ	inflow of sed. bound organic N

	SI(K,IC)=SI(K,IC)+SE(IC) 
!WB	rate of sed. inflow = inflow + outflow
      

  152 CONTINUE
  153	CONTINUE
*******************************end do loop #1276*******************
      IF(M.NE.N2) GO TO 170 
!WB	if element counter # does not equal total # of elements + channels
*******************************do loop #1293**************************
      DO 154 IC=1,NPART 
!WB	do from counter IC=1 to # of particles
	ER(IC)=ER(IC)+SE(IC)
!WB	amt of particle size i leaving watershed = same + movement from 
!WB	element
  154 CONTINUE
*******************************end do loop #1293**********************
      GO TO 170
C
C.....COMPUTE TRANSPORT/DEPOSITION FOR OVERLAND FLOW
C
  156 CONTINUE 


      CALL WETDEP(RATE(K),M,LDAY,MOD(SUR(M),256))
!RZ	call the wet deposition subroutine; determines the amount of wet deposition
!RZ	for this rainfall time increment

      CALL SED(DX,R(I,K),DT,DIR(K),M,N,KK,DX,N2) 
!WB		DX = cell width, R = net rainfall, DT=TIME INCREMENT,
!WB	    DIR= ret. depth, M = element counter, N = # of overland flow
!WB	    elements, KK = soil type for current element, DX = cell width
!WB		N2=# OF O.F. + CHANNEL CELLS
	CALL PBOUND(NPART,M)

!RZ	URBAN:::THE SOLUBLE NUTRIENTS SUBROUTINES CALCULATE PARTITIONING OF 
!RZ	NUTRIENTS FROM SEDIMENT, NOT REALLY APPLICABLE FOR IMPERVIOUS AREAS.
	IF(URB(M).EQ.1) THEN
		CALL AMMON(NPART,M)
		CALL ORGN(NPART,M)		
		URBAN=7
		DUMMY=0.
		IDUMMY=0
		CALL URBANIZED(URBAN,IDUMMY,IDUMMY,A1DUMMY,IDUMMY,IDUMMY,IDUMM
	1Y,IDUMMY,M,IDUMMY,CDUMMY,IDUMMY,CDUMMY,A3DUMMY,A5DUMMY,DUMMY,DUMMY
     2,DUMMY,DUMMY,DUMMY,IDUMMY,IDUMMY,A2DUMMY,A2DUMMY,CROP)
	ELSE 
      CALL SOLUBP(DX2,KK,M,I,K,DT,T12,L,T11,SSTOR,FIL,SE,N
     & ,CUMIN1,CU,NPART)
      CALL AMMON(NPART,M)
      CALL WATNH(SSTOR,FIL,M,DT,N,CUMIN1,CU,KK,NPART)
      CALL NO3Z(SSTOR,FIL,M,DT,N,CUMIN1,CU)
      CALL ORGN(NPART,M)
	END IF

*******************************do loop #1319**************************
      DO 157 IC=1,NPART 
!WB	do from counter IC = 1 to # of particles
      SI(M,IC)=0.
!WB	sediment inflow = 0
 157  CONTINUE
******************************* end do loop #1319*********************
C
C......PROPORTION OUTFLOW AND SEDIMENT TO DOWNSLOPE ADJACENT ROW
C............AND COLUMN ELEMENTS.....
C
      IF(M.LT.N2) GO TO 160 
!WB	if el # < # overland flow + channel elements
*******************************do loop #1332**************************
      DO 158 IC=1,NPART 
!WB	do from counter IC =1 to # of particles
	ER(IC)=ER(IC)+SE(IC) 
!WB	amt of part. type i leaving watershed = same + sed. exiting 
!WB	the element
  158 CONTINUE
****************************end do loop #1332*************************
  160 CONTINUE
!	URBAN:: FLOW IS ROUTED DIFFERENTLY FOR URBAN BMPS
!	IF (POND(M).GT.0) THEN
!	IF (CALLBMP(M).EQ.1) THEN
!	IF (SUB(POND(M)).EQ.0) THEN
!		BMPLOC=2
!		CONTINUE
!		CALL BMPS(BMPLOC,M,L,T,CU,CU1,CU2,DT,NEXP,FILTS,IDATE,SIMDUR
!	1			,LDAY,KPR,NDT,J,D)
!		GO TO 170
!	END IF
!	END IF
!	END IF



      DRA=D*RFL(M) 
!WB	incremental increase in outflow = depth increment * fraction 
!WB	of discharge in row dir
      I=NR(M) 
!WB	 # of element receiving outflow from element I in row dir.
      K=NC(M) 
!WB	 # of element receiving outflow from element I in col. dir.

      QI(I)=QI(I)+DRA 
!WB	inflow to row element i = same + incremental increase in outflow
 
      QI(K)=QI(K)+D-DRA 
!WB	inflow to column element i = same + depth increment - increase 
!WB	in outflow, row direction

      PSIRA=SP2(M)*RFL(M) 
!WB	 = outflow of dissol. P * fraction of discharge from element 
!WB	 flowing in row direction
      SPI(I)=SPI(I)+PSIRA 
!WB	 inflow of dissolved P from adjacent cells (row dir) = same +
!WB	 above
      SPI(K)=SPI(K)+SP2(M)-PSIRA 
!WB	 inflow of dissol P (column dir) = same + outflow dissolv P - 
!WB	 fraction in row dir
 
      AINH4(I)=AINH4(I)+OUTNH4(M)*RFL(M) 
!WB	inflow dissol NH4 (row dir) = same + outflow from M * fraction 
!WB	of discharge
      AINH4(K)=AINH4(K)+OUTNH4(M)-OUTNH4(M)*RFL(M) 
!WB	inflow diss NH4 (col dir) = same + outflow col dir - 
!WB	outflow col dir * fraction
	  
      AINO3(I)=AINO3(I)+OUTNO3(M)*RFL(M) 
!WB	inflow dissol NO3 (row dir) = same + outflow * rel fraction
      AINO3(K)=AINO3(K)+OUTNO3(M)-OUTNO3(M)*RFL(M) 
!WB	inflow dissol NO3 (col dir) = same + outflow - outflow * rel fract

*******************************do loop #1380**************************
      DO 162 IC=1,NPART 
!WB	do this loop from counter IC=1 to # of particle size classes
C *** NRZ
C *** CHANNEL CORRECTION
	PRA=PE(IC)*RFL(M) 
!WB	 = outflow of sed. bound P * fraction of discharge from el 
!WB	flowing in row dir
	ANRA=ANE(IC)*RFL(M) 
!WB	 = outflow of sed. bound NH4 for particle class i * fraction 
!WB	of discharge
	ONRA=ONE(IC)*RFL(M) 
!WB	 = outflow of sed. bound org. N * fractional flow discharge 
!WB	in row dir
 
	SRA=SE(IC)*RFL(M) 
!WB	 portion of sed. leaving and flowing in row dir = sed. exiting *
!WB	 fraction of flow in row dir
 
	PI(I,IC)=PI(I,IC)+PRA 
!WB	 = inflow of sed bound P (row, part. size class) + above
	PI(K,IC)=PI(K,IC)+PE(IC)-PRA 
!WB	 = inflow of sed bound P (col, part. size class) + above
	 
	ANI(I,IC)=ANI(I,IC)+ANRA 
!WB	see above
	ANI(K,IC)=ANI(K,IC)+ANE(IC)-ANRA 
!WB	see above
 
	ONI(I,IC)=ONI(I,IC)+ONRA 
!WB	see above
	ONI(K,IC)=ONI(K,IC)+ONE(IC)-ONRA 
!WB	see above
	SI(I,IC)=SI(I,IC)+SRA 
!WB	see above
	SI(K,IC)=SI(K,IC)+SE(IC)-SRA 
!WB	see above

  162 CONTINUE

***************************end do loop #1380**************************
C *** NRZ END
  170  CONTINUE
***************************end do loop 982***************************
***************************end do loop 1121**************************

	IF (CHN.LT.1..OR.SDR.EQ.0.) GO TO 180 
!WB	if # of channel seg's < 1 or accum groundH2O storage = 0
C
C **** CALCULATE TILE DRAINAGE AND GROUNDWATER CONTRIBUTION.
C
      XPR=KPR 
!WB	 = # of time increment routings b/t print lines
      CALL DRAIN (DR,DC,DIN,N,N1,N2,STD,TIAL,RFL,NR,NC)
!WB	DR = vert. drain loss, DC = tile drain. coeff, DIN = accum 
!WB	tile drain, N = # overland flow el's, N1 = N + 1, N2 = # overland
!WB	flow + # channel el's, STD = total inflow to tile lines, TIAL = 
!WB	flag, RFL = fraction of discharge in row dir, NR = # el receiving 
!WB	flow in row dir, NC = # el receiving flow in col dir

      SDR=SDR-STD*XPR 
!WB	groundwater storage = same - total inflow * # time increment 
!WB	routings
      CHDR=SDR*GRF/XPR/CHN 
!WB	groundH2O discharge into element = groundwater storage * 
!WB	fractional rate of baseflow release / XPR / # of channel segments
      SDR=SDR*(1.-GRF) 
!WB	groundwater storage = same * (1 - release fraction)
 
C
C **** OUTPUT PRINT SECTION.
C **** NRZ 9/14/94
C **** ADD EXTRA DIMENSION TO KEEP TRACK OF EACH CHANNEL OUTLET
C 180 Q1(L)=QI(NN)/CONV 
****************************do loop #1453**************************
  180 DO 219 NCH=1,NCHAN+1 
!WB	do from channel counter NCH = 1 to # of channels + 1
	Q1(L,NCH)=QI(CHOUT(NCH))/CONV 
!WB	discharge from catchment at ith hydrograph line = inflow 
!WB	to el i / catchment conversion
	SIG(NCH)=0. 
!WB	sum of sediment inflow values for all particle size clases

C *** NRZ
C *** CHANNEL ADDITION
C *** ACCUMULATE KG OF SEDIMENT FOR EACH PARTICLE CLASS
****************************do loop #1465**************************
	DO 185 IC=1,NPART 
!WB	do from counter IC=1 to # of particle size classes
          SEDG(NCH,IC)=0. 
!WB		sed of particle class i draining from a channel for a 
!WB		given print line
          SIG(NCH)=SIG(NCH)+SI(CHOUT(NCH),IC) 
!WB		sum of sediment for all particle size classes = same + 
!WB		sed inflow (channel outlet cell, particle size class)
          SEDG(NCH,IC)=SEDG(NCH,IC)+SI(CHOUT(NCH),IC) 
!WB		sed drainage = same + sed. inflow (channel outlet cell, 
!WB		part size class)
  185   CONTINUE
************************end do loop #1465**************************
****************************do loop #1479**************************
        DO 187 IC=1,NPART 
!WB	  do from counter IC=1 to # of particle size classes
          SEDH(NCH,L,IC)=SEDG(NCH,IC)*DT 
!WB		sed from catchment of particle class i at hydrograph line 
!WB		L = channel out * time increment
  187   CONTINUE 
************************end do loop #1479**************************
C *** NRZ END

	SSI(L,NCH)=SIG(NCH)*DT 
!WB	accum sed out of catchment for a given storm = sum of all sed 
!WB	size classes * time increment
	QHYP(L,NCH)=QI(CHOUT(NCH))*DT
!WB	FLOW RATE USED IN HYDROGRAPH PLOTTING OF NUTRIENT VARIABLES QI (M3/S) * DT (S)=M3
	IF (QI(CHOUT(NCH)).GT.0.) GO TO 190 
!WB	if discharge from catchment > 0 , then 
	SSCON(L,NCH)=0. 
!WB	sed conc at print line L of hydrograph for outlet i = 0
	GO TO 200
  190   SSCON(L,NCH)=(SIG(NCH)-SPT(NCH))/(SIG(NCH)-SPT(NCH)+
     &               QI(CHOUT(NCH))*CE6)*1000000.
!WB		sed. conc at print line L of hydrograph for outlet i = 
!WB		(sed accum - sed accum prev time step + Qinflow)*CE6)*1000000
  200   IF (Q1(L,NCH).GT.QMAX) QMAX=Q1(L,NCH) 
!WB	  if flow out of catchment > qmax, qmax = outflow
	IF (SSCON(L,NCH).GT.CMAX) CMAX=SSCON(L,NCH) 
!WB	if sed conc > ?max
	VOL(NCH)=VOL(NCH)+Q1(L,NCH) 
!WB	runoff depth for outlet i = same + flow out
	RW(L,NCH)=0. 
!WB	average rainfall intensity = 0
****************************do loop #1509**************************
	DO 210 I=1,NRG 
!WB	do from counter I = 1 to # of rain gages
	  J=JTR(I) 
!WB	  current rainfall intensity histogram period for rain gage
  210     RW(L,NCH)=RW(L,NCH)+RC(I,J)*FRA(I) 
!WB	    ave rainfall intensity = same + rainfall intensity for 
!WB		gage i * fraction of catchment covered by gage
************************end do loop #1509**************************
	IF (RW(L,NCH).GT.RMAX) RMAX=RW(L,NCH) 
!WB	if ave intensity > rmax, rmax = ave intensity
 
*
*DETERMINE PHOSPHORUS OUTPUT
*
 
      PSIG(NCH)=0. 
!WB	accum sed bound P loss for all particle size classes draining
!WB	to outlet i = 0

** NRZ (8/31/94)
** ACCUMULATE KG OF SEDIMENT BOUND P FOR EACH PARTICLE CLASS
****************************do loop #1531**************************
      DO 215 IC=1,NPART 
!WB	do from counter IC = 1 to # of particle size classes
         PSEDG(NCH,IC)=0. 
!WB	   sed bound P from channel = 0
         PSIG(NCH)=PSIG(NCH)+PI(CHOUT(NCH),IC) 
!WB	   sum of sed bound P to outlet = same + inflow of sed. bound 
!WB	   P from adj cells
         PSEDG(NCH,IC)=PSEDG(NCH,IC)+PI(CHOUT(NCH),IC) 
!WB	   sed bound P from channel = same + inflow from channel out
 215  CONTINUE
************************end do loop #1531**************************
****************************do loop #1543**************************
      DO 216 IC=1,NPART 
!WB	do from counter IC = 1 to # of particle size classes
        PSEDH(NCH,L,IC)=PSEDG(NCH,IC)*DT*1000. 
!WB	  sed bound P leaving catchment = sed bound P leaving channel * 
!WB	  time incr * 1000
 216  CONTINUE
************************end do loop #1543**************************
** NRZ (8/31/94)
 
      PSSI(L,NCH)=PSIG(NCH)*DT*1.E+3 
!WB	sum of sed. bound P loss from catchment = sum of sed bound P 
!WB	draining to outlet * time inc * 1000
      SPSSI(L,NCH)=SPI(CHOUT(NCH))*DT*1000. 
!WB	sum of dissol P loss from catchment to outlet i = inflow of 
!WB	dissol P * time inc * 1000
 
*
*DETERMINE NITROGEN OUTPUT
*
 
      ANSIG(NCH)=0. 
!WB	sum of sed bound NH4 loss to outlet i for all part size classes
      ONSIG(NCH)=0. 
!WB	sum of sed bound TKN loss to outlet i for all part size classes

** NRZ (8/31/94)
** ACCUMULATE KG OF SEDIMENT BOUND NH4 AND TKN FOR EACH PARTICLE 
** CLASS
****************************do loop #1572**************************
      DO 217 IC=1,NPART 
!WB	do from counter IC = 1 to # of particle size classes
         ANSEDG(NCH,IC)=0. 
!WB	   Sediment bound NH4 for particle class i draining from channel
!WB	   for a given hydrograph print line (kg/sec) = 0 
         ONSEDG(NCH,IC)=0. 
!WB	   Sediment bound TKN for particle class i draining from channel 
!WB	   for a given hydrograph print line (kg/sec) = 0
         ANSIG(NCH)=ANSIG(NCH)+ANI(CHOUT(NCH),IC)
!WB	   sum of sed bound NH4 loss to outlet i for all part size 
!WB		classes = same + ?
         ANSEDG(NCH,IC)=ANSEDG(NCH,IC)+ANI(CHOUT(NCH),IC)
!WB		Sediment bound NH4 for particle class i draining from channel
!WB		for a given hydrograph print line (kg/sec) = same + ?
		 ONSIG(NCH)=ONSIG(NCH)+ONI(CHOUT(NCH),IC)
!WB		sum of sed bound TKN loss to outlet i for all particle size 
!WB		classes = same + ?         
		 ONSEDG(NCH,IC)=ONSEDG(NCH,IC)+ONI(CHOUT(NCH),IC)
!WB		Sediment bound TKN for particle class i draining from channel 
!WB		for a given hydrograph print line (kg/sec) = same + ?

 217  CONTINUE
************************end do loop #1572**************************
****************************do loop #1596**************************
      DO 218 IC=1,NPART 
!WB	do from counter IC = 1 to # of particle size classes
         ANSEDH(NCH,L,IC)=ANSEDG(NCH,IC)*DT*1000. 
!WB	   Sediment bound NH4 for particle class i and hydrograph line L 
!WB		leaving catchment (kg) = Sediment bound NH4 for particle 
!WB		class i draining from channel for a given hydrograph print 
!WB		line (kg/sec) * time increment * 1000
		 ONSEDH(NCH,L,IC)=ONSEDG(NCH,IC)*DT*1000. 
!WB		 Sediment bound TKN for particle class i and hydrograph line L 
!WB		leaving catchment (kg) = Sediment bound NH4 for particle class
!WB		i draining from channel for a given hydrograph print line 
!WB		(kg/sec) * time incr * 1000
 218  CONTINUE
************************end do loop #1596**************************
** NRZ (8/31/94)

      ANSSI(L,NCH)=ANSIG(NCH)*DT*1.E+3 
!WB	Accumulated sediment-bound ammonium loss from catchment draining 
!WB	to outlet i at hydrograph line L for a given storm(g) = 
!WB	Accumulated sediment-bound ammonium loss for all particle size 
!WB	classes draining to outlet i for a given hydrograph print 
!WB	line (kg/sec) * time increment * 1000
      ONSSI(L,NCH)=ONSIG(NCH)*DT*1.E+3 
!WB	Accumulated sediment-bound TKN loss from catchment draining to 
!WB	outlet i at hydrograph line L for a given storm (g) =
!WB	Accumulated sediment-bound TKN loss for all particle size classes 
!WB	draining to outlet i for a given hydrograph print line (kg/sec) * 
!WB	time incr * 1000 

C     CONVERTING NITROGEN OUTPUT FROM KG TO G
 
      ANH4SI(L,NCH)=AINH4(CHOUT(NCH))*1000.*DT 
!WB	Accumulated dissolved ammonium loss from catchment draining to 
!WB	outlet i at hydrograph line L for a given storm (g) = 
!WB	Inflow of dissolved ammonium from adjacent cells (kg/s) * 1000 * 
!WB	time increment
      ANO3SI(L,NCH)=AINO3(CHOUT(NCH))*1000.*DT 
!WB	Accumulated dissolved nitrate loss from catchment draining to 
!WB	outlet i at hydrograph line L for a given storm (g) =
!WB	Inflow of dissolved NO3 from adjacent cells (kg/s) * 1000 * time 
!WB	increment
  219 CONTINUE
************************end do loop #1453**************************
C **** NRZ 9/14/94

C
C **** PRINT ONE HYDROGRAPH LINE.....
C
  220 CONTINUE
*******************************end do loop #972********************
  222   FORMAT(1X,F7.1,5(1X,F12.4))
!WB this is used nowhere.  try to find 222
C
C **** END OF HYDROGRAPH.  PRINT TOTAL RUNOFF AND RAINFALL.
C
      L=NDT+1 
!WB	Number of last element in row and a counter = Number of lines of
!WB	hydrograph print + 1

	TOTANO3SI=0.
	DO NCH=1,NDT
	TOTANO3SI=TOTANO3SI+ANO3SI(NCH,1)
	END DO

!WB*************************do loop # 1684********************
  230 DO 228 NCH=1,NCHAN+1 
!WB     do from channel counter = 1 to # of channels + 1

C **** NRZ 9/10/94
C **** ACCUMULATE RAINFALL AMOUNT

      IF (NCH.EQ.1) TPREC=TPREC+PREC 
!WB	if channel counter = 1, then Accumulated rainfall for 
!WB	simulation (mm) = same + Accumulated depth of precipitation (mm)

C **** NRZ END
 
      VOL(NCH)=(VOL(NCH)-.5*Q1(L-1,NCH))*DT*DBLE(KPR)/3600. 
!WB	Runoff depth for outlet i for a given storm (mm) = same - 0.5 * 
!WB	Flow out of catchment draining to outlet i at hydrograph line 
!WB	L (mm/h) * time increment * Number of time increment routings 
!WB	between print lines / 3600
C *** THE NUMBER OF CELLS DRAINING INTO EACH CHANNEL NETWORK IS COMPUTED FROM
C *** ARC-INFO, AND THIS IS CONVERTED TO AREA BY MULTIPLYING THE NUMBER OF 
C *** CELLS BY THE AREA OF EACH CELL IN HA.  IF THIS IS THE SEDIMENT COMING
C *** FROM THE "LEAKY CELLS", THE AREA IS COMPUTED BY MULTIPLYING THE
C *** PERCENTAGE OF CELL AREA LEAKING BY THE AREA OF EACH CELL. 
C     X=SSI(L-1)/AREA
      IF (NCH.LE.NCHAN) THEN 
!WB	if channel counter is less than number of channels
        XS(NCH)=SSI(L-1,NCH)/(DBLE(NCELLS(NCH))*AREA2)
!WB		Accumulated sediment loss out of catchment for outlet i for 
!WB		a given storm (kg/ha) = Accumulated sediment loss out of
!WB		catchment at print line L of hydrograph for outlet i for a 
!WB		given storm (kg) / (Number of cells in channel network i 
!WB		(entered in input file) * Element or channel area (m2))
      ELSE
C *** NRZ 7/29/95
C *** ADDED "IF OUTSID.GT.0" IN ORDER TO ELIMINATE 0/0 WHEN NO CELLS LEAK
        IF (OUTSID.GT.0) XS(NCH)=SSI(L-1,NCH)/(OUTSID*AREA2)
!WB	IF Area of watershed border elements which drain outside of 
!WB	watershed > 0, then Accumulated sediment loss out of catchment 
!WB	for outlet i for a given storm (kg/ha) = Accumulated sediment loss 
!WB	out of catchment at print line L of hydrograph for outlet i for a 
!WB	given storm (kg) / (Area of watershed border elements which drain 
!WB	outside of watershed * Element or channel area (m2))
	  ENDIF
      
      CONFAC=AREA*10000. 
!WB	 = Catchment area as sum of element areas, ha * 10000
      CONFA1=CONFAC/1000. 
!WB	 = Catchment area as sum of element areas, ha * 10000 / 1000
      VOL1F(NCH)=VOL1F(NCH)+VOL(NCH) 
!WB	Accumulated runoff depth for outlet i for the simulation (mm) = 
!WB	same + Runoff depth for outlet i for a given storm (mm)
      VOL1X(NCH)=VOL1X(NCH)+XS(NCH)
!WB	Accumulated sediment loss out of catchment for outlet i for 
!WB	the simulation (kg/ha) = same + XS (NCH) from above

      NUNIT=NCH+10 
!WB	 = channel counter + 10
	IF(YEAR0.NE.YERBEG) THEN 
!WB	if year0? does not equal the beginning year of the simulation
!RZ	if previous year is not current year (i.e., you just changed
!RZ	years in the simulation and you need to write an output file)
        DO 9902 NZ=0,NCHAN 
!WB	  do from counter NZ = 0 to # of channels
 9902     WRITE(NUNIT+NZ,*) YERBEG 
!WB		write to the channel file #(nunit+nz) the beg. year of sim
!RZ		YERBEG is actually the current year.  This increments the
!RZ		year in the channel output file so you can see what's going on.
        YEAR0=YERBEG 
!WB	  reset the year0 var to the beginning year of the simulation
!RZ	  reset the year0 var to the current year
      ENDIF 
!WB	put your finger on the side of your head and scratch, scratch
!WB	and say "hmmmmmmm".  I have no idea what the previous lines
!WB	are used for  10/15/98  
      RNO3(NCH)=RNO3(NCH)+ANO3SI(L-1,NCH) 
!WB	Accumulated dissolved nitrate loss from catchment draining to 
!WB	outlet i for the simulation (g) = same + Accumulated dissolved 
!WB	nitrate loss from catchment draining to outlet i at hydrograph 
!WB	line L for a given storm (g)
      RNH4S(NCH)=RNH4S(NCH)+ANH4SI(L-1,NCH) 
!WB	Accumulated dissolved NH4 loss from catchment draining to outlet 
!WB	i for the simulation (g)= same + Accumulated dissolved ammonium 
!WB	loss from catchment draining to outlet i at hydrograph line L 
!WB	for a given storm (g)
      RNH4SE(NCH)=RNH4SE(NCH)+ANSSI(L-1,NCH) 
!WB	Accumulated sediment-bound ammonium loss from catchment draining 
!WB	to outlet i for the simulation (g) = same + Accumulated 
!WB	sediment-bound ammonium loss from catchment draining to outlet i 
!WB	at hydrograph line L for a given storm(g)
      RPHOS(NCH)=RPHOS(NCH)+SPSSI(L-1,NCH) 
!WB	Accumulated dissolved P loss from catchment draining to outlet i 
!WB	for the simulation (g) = same + Accumulated dissolved P loss from 
!WB	catchment draining to outlet i at hydrograph print line L for a 
!WB	given storm (g)
      RORGN(NCH)=RORGN(NCH)+ONSSI(L-1,NCH) 
!WB	Accumulated sediment-bound TKN loss from catchment draining to 
!WB	outlet i for the simulation (g) = same + Accumulated sediment-bound 
!WB	TKN loss from catchment draining to outlet i at hydrograph line L 
!WB	for a given storm (g)
      RSEDP(NCH)=RSEDP(NCH)+PSSI(L-1,NCH) 
!WB	Accumulated sediment-bound P loss from catchment draining to outlet
!WB	i for the simulation (g) = same + Accumulated sediment-bound P loss
!WB	from catchment draining to outlet i at hydrograph line L for a given
!WB	storm (g)

	IF (NCH.LT.NCHAN+1) THEN
	IF (NSBS.EQ.1)THEN
	DO JKK=1,20
	CNT2=0
	do CNT=1,NN-1
	JK=MOD(SUR(CNT),256)
	KKX=(SOIL(CNT)/256)
	if (jk.eq.jkk) then 
	IF (CNT2.EQ.1) GOTO 3451
	CNT2=1
	WRITE (101,3450) LDAY,XS(NCH),JK,DAYDIFF(CNT),
	1KRBASE(CNT),TAUCB(CNT),TAURR(CNT),TAUCHLD(CNT),KRCONS(CNT),
     2KRSC(CNT),KRBR(CNT),KRADJ(CNT),TAUCONS(CNT),TAUSC(CNT),
     3TAUCADJ(CNT),KKX,KDROOTR(CNT),KLROOTR(CNT),CNT
      WRITE (102,3452) LDAY,XS(NCH),JK,DAYDIFF(CNT),KIBASE(CNT),
	1HEIGHT(JK),CANOPY(JK),KICAN(CNT),INRCOV(JK),KIGRCOV(CNT),
     2KICONS(CNT),KISC(CNT),LROOT(JK),DROOT(JK),KLROOTI(CNT),
     3KDROOTI(CNT),KIADJ(CNT),KKX,CNT
	endif
 3451	end do	
	END DO
	ENDIF

 3450 FORMAT (1X,I3,1X,F8.2,3X,I2,1X,F6.0,2X,F5.3,3X,F4.2,4X,F4.2,2X,
	1F4.2,/,
     27X,F6.4,1X,F4.2,1X,F4.2,4X,F6.4,2X,F4.2,4X,F4.2,2X,F4.2,2X,I3,/,
     37X,F6.4,1X,F6.4,' CELL: ',I4)
 3452 FORMAT (1X,I3,1X,F9.2,1X,I2,1X,F6.0,F10.0,1X,F4.2,5X,F5.3,
	12X,F4.2,/,
     113X,F4.2,2X,F4.2,2X,F9.0,1X,F4.2,5X,F4.2,3X,F4.2,/
     2,13X,F4.2,2X,F4.2,3X,F8.0,2X,I3,' CELL: ',I4)
	END IF

C **** THE FOLLOWING PRODUCES DAILY OUTPUT
      IF (NSBS.EQ.1) THEN
!WB	if NSBS? (I believe this reads the flag for storm by 
!WB	storm output) equals 1
!      WRITE(NUNIT,229) LDAY,PREC,VOL(NCH),XS(NCH),TOTANO3SI/1000.,
      WRITE(NUNIT,229) LDAY,PREC,VOL(NCH),XS(NCH),ANO3SI(L-1,NCH)/1000.,
     &ANH4SI(L-1,NCH)/1000.,ANSSI(L-1,NCH)/1000.,SPSSI(L-1,NCH)/1000.,
     &PSSI(L-1,NCH)/1000.,ONSSI(L-1,NCH)/1000.
!WB	write to channel out file: LDAY = day of sim?, PREC = accumulated
!WB	depth of precipitation (mm), VOL(NCH) = Runoff depth for outlet i 
!WB	for a given storm (mm), XS (NCH) = Accumulated sediment loss out 
!WB	of catchment for outlet i for a given storm (kg/ha), ANO3SI = 
!WB	accumulated dissolved nitrate loss from catchment draining to 
!WB	outlet i at hydrograph line L for a given storm (g) / 1000,
!WB	and same for dissolve NH4, sed bound NH4 loss, dissolved P loss, 
!WB	sed bound P loss, sed bound TKN loss
      IF (NCH.EQ.1) THEN
	WRITE(8898,231) LDAY,PREC,ANO3SI(L-1,NCH)/1000.,
     &ANH4SI(L-1,NCH)/1000.,ANSSI(L-1,NCH)/1000.,SPSSI(L-1,NCH)/1000.,
     &PSSI(L-1,NCH)/1000.,ONSSI(L-1,NCH)/1000.
	END IF
	END IF

231	FORMAT (1X, I3, F6.2, 1X, 5(F8.4,1X), F11.5)

!TMN    ANNUAL PRECIPITATION ADDED TO ANNUAL OUTPUT
	IF (NCH.EQ.1) THEN
        PCPANNUAL=PCPANNUAL+PREC
!TMN    ANNUAL RUNOFF ADDED TO THE ANNUAL OUTPUT
        RUNANNUAL=RUNANNUAL+VOL(NCH)
!TMN    SEDANNUAL ADDED TO USE FOR ANNUAL OUTPUT
	  SEDANNUAL=SEDANNUAL+ XS(NCH)
!TMN    NO3ANNUAL (DISSOLVED NITRATE) ADDED TO USE FOR ANNUAL OUTPUT
	  NO3ANNUAL=NO3ANNUAL+(ANO3SI(L-1,NCH)/1000.)
!TMN    NHWANNUAL (DISSOLOVED NH4) ADDED TO USE FOR ANNUAL OUTPUT
	  NHWANNUAL=NHWANNUAL+(ANH4SI(L-1,NCH)/1000.)
!TMN    NHSANNUAL (SEDIMENT BOUND NH4) ADDED TO USE FOR ANNUAL OUTPUT
	  NHSANNUAL=NHSANNUAL+(ANSSI(L-1,NCH)/1000.)
!TMN    PO4WANNUAL (DISSOLVED PO4) ADDED TO USE FOR ANNUAL OUTPUT
	  PO4WANNUAL=PO4WANNUAL+(SPSSI(L-1,NCH)/1000.)
!TMN    PO4SANNUAL (SEDIMENT BOUND PO4) ADDED TO USE FOR ANNUAL OUTPUT
	  PO4SANNUAL=PO4SANNUAL+(PSSI(L-1,NCH)/1000.)
!TMN    TKNANNUAL (SEDIMENT BOUND TKN) ADDED TO USE FOR ANNUAL OUTPUT
	  TKNANNUAL=TKNANNUAL+(ONSSI(L-1,NCH)/1000.)
	END IF


C ****THE FOLLOWING PRODUCES CUMULATIVE OUTPUT ON A SPECIFIED DAY
	DO 9903 NZ=1,10
 9903 IF (LDYEAR.EQ.NPDAY(NZ))
     &WRITE (NUNIT,229) LDAY,PREC,VOL(NCH),XS(NCH),ANO3SI(L-1,NCH)/1000
	1,ANH4SI(L-1,NCH)/1000,ANSSI(L-1,NCH)/1000,SPSSI(L-1,NCH)/1000,
	2ONSSI(L-1,NCH),PSSI(L-1,NCH)
!WB	THIS PRINT LINE ADDED 1/15/99 TO PRODUCE STORM OUTPUT ALONG 
!WB	WITH CUMULATIVE OUTPUT
	DO 9901 NZ=1,10
 9901 IF (LDYEAR.EQ.NPDAY(NZ))
!WB	if yerbeg+1000 equals an input print option
     &WRITE(NUNIT,229) LDAY,TPREC,VOL1F(NCH),VOL1X(NCH),RNO3(NCH)/1000.,
     & RNH4S(NCH)/1000.,RNH4SE(NCH)/1000.,RPHOS(NCH)/1000.,
     & RSEDP(NCH)/1000.,RORGN(NCH)/1000.
	
!WB	write LDAY = day of sim, TPREC = accum rainfall for sim., see 
!WB	above for remaining printout stuff
	

C *** CONTINUE LOOP FOR EACH CHANNEL OUTLET
  228 CONTINUE
!WB*************************end do loop # 1684**************

!TMN  CHANGED FORMATTING OF THE DAILY PRECIPITATION AND RUNOFF TO HAVE
!TMN  TWO DECIMAL PLACES.
  229 FORMAT(1X,I3,1X,F6.2,1X,F7.2,1X,F9.1,5(1X,F7.1),F10.3)


C *** NRZ END
C
C **** INDIVIDUAL ELEMENT SEDIMENT LOSS (-) OR GAIN (+).
C
	  X=10000./DX/DX 
!WB	  overland flow width across overland flow element
	  IF (IT.EQ.0) X=X*4.356 
!WB	  if IT flag = 0, then multiply flow width * 4.356

C
C **** OUTPUT INDIVIDUAL ELEMENT NET SEDIMENTATION AMOUNTS AND GROSS
C **** STATISTICAL VALUES.
C
      SPAERO=0. 
!WB	min. elemental aggradation value (kg/ha)
      SPADEP=0. 
!WB	max. elemental aggrad. value (kg/ha)
      SPASUM=0. 
!WB	sum of sel values used to calculate SPASD
      SPASS=0. 
!WB	variable used in determining SPASD
C
C **** COMPUTE STATISTICS ON OVERLAND FLOW ELEMENTAL SEDIMENT YIELDS.
C
	  DO 250 I=1,N 
	  SEL(I)=SEL(I)*DT*X 
!WB	  accum sed aggrad. in element i for a given storm (kg/s)
!WB	  where dt is the time increment and x is the area of a cell in 1/ha

	  NO3SEL(I)=NO3SEL(I)*X*DT  
!WB	  accum NO3 loss in ele i for a given storm (kg/s)
	  NHWSEL(I)=NHWSEL(I)*X*DT 
!WB	  accum dissol NH4 loss in el i for a given storm (kg/s)
	  NHSSEL(I)=NHSSEL(I)*X*DT 
!WB	  accum sed.-bound NH4 loss in el i for a given storm (kg/s)
	  TKNSEL(I)=TKNSEL(I)*X*DT 
!WB	  accum sed.bound TKN loss in el i for a given storm (kg/s)
	  PO4SEL(I)=PO4SEL(I)*X*DT 
!WB	  accum dissol P loss in el i for a given storm (kg/s)
	  SUMSED(I)=SUMSED(I)+SEL(I) 
!WB	  accum sed. loss for cell i for the entire length of the sim (kg)
	  SUMNO3(I)=SUMNO3(I)+NO3SEL(I)
!WB	  accum dissol. NO3 loss for cell i for the entire length of sim (kg)
	  SUMNHW(I)=SUMNHW(I)+NHWSEL(I) 
!WB	  accum dissol. NH4 loss for cell i for the entire length of sim (kg)
	  SUMNHS(I)=SUMNHS(I)+NHSSEL(I)
!WB	  accum sed. bound NH4 loss for cell i for the entire length 
!WB		of sim (kg) 
	  SUMTKN(I)=SUMTKN(I)+TKNSEL(I) 
!WB	  accum sed. bound TKN loss for cell I for the entire length 
!WB		of sim (kg)
	  SUMPO4(I)=SUMPO4(I)+PO4SEL(I) 
!WB	  accum dissol P loss for cell i for entire length of the sim. (kg)

 
  250    CONTINUE

	!RZ ADDED FOR CHECKING
!	sel(6651)=sel(6651)*dt*x
!	sumsed(6651)=sumsed(6651)+sel(6651)
!	sel(6650)=sel(6650)*dt*x
!	sumsed(6650)=sumsed(6650)+sel(6650)

C
C **** NOW, OUTPUT NET DEPOSITION FOR CHANNEL AREAS.
C

      J=N+1 
!WB	J = # overland flow cells + 1
      DO 260 I=J,N2 
!WB	do from #overland flow cells + 1 to # overland flow cells + 
!WB	 # channel flow cells
      SEL(I)=SEL(I)*DT 
260	SUMSED(I)=SUMSED(I)+SEL(I)
!WB	accum sed aggradation in element i for a given storm (kg/s) * 
!WB	time increment

C
C **** PLOTTING SECTION.  THIS SECTION OF CODE WILL CREATE THE INPUT
C **** FILE FOR SUBROUTINE HYPLT ON DEVICE 8.  SOME OF THE COMMANDS
C **** ARE MACHINE DEPENDENT AND ALL ARE PRESENTLY DISABLED.  TO USE,
C **** SIMPLY REMOVE THE C IN COLUMN 1, ADD SUBROUTINE HYPLT TO THE
C **** PROGRAM, AND APPEND THE CALCOMP LIBRARY TO THE INPUT FILE.
C **** THERE ARE TWO FORMAT STATEMENTS (380 AND 390) THAT MUST ALSO
C **** HAVE THE COMMENT DESIGNATION REMOVED!
C
C     L=L-1
C     REWIND 8
C     WRITE (8,380) L1,RMAX,QMAX,CMAX,IT,PP
C
C **** COPY HYDROGRAPH TO STORAGE TAPE.
C
C     DO 270 I=1,L
C 270 WRITE (8,390) T(I),RW(I),Q1(I),SSCON(I)
C     CALL HYPLT (L1,T,RW,Q1,SSCON,RMAX,QMAX,CMAX,IT,PP)

	IF (PRINHYD.EQ.1) THEN
	DO NCH=1,NCHAN
	WRITE (HYPNAM(NCH),3070) 'HYPLOT',NCH,'.OUT'
 3070 FORMAT (A6,I1,A4)
	OPEN (UNIT=NCH+20,FILE=HYPNAM(NCH))
	PRINHYD=2
	ENDDO
	ENDIF
	
	DO NCH=1,NCHAN
	DO I=2,L-1
!WB	DO FROM: 2 B/C BELOW SETS 1 = 0, AND TO: L-1 B/C L=NDT+1
!RZ	I think this is in error - L=ndt, not ndt+1, from my testing...
	
	IF (PSSI(I,NCH).EQ.PSSI(I-1,NCH)) THEN
!	IF ((PSSI(I,NCH).EQ.0).AND.(PSSI(I-1,NCH).EQ.0)) THEN
	PHYP(I,NCH)=0
	ELSE
	PHYP(I,NCH)=
     2((PSSI(I,NCH)-PSSI(I-1,NCH))/(PSSI(I,NCH)-PSSI(I-1,NCH)
     3+QHYP(I,NCH)*1000000.))*1000000.
!WB	PSSI=SED BOUND P (G - G)/(G-G+M3*(E6G/M3)) * 1000000 = PPM
!WB	THESE VALUES WILL NEVER BE LT 0 B/C THEY ARE CUMULATIVE VALUES
!WB	AT WORST, THE DIFFERENCE WILL BE 0.
	ENDIF

	IF (SPSSI(I,NCH).EQ.SPSSI(I-1,NCH)) THEN
!	IF ((SPSSI(I,NCH).EQ.0).AND.(SPSSI(I-1,NCH).EQ.0)) THEN
	DPHYP(I,NCH)=0
	ELSE
      DPHYP(I,NCH)=((SPSSI(I,NCH)-SPSSI(I-1,NCH))/
     5(SPSSI(I,NCH)-SPSSI(I-1,NCH)
     6+QHYP(I,NCH)*1000000.))*1000000.
!WB	SPSSI=DISSOL P
	ENDIF

	IF (ANSSI(I,NCH).EQ.ANSSI(I-1,NCH)) THEN
!	IF ((ANSSI(I,NCH).EQ.0).AND.(ANSSI(I-1,NCH).EQ.0)) THEN
	A4SHYP(I,NCH)=0
      ELSE
	A4SHYP(I,NCH)=((ANSSI(I,NCH)-ANSSI(I-1,NCH))/
     7(ANSSI(I,NCH)-ANSSI(I-1,NCH)
     8+QHYP(I,NCH)*1000000.))*1000000.
	ENDIF
!WB	ANSSI=SED BOUND NH4
	
	IF (ANH4SI(I,NCH).EQ.ANH4SI(I-1,NCH)) THEN
!	IF ((ANH4SI(I,NCH).EQ.0).AND.(ANH4SI(I-1,NCH).EQ.0)) THEN
	A4DHYP(I,NCH)=0
	ELSE
      A4DHYP(I,NCH)=((ANH4SI(I,NCH)-ANH4SI(I-1,NCH))/
     9(ANH4SI(I,NCH)-ANH4SI(I-1,NCH)
     1+QHYP(I,NCH)*1000000.))*1000000.
!WB	ANH4SI=DISSOL NH4
	ENDIF
	
	IF (ONSSI(I,NCH).EQ.ONSSI(I-1,NCH)) THEN
!	IF ((ONSSI(I,NCH).EQ.0).AND.(ONSSI(I-1,NCH).EQ.0)) THEN	
	ONHYP(I,NCH)=0
	ELSE
      ONHYP(I,NCH)=((ONSSI(I,NCH)-ONSSI(I-1,NCH))/
	2(ONSSI(I,NCH)-ONSSI(I-1,NCH)
     3+QHYP(I,NCH)*1000000.))*1000000.
!WB	ONSSI=SED BOUND TKN
	ENDIF

	IF (ANO3SI(I,NCH).EQ.ANO3SI(I-1,NCH)) THEN
!	IF ((ANO3SI(I,NCH).EQ.0).AND.(ANO3SI(I-1,NCH).EQ.0)) THEN
	A3HYP(I,NCH)=0
	ELSE
	A3HYP(I,NCH)=((ANO3SI(I,NCH)-ANO3SI(I-1,NCH))/
	3(ANO3SI(I,NCH)-ANO3SI(I-1,NCH)
     4+QHYP(I,NCH)*1000000.))*1000000.
!WB	ANO3SI=DISSOL NO3
	ENDIF

	ENDDO
	ENDDO

	IF (PRINHYD.NE.0) THEN
	IF (NIMP.GT.0) THEN 
	IF (IMPFLAG.EQ.1) THEN
	WRITE (2,*) 'INPUT INDICATES IMPOUNDMENTS, HYDROGRAPH(S) WILL NOT
	1 PRINT FOR THIS SIMULATION'
	IMPFLAG=1
	ENDIF
	ELSE
	DO NCH=1,NCHAN
	WRITE (NCH+20,3080) 'STORM DATE = ',LDYEAR
	WRITE (NCH+20,3090) 
	DO I=1,L-1

	IF (RAITES.NE.1) THEN
	IF (I.EQ.1) WRITE (NCH+20,*)
	ELSE
	IF (I.EQ.1) WRITE (NCH+20,3100) T(I),RW(I,NCH),Q1(I,NCH)
	1,Q1(I,NCH)*CONV,SSCON(I,NCH),0,0,0,0,0,0
      END IF		
	IF (I.GT.1) WRITE (NCH+20,3100) T(I),RW(I,NCH),Q1(I,NCH)
	1,Q1(I,NCH)*CONV
!WB	T(I)=TIME (MIN), RW=RAINFALL INTENS,MM/HR,Q1=FLOW MM/HR
!WB	Q1*CONV = FLOW M3/S (CHECK THE CONVERSION TO Q1)
	1,SSCON(I,NCH),PHYP(I,NCH),DPHYP(I,NCH),A4SHYP(I,NCH)
	2,A4DHYP(I,NCH),ONHYP(I,NCH),A3HYP(I,NCH)
!WB	SSCON IS SED CONC IN PPM (THE KG/S UNITS CANCEL), SEE ABOVE
!WB	PHYP = PSSI = SED BOUND P
!WB	DPHYP = SPSSI=DISSOL P
!WB	A4SHYP = ANSSI=SED BOUND NH4
!WB	A4DHYP = ANH4SI=DISSOL NH4
!WB	ONHYP = ONSSI=SED BOUND TKN
!WB	A3HYP = ANO3SI=DISSOL NO3
	END DO
	DO MN=1,N2
	IF (POND(MN).GT.0) THEN
		IF (SUB(POND(MN)).EQ.0.) THEN
			WRITE(NCH+20,*) 'CELL',MN,'PONDDEPTH=',H2ODEPTH(POND(MN))
		END IF
	END IF
	END DO
!RZ	above do and if-then isolates the ponds in the watershed and prints out
!RZ	the current pond depth at the end of the day to the HYPLOT file
	WRITE (NCH+20,*) 
	WRITE (NCH+20,*)
	END DO
	ENDIF
	ENDIF

		 
*COMPUTE NEW SOIL MOISTURE AFTER EVERY RAINFALL EVENT
*
	DO 6003 J=1,N 
!WB	resets J and goes back to counting for every cell
 	K=SOIL(J)/256 
!WB    	# of values in rainfall hyetograph and surface type of 
!WB	current element = soil type for element i / 256
!RZ	BELOW: IF THE CELL IS URBAN, SKIP CALCULATIONS OF ASMVOL AND ASMPER
	IF (URB(J).EQ.1) GOTO 6003
	M=MOD(SUR(J),256)
	ASMVOL(J)=(1.-PIV(J)*DT/TP1(K))*TP1(K)/CU1-RESWAT(K) 
!WB	 = (1-vol of air filled pore space in upper soil layer in el
!WB	 i * time increment / porosity for soil type i ?) * porosity for 
!WB	soil type i / (convert mm to m3) - residual water as a fraction 
!WB	of soil porosity
	ASMPER(J)=ASMVOL(J)*CU1/TP1(K)
!WB	 = above * (convert mm to m3) / porosity for soil type i ? 

 6003   CONTINUE

** NRZ 8/24/94
** CONVERSIONS FOR IMPOUNDMENT MODEL
** SUM SEDIMENT BOUND NUTRIENTS FOR EACH PARTICLE SIZE CLASS
 
      DO 2610 NCH=1,NCHAN
      DO 261 IC=1,NPART
        SEDWT(NCH,IC)=SEDH(NCH,L-1,IC) 
!WB	  sed of part class i leaving catchment and entering impoundment 
!WB		for a single rainfall event (kg) = sed of part class i and 
!WB		hydr line L leaving catchment (kg)
        TSEDI(NCH,IC)=TSEDI(NCH,IC)+SEDWT(NCH,IC) 
!WB	  accum sed of part class i leaving catchment and entering 
!WB		impoundment for sim (kg) = same + above
        PSEDI(NCH,IC)=PSEDI(NCH,IC)+PSEDH(NCH,L-1,IC) 
!WB	  accum sed bound P for part class i leaving catchment & 
!WB		entering impoundment for the sim (kg) = same + sed bound P 
!WB		for part class i and hydr line L leaving catchment (kg)
        ANSEDI(NCH,IC)=ANSEDI(NCH,IC)+ANSEDH(NCH,L-1,IC) 
!WB	  accum total sed. bound NH4 for part class i leaving catchment
!WB		& entering impoundment for the sim (kg) = same + sed bound 
!WB		NH4 for part class i and hydr line L leaving catchment 
        ONSEDI(NCH,IC)=ONSEDI(NCH,IC)+ONSEDH(NCH,L-1,IC) 
!WB	  accum sed. bound TKN for part class i leaving catchment and 
!WB		entering impond. for the sim (kg) = same + sed. bound TKN 
!WB		for part class i and hydr line L leaving catchment (kg)
 261  CONTINUE 
 2610 RUNVOL(NCH)=VOL(NCH)/1000.*(AREA2*DBLE(NCELLS(NCH)))*10000. 
!WB	runoff leaving catchment and entering impoundment for a single 
!WB	rainfall event (m^3) (calc from depth of runoff * area drained 
!WB	by network)
      DFWEV=0.0 
!WB	daily free water evap for impoundment (m)
 
!RZ	URBAN:::LASTIRR will track the last rainfall day for future reference
!RZ	for type 2 irrigation; also reset the irrflag to zero in preparation
!RZ	for the next day's calculations.
	
	IF (RAITES.EQ.1) THEN
	DO I=1,ICR
		LASTIRR(I)=LDAY
	END DO
	END IF
	IRRFLAG=0



** NRZ 8/24/94

 
*THE FOLLOWING ENDIF INDICATES THE END OF THE IF RAITES=1
 2611 ENDIF
*******************end if then loop #699************************
** NRZ 8/29/94
** CALL FREE WATER EVAPORATION SUBROUTINE IF IMPOUNDMENT IS PRESENT

      IF (RAITES.EQ.0. .AND. NIMP.GE.1) CALL EVAPFW(LDAY) 
!WB	if raintest flag equals 0 and # of impoundments greater 
!WB	than or equal to 1

** CALL IMPOUNDMENT MODEL FOR A CHANNEL IF STRUCTURE IS PRESENT AT 
** THE END OF THAT CHANNEL

      IF (NIMP.GE.1) THEN

C *** CONVERT PARTICLE DIAMETER FROM MM TO M

      DO 262 ID=1,NPART
        DIAM(ID)=DIAMM(ID)*0.001 
!WB	  diameter of sed. part. size i (m) = part dia (mm) * 0.001
 262  CONTINUE  
      
      DO 10000 NCH=1,NCHAN
        IF (BASE(NCH).NE.0.) THEN 
!WB	  BASE(NCH)? DOES NOT EQUAL 0
!RZ		I think this basically is checking to see if the channel
!RZ		has an impoundment - if so, BASE will be the base length
!RZ		if not, there will be no value for BASE (i.e., it will be zero)
        NUNIT=10+NCH 
!WB	  reset the nunit variable to equal 10 + nch counter
 
** SET DAILY SEDIMENT AND NUTRIENT ACCUMULATORS TO ZERO
        RUNO(NCH)=0.0 
!WB	  daily runoff leaving impoundment (m^3) = 0
        DTSEDO(NCH)=0.0 
!WB	  daily total of sediment leaving impoundment = 0
        DPSED(NCH)=0.0 
!WB	  daily total of sed. bound P leaving impound = 0
        DANSED(NCH)=0.0 
!WB	  daily totalof sed bound NH4 leavin impound = 0
        DONSED(NCH)=0.0 
!WB	  daily total of sed bound TKN leaving impound = 0
        DNO3O(NCH)=0.0 
!WB	  daily total of dissol. NO3 leaving impound = 0
        DNH4O(NCH)=0.0 
!WB	  daily total of dissolv NH4 leaving impound = 0
        DPHOSO(NCH)=0.0 
!WB	  daily total of soluble P leaving impound = 0

        CALL IMPOND(IDATE,RAITES,NPART,DIAM,SG,RUNVOL,SEDWT,DFWEV,
     &              SEDOT,SEDOR,RUNO,NCH)
!WB	IDATE = date of sim, RAITES = raintest flag (1 = rain), 
!WB	NPART = # of particle size classes, DIAM = diam of sediment 
!WB	particle size i (m), SG = spec. gravity of particle type i,
!WB	RUNVOL = runoff leaving catchment & entering impoundment, 
!WB	SEDWT = sed of part class i leaving catchment and !WB	entering
!WB	impoundment for a singl rainfall event (kg), DFWEV = daily 
!WB	free water evap for impound (m), SEDOT = sed for part class 
!WB	i overtopping impound !WB	for a single rainfal event, 
!WB	SEDOR = sed of particle class i passing through impound 
!WB	orifice for a single rainfall event (kg), RUNO = daily runoff 
!WB	leaving impoundment (m^3), NCH = counter for # of channel 
!WB	networks, or denotes which channel network
** ACCUMULATE RUNOFF FROM IMPOUNDMENT OVER SIMULATION
        TRUNO(NCH)=TRUNO(NCH)+RUNO(NCH) 
!WB	  cum. runoff leaving impound (m^3) = same + daily runoff 
!WB		leaving impundment (m^3)
	
** CALCULATE THE TOTAL SEDIMENT DISTRIBUTION LEAVING THE IMPOUNDMENT
        DO 263 ID=1,NPART
          TSEDO(NCH,ID) = TSEDO(NCH,ID) + SEDOT(NCH,ID) + SEDOR(NCH,ID)
!WB	sed of part class i leaving catchment & entering impond = 
!WB	same + sed for part class i overtopping impound + sed of 
!WB	particle class i passing through impound orifice for a single 
!WB	rainfall event (kg)
          SEDZO(NCH,ID) = SEDZO(NCH,ID) + SEDOR(NCH,ID)
!WB	accum sed of particle class i passing through impond for sim = 
!WB	same + sed of particle class i passing through impound orifice 
!WB	for a single rainfall event (kg)
          SEDZOT(NCH,ID) = SEDZOT(NCH,ID) + SEDOT(NCH,ID)
!WB	total sed for part class i overtopping impound? = same + 
!WB	sed for part class i overtopping impound

** CALCULATE THE TOTAL MASS OF SEDIMENT LEAVING THE IMPOUNDMENT
** DAILY AND OVER THE ENTIRE SIMULATION
          DTSEDO(NCH) = DTSEDO(NCH) + SEDOT(NCH,ID) + SEDOR(NCH,ID)          
!WB	daily total of sed leaving impound = same + above + above
		  TTSEDO(NCH) = TTSEDO(NCH) + SEDOT(NCH,ID) + SEDOR(NCH,ID)
!WB	accum sed leaving impound = same + above + above

** CALCULATE NUTRIENT REDUCTION DUE TO SETTLING OF SEDIMENT BOUND
** SPECIES (BASED ON A RATIO OF SEDIMENT SETTLED/TOTAL SEDIMENT)
** COMPUTE DAILY AND CUMULATIVE TOTALS
** NOTE: IF SEDIMENT LEAVES THE IMPOUNDMENT ON A DAY WITH NO RAINFALL,
** SEDWT,PSEDI,ANSEDI, AND ONSEDI ARE EQUAL TO THE VALUES COMPUTED FOR
** THE LAST RAINFALL EVENT

        IF (SEDWT(NCH,ID).GT.0.) THEN
!WB	SEDWT = sed of part class i leaving catchment and entering 
!WB	impoundment for a single rainfall event (kg)
          PSEDO(NCH,ID)=(SEDOT(NCH,ID)+SEDOR(NCH,ID))/SEDWT(NCH,ID)*
     &               PSEDH(NCH,L-1,ID)/1000.
!WB	accum sed bound P for part class i leaving impoundment for 
!WB	sim (kg) = above
          DPSED(NCH)=DPSED(NCH)+PSEDO(NCH,ID)
!WB	daily total of sed bound P leaving impound (kg) = same + 
!WB	accum sed bound P for part class i leaving impond for sim (kg)
          PSEDT(NCH)=PSEDT(NCH)+PSEDO(NCH,ID)
!WB	accum sed bound P for all classes ? = same + accum sed bound 
!WB	P for particle class i leaving impond for sim (kg)
          ANSEDO(NCH,ID)=(SEDOT(NCH,ID)+SEDOR(NCH,ID))/SEDWT(NCH,ID)*
     &                ANSEDH(NCH,L-1,ID)/1000.
!WB	accum sed bound NH4 leaving impond on part size i for sim (kg) 
          DANSED(NCH)=DANSED(NCH)+ANSEDO(NCH,ID)
!WB	daily total of sed bound NH4 leaving impound (kg) = 
          ANSEDT(NCH)=ANSEDT(NCH)+ANSEDO(NCH,ID)
!WB	sim total sed bound NH4 leaving impond = 
          ONSEDO(NCH,ID)=(SEDOT(NCH,ID)+SEDOR(NCH,ID))/SEDWT(NCH,ID)*
     &                ONSEDH(NCH,L-1,ID)/1000.
!WB	accum sed bound TKN for part class i           
		  DONSED(NCH)=DONSED(NCH)+ONSEDO(NCH,ID)
!WB	daily total of sed bound TKN leaving impound
          ONSEDT(NCH)=ONSEDT(NCH)+ONSEDO(NCH,ID)
!WB	sim total sed bound TKN for part class i ?
        ENDIF
  263  CONTINUE
       IF (RUNVOL(NCH).GT.0.) THEN 
!WB	 runoff entering impoundment (depth * area)
         DNO3O(NCH)=RUNO(NCH)/RUNVOL(NCH)*ANO3SI(L-1,NCH) 
!WB	daily total of dissolved NO3 leaving impound = daily runoff
!WB	leaving impound / runoff entering * accum dissol NO3 loss at 
!WB	outlet i
         TNO3O(NCH)=TNO3O(NCH)+DNO3O(NCH)
!WB	accum dissol NO3 leaving impond for si = same + daily 
!WB	dissolved NO3
         DNH4O(NCH)=RUNO(NCH)/RUNVOL(NCH)*ANH4SI(L-1,NCH)
!WB	daily NH4 leaving impound = daily runoff leaving impound / 
!WB	runoff entering impound * accum dissol NH4 at outlet i 
         TNH4O(NCH)=TNH4O(NCH)+DNH4O(NCH)
!WB	accum dissol NH4 leaving impound for sim = same + daily 
!WB	dissolved NH4
         DPHOSO(NCH)=RUNO(NCH)/RUNVOL(NCH)*SPSSI(L-1,NCH)
!WB	daily total soluble P = volume exiting impound / volume 
!WB	entering impound * accum dissolved P loss from catchment 
!WB	draining to outlet i for a given storm         
		 TPHOSO(NCH)=TPHOSO(NCH)+DPHOSO(NCH)
!WB	accum soluble P leaving impound for sim = same + daily 
!WB	soluble P leaving impound
       ENDIF 
      
** PRINT DAILY OUTPUT FOR IMPOUNDMENT
        
      IF ((RAITES.EQ.1).OR.(DTSEDO(NCH).GT.0.)) THEN
!WB	if raintest = 1 (rain) or daily total of sed leaving impound > 0

** THE FOLLOWING PRODUCES CUMULATIVE OUTPUT
        TRUNOM(NCH)=TRUNO(NCH)/(10000.*(AREA2*DBLE(NCELLS(NCH))))*1000.
!WB	total runoff leaving impoundment = cum runoff leaving impound / 
!WB	 (10000 * (area of element*# cells in the channel))*1000 

** THE FOLLOWING PRODUCES DAILY OUTPUT
        RUNOM(NCH)=RUNO(NCH)/(10000.*(AREA2*DBLE(NCELLS(NCH))))*1000.
!WB	total daily runoff leaving impound = daily runoff leaving 
!WB	impound / (10000 ( area of cell * (# of cells))*1000

      ENDIF

 2290 FORMAT(1X,6F9.1)
 6012 FORMAT(1X,10X,F6.1,2X,F7.1,5(1X,F7.3),F10.3,/)

  265   IF (IDATE.EQ.SIMDUR) THEN
!WB	If date of sim equals the duration of the simulation

         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'THE FINAL SEDIMENT DISTRIBUTION ENTERING THE',
     &   ' IMPOUNDMENT FOLLOWS:'
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'CLASS    DIAM(MM)   SEDIMENT(KG/HA)'
         DO 267 NSD=1,NPART
  267      WRITE(NUNIT,6014) NSD,DIAMM(NSD),TSEDI(NCH,NSD)/
     &                                      (AREA2*DBLE(NCELLS(NCH)))
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'THE FINAL SEDIMENT DISTRIBUTION LEAVING THE',
     &   ' OUTLET OF THE IMPOUNDMENT FOLLOWS:'
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'CLASS    DIAM(MM)   SEDIMENT(KG/HA)'
         DO 268 NSD=1,NPART
           WRITE(NUNIT,6014) NSD,DIAMM(NSD),TSEDO(NCH,NSD)/
     &                                      (AREA2*DBLE(NCELLS(NCH)))
  268    CONTINUE
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'THE FINAL SEDIMENT DISTRIBUTION LEAVING THE',
     &   ' ORIFICE:'
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'CLASS    DIAM(MM)   SEDIMENT(KG/HA)'
         DO 269 NSD=1,NPART
           WRITE(NUNIT,6014) NSD,DIAMM(NSD),SEDZO(NCH,NSD)/
     &                                      (AREA2*DBLE(NCELLS(NCH)))
  269    CONTINUE
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'THE FINAL SEDIMENT DISTRIBUTION',
     &   ' OVERTOPPING:'
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'CLASS    DIAM(MM)   SEDIMENT(KG/HA)'
         DO 271 NSD=1,NPART
           WRITE(NUNIT,6014) NSD,DIAMM(NSD),SEDZOT(NCH,NSD)/
     &                                      (AREA2*DBLE(NCELLS(NCH)))
  271    CONTINUE
 6014      FORMAT(3X,I1,6X,F5.3,6X,F7.1)
         WRITE(NUNIT,*)
         WRITE(NUNIT,*) 'THE TOTAL OUTPUTS FROM THE IMPOUNDMENT ARE ',
     &              'AS FOLLOWS:'
         WRITE(NUNIT,*)
        WRITE(NUNIT,*) 'DAY  RAIN  RUNOFF SEDIMENT   NO3   DIS-NH4'
     &            ,' SED-NH4 DIS-PO4 SED-PO4 SED-TKN'
        WRITE(NUNIT,*) '      MM     MM     KG/HA     KG      KG'
     &            ,'      KG      KG      KG       KG'
        WRITE(NUNIT,229) LDAY,TPREC,TRUNOM(NCH),TTSEDO(NCH)/
     &  (AREA2*DBLE(NCELLS(NCH))),TNO3O(NCH)/1000.,
     &  TNH4O(NCH)/1000.,ANSEDT(NCH),TPHOSO(NCH)/1000.,
     &  PSEDT(NCH),ONSEDT(NCH)
          
** THE FOLLOWING ENDIF INDICATES THE END OF THE IF (IDATE.EQ.SIMDUR) 
 
      ENDIF         

** THE FOLLOWING ENDIF INDICATES THE END OF THE IF (BASE(NCH).NE.0)
      ENDIF
10000 CONTINUE

** THE FOLLOWING ENDIF INDICATES THE END OF THE IF (NIMP.GE.1)
      ENDIF         

** NRZ 9/10/94
** PRINT FINAL OUTPUTS FROM THE CATCHMENT

      DO 11000 NCH=1,NCHAN+1
        NUNIT=10+NCH
      IF (IDATE.EQ.SIMDUR) THEN
        WRITE(NUNIT,*)
        WRITE(NUNIT,*) 'THE TOTAL OUTPUTS FROM THIS AREA ARE ',
     &             'AS FOLLOWS:'
        WRITE(NUNIT,*)
        WRITE(NUNIT,*) 'DAY  RAIN  RUNOFF SEDIMENT   NO3   DIS-NH4'
     &            ,' SED-NH4 DIS-PO4 SED-PO4 SED-TKN'
        WRITE(NUNIT,*) '      MM     MM     KG/HA     KG      KG'
     &            ,'      KG      KG      KG       KG'
        WRITE(NUNIT,229) LDAY,TPREC,VOL1F(NCH),VOL1X(NCH),
     &  RNO3(NCH)/1000.,RNH4S(NCH)/1000.,RNH4SE(NCH)/1000.,
     &  RPHOS(NCH)/1000.,RSEDP(NCH)/1000.,RORGN(NCH)/1000.

!WB	PRINT NEW CHANNEL WIDTHS CALCULATED BY NEW SED ROUTINE      
	IF (NCH.LT.NCHAN+1) THEN
	WRITE (NUNIT,*)
	WRITE (NUNIT,*) 'THE FINAL WIDTHS FOR THIS CHANNEL ARE:'
	DO JKL=N+1,N2
	KKJ=SOIL(JKL)/256
		IF (CHNUMBER(JKL-N).EQ.NCH) THEN
		IF (CWID(JKL).GT.0) THEN
		WRITE (NUNIT,*)
		WRITE (NUNIT,3046) JKL,KKJ,CWID(JKL)+WIDINC(JKL)
		IF (DEPTHINC(JKL).GE.0) THEN
		WRITE (NUNIT,3047) DEPTHINC(JKL)
!WB	IF THE DEPTHINC IS GREATER THAN 0, IT INDICATES BOTTOM EROSION
!WB	AS THIS IS TRACKED AS A POSITIVE NUMBER.
		ELSE
		WRITE (NUNIT,3048) -1*DEPTHINC(JKL)
!WB	IF THE DEPTHINC IS NEGATIVE, IT INDICATES DEPOSITION, SO PRINT
!WB	NET DEPOSITION MASS
		ENDIF
		ELSE
		WRITE (NUNIT,*)
		WRITE (NUNIT,*) 'CHANNEL WIDTH = 0.'
	ENDIF
	ENDIF
      ENDDO
	ENDIF
	ENDIF          
!WB	END OF PRINT NEW CHANNEL WIDTHS CALCULATED BY NEW SED ROUTINE	
	
11000 CONTINUE
** NRZ 9/10/94

 
      CALL ETP11(TEMPC,RADI,ETPMM)
	TETPPR=0.
!WB	TETPPR = unknown
!RZ	TOTAL TETP (POTENTIAL EVAPOTRANSPIRATION)
	TOTPER=0.
!WB	TOTPER = unknown
!RZ	TOTAL PERCOLATION
*       TOTES=0.
*       TOTEP=0.
	TOTXMO=0.
!WB	TOTXMO = unknown
!RZ	TOTAL SOIL MOISTURE (XMOI)


	DO 5590 J11=1,N
!RZ	URBAN:::if the cell is an urban cell, it has no evapotranspiration (because evapotranspiration
!RZ	only depletes soil water, not surface water; free water evaporation actually depletes 
!RZ	surface water).  So skip this loop for urban cells
	IF (URB(J11).EQ.1) GO TO 5590

	K=MOD(SUR(J11),256)
!WB	K = # of values in rainfall hyetograph and surface type 
!WB	of current element
!RZ	???? K=cover type for current element!
!WB	  = surface type - INT (same / 256) * 256
	KK=SOIL(J11)/256
!WB	KK = soil type for current element

	CALL EVAPO(LAI1(K),S1EP(J11),ESU(KK),TTIME(J11),S2EP(J11)
     & ,ETPMM,TETP,PEP(J11),ES(J11),CUMIN1(J11))
!WB	LAI1 =  LAI + 1?, S1EP = accum stage 1 soil evap (mm), 
!WB	ESU = Upper limit of stage 1 of soil evap (mm day-0.5),
!WB	TTIME = time since stage 2 evap started (days), S2EP = 
!WB	accum stage 2 soil evap (mm), ETPMM = Pot ET (mm),
!WB	TETP = Sum of ES and PEP (mm), PEP = plant transpiration (mm), 
!WB	ES = soil evap (mm), CUMIN1 = cum infil (mm)
!RZ	Following: if the cell is urban, there is no soil moisture or root growth
!RZ	effects or percolation, therefore go to end of loop

*INITIALIZING THE INITIAL CUMULATIVE INFILTRATION TO ZERO
	CUMIN1(J11)=0.
!WB	cum infil = 0 
	IF (XMOI(J11).LT.WP(KK)) XMOI(J11)=WP(KK)
!WB	THIS LINE ADDED 2/9/99 TO DETERMINE IF SOIL MOISTURE WAS 
!WB	INADVERTENTLY CAUSING NEGATIVE STORAGE IN SOLUBP	
	XMOI(J11)=ASMVOL(J11)+RESWAT(KK)*TP1(KK)/CU1
!WB	soil moisture = ASMVOL? + residual water as a fraction of 
!WB	soil porosity * porosity / (conv mm to m3)
*EDX REPRESENTS THE MAXIMUM EVAPORATIVE DEPTH
	RRATIO=(EDX(KK)/DF1(KK))*(XMOI(J11)-WP(KK))
!WB	RRATIO? = (max soil evap depth / depth of soil horizon)*
!WB	 (soil moisture - WP?)
	IF(ES(J11).GT.RRATIO) ES(J11)=RRATIO
!WB	If soil evaporation greater than RRATIO?, set em equal
*REDUCE THE PLANT EVAPORATION ACCORDING TO THE ROOT DEPTH
	IF(ROTDAY(K).GT.DF1(KK)) THEN
!WB	if root depth at a specific day is greater than depth of 
!WB	soil horizon 
	  ROTRAT=DEXP(-3.065*DF1(KK)/ROTDAY(K))
!WB	ROTRAT? = E^(-3.065 * depth of soil horizon) / root depth 
!WB	at a specific day
	  ROTR(J11)=(1.-ROTRAT)/(1.-EXP(-3.065))
!WB	Ratio that reduces evap according to root depth = 
!WB	 (1-root ratio?) / (1-exp(-3.065)
	  PEP(J11)=PEP(J11)*ROTR(J11)
!WB	plant transpiration = same * root depth ratio
	ELSE
	  ROTR(J11)=1.
!WB	reset root ratio equal to 1
	ENDIF
 
	CNH4(J11)=0.
!WB	fraction of water leaching = 0
*SOIL MOISTURE LIMITING
	IF(XMOI(J11).LT.WP(KK)) xmoi(j11)=wp(kk)
!WB	if soil moisture is less than wilting point?	
	IF(XMOI(J11).LT.ASMLIM(KK)) THEN
!WB	if soil moisture is less ASMLIM?
	 PEP(J11)=PEP(J11)*XMOI(J11)/ASMLIM(KK)
!WB	plant transpiration = same * soil moisture / ASMLIM ? 
	 TETP=PEP(J11)+ES(J11)
!WB	TETP = plant transpiration + soil evaporation
	  IF((XMOI(J11)-WP(KK)).GT.TETP) THEN
!WB	if soil moisture - wilting point? is greater than plant 
!WB	trans + soil evap
	    ASMVOL(J11)=ASMVOL(J11)-TETP
!WB	ASMVOL = same - (plant trans + soil evap)
	    TETPPR=TETPPR+TETP
!WB	TETPPR ? = same + (plant trans + soil evap)
	  ELSEIF (XMOI(J11).EQ.WP(KK)) THEN
!WB	elseif soil moisture equal to wilting point (we set 
!WB	it equal earlier if it's less than)
	    ES(J11)=0.
!WB	soil evapo = 0
	    PEP(J11)=0
!WB	plant trans = 0
	  ELSE
	    TETP=XMOI(J11)-WP(KK)
!WB	 (plant trans + soil evap) = soil moisture - wilting point?
!WB	 (wilt point*porosity / conversion)
	    PEP(J11)=PEP(J11)*TETP/(PEP(J11)+ES(J11))
!WB	plant trans = same * (soil moisture - wilt point) / (plant 
!WB	trans + soil evap)
	    ES(J11)=ES(J11)*TETP/(PEP(J11)+ES(J11))
!WB	soil evap = same*(soil moisture - wilt point) / (plant 
!WB	trans + soil evap)
	    ASMVOL(J11)=ASMVOL(J11)-TETP
!WB	ASMVOL ? = same - (soil moisture - wilting point)
	    TETPPR=TETPPR+TETP
!WB	TETPPR ? = same + (soil moisture - wilting point)
	  ENDIF

	TOTES=TOTES+ES(J11)
!WB	TOTES? = same + soil evap
!RZ	TOTES=total Evaporation from Soil
	TOTEP=TOTEP+PEP(J11)
!WB	TOTEP? = same + plant trans
!RZ	TOTEP=total Evaporation from Plants
	GOTO 5590
	ENDIF
 
 
*SOIL MOISTURE NOT LIMITING
	IF (XMOI(J11).GT.FCVOL(KK)) THEN
!WB	if soil moisture greater than field capacity
	  XMOI2=XMOI(J11)*CU1/TP1(KK)
!WB	soil moisture var #2 = soil moisture * (conv mm to m3) / porosity?
	  PERCOL=0.
!WB	percolation amount (mm) = 0
	
	IF(XMOI(J11).LT.WP(KK)) xmoi(j11)=wp(kk)
!WB	if soil moisture is less than wilting point?	
!WB	THIS LINE ADDED TO ALL CALL STATEMENTS DUE TO FLOAT OVERFLOWS AND
!WB	DOMAIN ERRORS ASSOCIATED WITH XMOI DROPPING BELOW WP 1/19/99	
	  CALL PERCO(KS(KK),FCVOL(KK),CU,PERCOL,FCAP1(KK)
     &    ,XMOI2,TMAX,RAITES,A(KK),J11)
!WB	XMOI = soil moisture, KS = sat hyd conductivity (mm/hr), 
!WB	FCVOL = field cap, PERCOL = percolation amount, FCAP1 = 
!WB	field cap ?, XMOI2 = soil moisture,	converted and divided 
!WB	by porosity, TMAX = max time on hyetograph, RAITES=
!WB	raintest flag, A = ratio of KS of top layer to KS for 
!WB	underlying layer
	ASMVOL(J11) = ASMVOL(J11)-TETP-PERCOL
!WB	ASMVOL? = same - (soil moisture - wilting point) - percolation 
!WB	amount
	XMOI(J11)=ASMVOL(J11)+RESWAT(KK)*TP1(KK)/CU1
!WB	soil moisture = ASMVOL? + residual water as a fraction of 
!WB	soil porosity * porosity / (conv mm to m3)

*CNH4 REPRESENTS THE LEACHING FRACTION OF NITROGEN
	CNH4(J11)=(PERCOL+CNO3(J11))/(XMOI(J11)+TETP+PERCOL+CNO3(J11))
!WB	leaching frac of N = (perc amt + accum perc during infil 
!WB	 (mm)) / (soil moisture + (soil moisture - wilting point) + 
!WB	perc amt + accum perc during infil)
	CNO3(J11)=0.
!WB	reset accum perc =0
	TETPPR=TETPPR+TETP
!WB	TETPPR? = same + (soil moisture - wilting point)
	TOTPER=TOTPER+PERCOL
!WB	total percolation? = same + perc amount
	TOTES=TOTES+ES(J11)
!WB	total soil evap? = same + soil evap
	TOTEP=TOTEP+PEP(J11)
!WB	total plant evap? = same + plant evap
	PERCOL=0.
!WB	set perc amount = 0	
	GOTO 5590
	ENDIF
 
	  IF((XMOI(J11)-WP(KK)).GT.TETP) THEN
!WB	soil moisture - wilt point greater than (soil moisture - wilt point)
!WB	this may be using a different def of TETP, as it is redefined above
	    ASMVOL(J11)=ASMVOL(J11)-TETP
	    TETPPR=TETPPR+TETP
	  ELSEIF (XMOI(J11).EQ.WP(KK)) THEN
	    ES(J11)=0.
	    PEP(J11)=0
	  ELSE
	    TETP=XMOI(J11)-WP(KK)
	    PEP(J11)=PEP(J11)*TETP/(PEP(J11)+ES(J11))
	    ES(J11)=ES(J11)*TETP/(PEP(J11)+ES(J11))
	    ASMVOL(J11)=ASMVOL(J11)-TETP
	    TETPPR=TETPPR+TETP
	  ENDIF
	  TOTES=TOTES+ES(J11)
	  TOTEP=TOTEP+PEP(J11)
	  TOTXMO=TOTXMO+XMOI(J11)

 5590   CONTINUE
 
 5591   FORMAT(1X,5(F10.5,1X))

	CALL NITRAN(ES,FCVOL,SOIVOL,PEP,WP,N,TEMPC,ICR,
     &              RATEMX,CU1,SOITEM,RNUTNI,RNUTAM,RNUTP,DF1,TP1)
 
      IF(IDATE.EQ.SIMDUR) THEN
       XCOR=365./SIMDUR
 
	 WRITE(2,301)
	 WRITE(2,302)
	 WRITE(2,303)
 301  FORMAT(///,1X,75('*'))
!TMN  CHANGED THE HEADING FROM READING "ANNUAL OUTPUT" TO READ
!TMN  "AVERAGE ANNUAL OUPUT" SINCE IT IS AN AVERAGE
 302  FORMAT(///,27X,32H**** AVERAGE ANNUAL OUTPUT  ****)
 303  FORMAT(30X,25H**** ON A CELL BASIS ****,///)
 
	 WRITE(2,309)
	 WRITE(2,308)
 
	DO 5554 I=1,N2
	 WRITE (2,360) I,SUMSED(I)*XCOR,SUMNO3(I)*XCOR,SUMNHW(I)*XCOR,
     &  SUMNHS(I)*XCOR,SUMTKN(I)*XCOR,SUMPO4(I)*XCOR,CLENO3(I)*XCOR
 
 5554 CONTINUE
!	WRITE(2,360) 6650,SUMSED(6650)*XCOR
!	WRITE(2,360) 6651,SUMSED(6651)*XCOR

C***  WDB 5/23/94
C***  Added by Bill Batchelor to send annual output to new file
	 DO 9876 I=1,N
	 WRITE (5,360) I,SUMSED(I)*XCOR,SUMNO3(I)*XCOR,SUMNHW(I)*XCOR,
     &  SUMNHS(I)*XCOR,SUMTKN(I)*XCOR,SUMPO4(I)*XCOR,CLENO3(I)*XCOR
 9876 CONTINUE

	WRITE(1793,*)
	DO I=1,35000
		IF (POND(I).GT.0) THEN

		WRITE(1793,*) I,POND(I),NR(I),NC(I)

		IF (TIPE(POND(I)).EQ.3) THEN

		WRITE(1793,*)
		WRITE(1793,*) 'Infiltration Trench'
		WRITE(1793,382) TOTALIN(2),TOTALLOST(2),TOTALWLOST(2),
	1	TOTALINF(2),TOTALEVAP(2),H2ODEPTH(2)

		ELSEIF (SUB(POND(I)).EQ.0) THEN

		WRITE(1793,*)

		WRITE(1793,382) TOTALIN(POND(I)),TOTALLOST(POND(I)),
	1	TOTALWLOST(POND(I)),TOTALINF(POND(I)),TOTALEVAP(POND(I)),
     2	H2ODEPTH(POND(I))

		WRITE(1793,*) TOTALIN(POND(I)),TOTALLOST(POND(I)),
	1	TOTALWLOST(POND(I)),TOTALINF(POND(I)),TOTALEVAP(POND(I)),
     2	H2ODEPTH(POND(I))

		WRITE(1793,*) 
		WRITE(1793,383) TOTALSED(POND(I)),TOTALPHOS(POND(I)),
	1	TOTALANIT(POND(I)),TOTALONIT(POND(I))

		WRITE(1793,*) 
		WRITE(1793,385) TOTALDEPSED(POND(I)),TOTALDEPPHOS(POND(I)),
	1	TOTALDEPANI(POND(I)),TOTALDEPONI(POND(I))

		WRITE(1793,*)
		WRITE(1793,384) TOTALOUTSED(POND(I)),TOTALOUTPHOS(POND(I)),
	1	TOTALOUTANI(POND(I)),TOTALOUTONI(POND(I))

		WRITE(1793,*)
		WRITE(1793,386) TOTALSOLP(POND(I)),TOTALSOLNH4(POND(I)),
	1	TOTALSOLNO3(POND(I))
		WRITE(1793,387) TOTALINFP(POND(I)),TOTALINFNH4(POND(I)),
	1	TOTALINFNO3(POND(I)),TOTALLOSTSOLP(POND(I)),
     2	TOTALLOSTSOLNH4(POND(I)),TOTALLOSTSOLNO3(POND(I))
		WRITE(1793,389) SOLP(POND(I)),SOLNH4(POND(I)),SOLNO3(POND(I))
		END IF
		END IF
	END DO
	




389	FORMAT (1X,'Current Phosphorus=',F9.5,'  Current NH4=',F9.5,'  
	1Current NO3=',F9.5)

388	FORMAT (1X,'Current Sediment=',F9.5,'  Current Phosphorus=',F9.5,
	1'  Current A-Nit=',F9.5,/,'  Current O-Nit=',F9.5)
	
386	FORMAT (1X,'Soluble P inflow=',F9.7,'  Soluble NH4 inflow=',F9.7,
	1'  Soluble NO3 inflow=',F9.7)

387	FORMAT (1X,'Infiltrated P=',F9.7,'  Infiltrated NH4=',F9.7,'  Infi
	1ltrated NO3=',F9.7,/,' Lost P=',F9.7,'  Lost NH4=',F9.7,'  Lost N
	1O3=',F9.7)

385	FORMAT (1X,'Deposited Sediment=',F9.3,'  Deposited Phosphorus=',
	1F9.5,'  Deposited A-Nit=',F9.5,/,'  Deposited O-Nit=',F9.5)

384	FORMAT (1X,'Sediment Outflow=',F9.3,'  Phosphorus Outflow=',F9.5,
	1'  A-Nit Outflow=',F9.5,/,'  O-Nit Outflow=',F9.5)

383	FORMAT (1X,'Sediment Inflow=',F9.3,'  Phosphorus Inflow=',F9.5,
	1'  A-Nit Inflow=',F9.5,/,'  O-Nit Inflow=',F9.5)

382	FORMAT (1X,'Water Inflow=',F10.3,'  Pipe Outflow=',F9.3,
	1'  Weir Outflow=',F9.3,/,'  Total Infiltration=',F9.3,'  Total Eva
     1poration=',F9.5,'  Current Water Depth=',F9.3)

C**   WDB 5/23/94
      ENDIF

C *** NRZ
C *** PRINT CELLULAR OUTPUT FILE IF REQUESTED FOR A CERTAIN DAY

      DO 9877 NZ=1,10
        IF (LDYEAR.EQ.NPDAY(NZ)) THEN
          XCOR = 365./DBLE(IDATE)
	  NFUNIT=30+NZ
	  WRITE(XPFIL(NZ),9900) NPDAY(NZ)
 9900     FORMAT (I7)
	  OPEN (NFUNIT,FILE=XPFIL(NZ))
   
          DO 9878 I=1,N
            WRITE (NFUNIT,360) I,SUMSED(I)*XCOR,SUMNO3(I)*XCOR,SUMNHW(I)
     &      *XCOR,SUMNHS(I)*XCOR,SUMTKN(I)*XCOR,SUMPO4(I)*XCOR,CLENO3(I)
     &      *XCOR
 9878     CONTINUE
          CLOSE (NFUNIT)
        ENDIF
 9877 CONTINUE

      DO 29293 I=1,N
!TMN  ADDED TO SUM THE TOTAL NITROGEN THAT IS LEACHED ANNUALLY
      
	LNO3DAY=LNO3DAY+CLENO3(I)
29293 CONTINUE

      LNO3ANNUAL=LNO3ANNUAL+LNO3DAY-CUMMULATIVE
	CUMMULATIVE=LNO3DAY
      LNO3DAY=0.0

!TMN  ADDED COUNTER FOR THE ANNUAL OUTPUT
 	IF(LDAY.EQ.365 .AND. MOD(YERBEG,4).NE.0.) THEN
	ANNUALOUT=1
        ELSEIF (LDAY.EQ.366 .AND. MOD(YERBEG,4).EQ.0) THEN
	ANNUALOUT=1
	ENDIF

 !TMN  WRITE ANNUAL OUTPUT TO 'ANNUAL.OUT' (UNIT=300)
!      IF(MOD(IDATE,365).EQ.0)THEN
      IF (ANNUALOUT.EQ.1)THEN
	WRITE (300,988)YERBEG,PCPANNUAL,RUNANNUAL,
     & SEDANNUAL,NO3ANNUAL,NHWANNUAL,
     & NHSANNUAL,PO4WANNUAL,PO4SANNUAL,TKNANNUAL,LNO3ANNUAL

 988  FORMAT(1X,I4,2X,F8.2,1X,F6.1,1X,F10.1,1X,F9.4,2(2X,F7.2),
     &2(3X,F7.2),3X,F10.3,1X,F10.2)

!TMN  SET ANNUAL ACCUMULATION TO ZERO FOR NEW YEAR 
      PCPANNUAL=0
	RUNANNUAL=0
      SEDANNUAL=0
	NO3ANNUAL=0
	NHWANNUAL=0
	NHSANNUAL=0
	PO4WANNUAL=0
	PO4SANNUAL=0
	TKNANNUAL=0
	LNO3ANNUAL=0
!TMN  RESET THE ANNUAL COUNTER TO ZERO
      ANNUALOUT=0
      ENDIF

 5555 CONTINUE

       CLOSE(5) 

C *** SET IEEE ARITHMETIC FLAG TO 0 FOR SUN-OS FORTRAN 77 COMPILER
*      ieeer=ieee_flags('clear', 'exception', 'all', out)  

C
C **** FORMATS.
C
  280 FORMAT (19A4)
  290 FORMAT (1X,52H DISTRIBUTED HYDROLOGIC AND WATER QUALITY SIMULATION
     1,/9X,37HBY ANSWERS VER 19 AUG 99 BETA RELEASE/19A4)
  300 FORMAT (/,15X,'OUTLET HYDROGRAPHS--VER 4.940001',/,31X,'YIELD',9X,
     1'CONCENTRATIONS -',A4,/,2X,' TIME',2X,'RAINFALL',2X,'RUNOFF',4X,'S
     2EDIMENT',3X,'SEDIMENT  PHOSPHORUS   SOLPHOS',/,1X,'  MIN.',2X,2A4,
     31X,2A4,5X,A4,18X,'(MG)',6X,'(G)')
* 309 FORMAT(5X,'TIME',5X,'SEDIMENT',5X,'SOLUBLE',6X,'SEDIMENT')
* 308 FORMAT(13X,'BOUND NH4',7X,'NH4',7X,'BOUND ORG-N',5X,'NITRATE')
* 307 FORMAT(5X,'(MN)',6X,'(G)',10X,'(G)',10X,'(G)',11X,'G')
C *** NRZ
C *** SIGNIFIED DISSOLVED PO4 IN CELLULAR OUTPUT ("DIS-PO4", NOT "PO4")
  309 FORMAT(1X,7HELE NO ,1X,9H SEDIMENT,1X,9H   NO3   ,1X,9H SOL-NH4 ,
     &1X,9H SED-NH4 ,1X,9H SED-TKN ,1X,9H DIS-PO4 ,10H NO3 LEACH )
  308 FORMAT(1X,7H       ,1X,9H   KG/HA ,1X,9H KG/HA   ,1X,9H  KG/HA  ,
     &1X,9H   KG/HA ,1X,9H  KG/HA  ,1X,9H  KG/HA  ,9H   KG/HA )
  310 FORMAT (1X,F7.1,F8.2,F10.4,2F11.0,1X,F12.3,1X,F12.5)
  311 FORMAT(1X,F7.1,1X,F12.4,1X,F12.4,1X,F12.4,2X,F12.4)
  320 FORMAT (4X,28HRUNOFF VOLUME PREDICTED FROM,F7.2,A4,14H OF RAINFALL
     1 =,F7.3,A4/15X,19HAVERAGE SOIL LOSS =,F7.0,1X,2A4)
  330 FORMAT (///5X,48HMEAN FLOW DEPTH GREATER THAN EXPECTED AT ELEMENT,
     1I5/56H CONDITION OCCURRED BECAUSE THIS ELEMENT'S SLOPE IS MUCH,
     231H LESS THAN WATERSHED AVERAGE OR,/,28H CIRCULAR FLOW PATTERNS 
     3ARE ,58H PRESENT IN THIS VICINITY.  RECOMMENDED CORRECTIVE ACTION:
     4,/' INCREASE EXPECTED PEAK RUNOFF VALUE (SF) IN SUBROUTINE DATA', 
     510H OR MODIFY,/,24HELEMENT FLOW DIRECTIONS.)
  350 FORMAT (1X,'MAX EROSION RATE =',F7.0,2A4,2X,'MAX DEPOSITION RATE =
     1',F7.0,2A4,/,23X,'STD. DEV. =',F7.0,2A4,//,24X,'CHANNEL DEPOSITION
     2 --',A4,/,4(4X,'NO.     AMOUNT'))
  360 FORMAT (I7,1X,F9.0,6(1X,F9.3))
  370 FORMAT (21H  STRUCTURAL PRACTICE,I3,32H REDUCED TOTAL SEDIMENT YIE
     1LD BY,F9.0,A4)
C 380 FORMAT (I4,2F7.2,F7.0,I3/12A4)
C 390 FORMAT (3F10.2,F10.0)
  405 FORMAT(/20X,26HPARTICLE SIZE DISTRIBUTION/
     *24X,18HOF ERODED SEDIMENT/)
  410 FORMAT(17X,15HPARTICLE CLASS ,I1,2H =,F6.2,8H PERCENT)
C
 5560 FORMAT(1X,I4,1X,I4,1X,I4,1X,I1,1X,I1)

C *** NRZ 9/12/94
C *** MODIFY FORMAT LINE FOR FERTILIZER INPUT
C 6010 FORMAT (1X,F9.4,1X,F9.4,1X,F9.4)
 6010 FORMAT (1X,I4,1X,I3,1X,I5,3(1X,F9.4))
C *** NRZ 9/12/94

 2570 FORMAT(2X,I4,1X,I3,3X,F7.2,2X,F7.3,2X,F7.0,3X,F7.4,2X,F7.4,5X,
     &F7.4,3X,F7.4,/,55X,F7.4,5X,F7.4)
 2580 FORMAT(2X,I4,1X,I3,3X,F7.2,2X,F7.3,2X,F7.0,3X,F7.3,2X,F7.3,5X,
     &F7.3,3X,F7.3,/,55X,F7.3,5X,F7.3)
!WB	BEGIN NEW SED ROUTINE ERROR MESSAGES 
 2582 FORMAT ('GROWTH FACTOR IS < 0 OR >1',F5.2) 
 2584 FORMAT ('MAXIMUM PLANT HEIGHT <0 OR > 3.0 M',F5.2)
 2586 FORMAT ('THE HEIGHT FACTOR IS <0 OR >1',F5.2,/,'PLEASE CHECK THE
     1GROWTH FACTOR AND MAXIMUM PLANT HEIGHT')
 2588 FORMAT ('THE AREA UNDER THE CANOPY IS EITHER < 0 OR > 100%',
	1F6.2)
 2590	FORMAT ('THE AREA UNDER THE CANOPY FACTOR IS <0 OR >1',F5.2,/,
     1'PLEASE CHECK THE GROWTH FACTOR AND AREA UNDER CANOPY')
 2592 FORMAT ('AN ERROR HAS OCCURRED.  PLEASE CHECK THE PRIMARY'
	1,/,'OUTPUT FILE.')
 2594 FORMAT ('ERROR IN ROUTINE THAT CALCULATES THE COVER
	1 FOR THE ',/,'CURRENT DAY.  PLEASE CHECK YOUR ROTATION
	2 PARAMETERS.')
 2595 FORMAT ('THE ROTATION LENGTH IS GREATER THAN ONE YEAR.  THIS ',/,
     1'MAY CAUSE ERRORS IN THE PLANT GROWTH SCHEME.  PLEASE LIMIT',/,
	2' ROTATIONS TO LESS THAN ONE YEAR IN LENGTH.')
 2596 FORMAT ('ONE OF THE SOIL VARIABLES IS < 0, >1 (>100%), OR BULK'
     1,/,' DENSITY IS INPUT IN KG/M3 INSTEAD OF G/CM3',/,'IT IS
	2CLAY =',F5.2,' SAND =',F5.2,' SILT=',F5.2,' VFS =',F5.2,
     3' ORGMAT=',F5.2)
 2597 FORMAT('MASS OF C.F. BY WEIGHT =',F5.2,' BULK DENSITY ='
     4,F5.2,/,'IT OCCURRED AT CELL # ',I3) 
 
 2598 FORMAT ('KRBASE GT 0.05',' CNT =',I3,' KRBASE= ',F8.4, 
	1/,' AND HAS BEEN SET EQUAL TO 0.05.')
 3000 FORMAT ('KRBASE LT 0.002',' CNT =',I3,' KRBASE= ',F8.4,
	1/,' AND HAS BEEN SET EQUAL TO 0.002.')
 3002	FORMAT ('TAUCB GT 7.0',' CNT =',I3,' TAUCB= ',F8.4,
	1/,' AND HAS BEEN SET TO 7.0')
 3004 FORMAT ('TAUCB LT 0.3',' CNT =',I3,' TAUCB= ',F8.4,
	1/,' AND HAS BEEN SET TO 0.3')
 3005 FORMAT ('THE BURIED RESIDUE ADJUSTMENT IS <0 OR >1, AND THIS',/,
	1'INDICATES THAT A PROGRAM ERROR HAS OCCURRED.  KRBR = ',F5.2,/,
     2' AT CELL # ',I3)
 3006 FORMAT ('THE RANDOM ROUGHNESS APPEARS TO BE INPUT IN M.',/,
	1' THE RANDOM ROUGHNESS IS (IN METERS):',F10.5,/,
     2' THE CROP SERIES # IS: ',I3,/,' PLEASE BE 
	2 CERTAIN THAT THE ROUGHNESS IS INPUT IN MM.')
 3008 FORMAT ('THE RANDOM ROUGHNESS ADJUSTMENT FACTOR INDICATES THAT',/,
	1' RANDOM ROUGHNESS EXCEEDS 200 MM, OR IS INPUT IN METERS.',/,
     2' PLEASE CHANGE THIS.',/,
	3' RR ADJUSTMENT =',F5.2,' THE CELL IS: ',I3)
 3010 FORMAT ('KIBASE GT 12,000,000 AT CELL:',' CNT =',I3,' 
	1KIBASE = ',F8.4,/,' AND HAS BEEN SET TO 12,000,000.')
 3012 FORMAT ('KIBASE LT 500,000 AT CELL:',' CNT =',I3,'
	1KIBASE =',F8.4,/,' AND HAS BEEN SET TO 500,000.')
 3014	FORMAT ('FIELD CAPACITY TIMES POROSITY (FCFRAC) IS GT 1.'
     1,/,' THE VALUE IS: ',F5.3,' AND IT OCCURRED FOR SOIL #: ',I3)
 3016	FORMAT ('THE SOIL CONSOLIDATION FACTOR KRCONS IS LT 0 OR GT 1.'
	1,/,' ITS VALUE IS: ',F6.3,' AT CELL #: ',I5)
 3018	FORMAT ('THE SEALING AND CRUSTING FACTOR IS LT 0 OR GT 1.'
	1,/,' ITS VALUE IS: ',F6.3,' AT CELL #: ',I5)
 3020	FORMAT ('THE ADJUSTED RILL ERODIBILITY IS LT 0.'
	1,/,' ITS VALUE IS: ',F6.3,' AT CELL #: ',I5)
 3022 FORMAT ('THE ADJUSTED RILL ERODIBILITY IS GT 1.'
	1,/,'ITS VALUES IS: ',F6.3,' AT CELL #: ',I5)
 3030 FORMAT ('TAUCONS LT 0, OR TAUCADJ GT 15.',/,' TAUCONS: ',F10.5,/,
	1' CELL #: ',I4)
 3032 FORMAT ('HEIGHT GT 3.0 M, OR CANOPY FACTOR GT 1.0',/,'
     1 CELL #: ',I3)
 3034	FORMAT ('THE INTERRILL CANOPY FACTOR IS LT 0 OR IS GT 1.'
     1,/,' THE VALUE IS: ',F5.3,' AND IT OCCURRED FOR CELL #: ',I3)
 3036	FORMAT ('THE FRACTION OF INTERRILL AREA COVERED BY GROUND
     1 COVER IS 0 OR IS GT 1.',/,' AND IT HAS BEEN SET TO 0 OR 1 '
     2,/,' THE VALUE IS: ',F5.3,' AND IT OCCURRED FOR CROP #: ',I3)
 3038 FORMAT ('THE INTERRILL COVER FACTOR IS LT 0 OR IS GT 1.'
     1,/,' THE VALUE IS: ',F5.3,' AND IT OCCURRED FOR CELL #: ',I3)
 
 3040 FORMAT ('THE VARIABLES BELOW HAVE CAUSED THE INTERRILL CONSOLI
	1DATION',/,' FACTOR TO BE NEGATIVE, PLEASE CHECK THEM.',/,
	21X,14HSAND FRACTION=,1X,F5.3,3X,24HORGANIC MATTER FRACTION=
     3,1X,F5.3,/,1X,15HFIELD CAPACITY=,1X,F5.3)
 3042 FORMAT ('THE INTERRILL SEALING AND CRUSTING FACTOR '
	1,/,' IS LT 0 OR IS GT 1.'
     2,/,' THE VALUE IS: ',F5.3,' AND IT OCCURRED FOR CELL #: ',I3)
 3044 FORMAT ('THE ADJUSTED INTERRILL ERODIBILITY FACTOR IS LT 0.'
     1,/,' THE VALUE IS: ',F5.3,' AND IT OCCURRED FOR CELL #: ',I3)
 3046 FORMAT (11HCELL NO. = ,I5,2X,12HSOIL TYPE = ,I2,2X,
     114HFINAL WIDTH = ,F8.3)
 3047 FORMAT (14HERODED DEPTH =,2X,F7.4)
 3048 FORMAT (17HDEPOSITED DEPTH =,2X,F7.4)
 3049 FORMAT ('THE INTERILL COVER IS LESS THAN 0.'
	1,/,'  ITS VALUE IS ',F6.3,' FOR CROP # :',I3)
 3050 FORMAT ('THE DEAD ROOT FACTOR IS LESS THAN -1, OR GT 1'
	1,/,'  ITS VALUE IS ',F6.3,' FOR CROP # :',I3)
 3052 FORMAT ('THE LIVE ROOT FACTOR IS LESS THAN 0, OR GT 1'
	1,/,'  ITS VALUE IS ',F6.3,' FOR CROP # :',I3)
 3054 FORMAT ('KLROOTR LT 0 OR GT 1 :',F6.3,3X,'FOR CROP #',3X,I3
	1,' AT CELL # ',3X,I4)
 3056 FORMAT ('KDROOTR LT 0 OR GT 1 :',F6.3,3X,'FOR CROP #',3X,I3
	1,' AT CELL # ',3X,I4)
 3058 FORMAT ('KLROOTI LT 0 OR GT 1 :',F6.3,3X,'FOR CROP #',3X,I3
	1,' AT CELL # ',3X,I4)
 3060 FORMAT ('KDROOTI LT 0 OR GT 1 :',F6.3,3X,'FOR CROP #',3X,I3
 	1,' AT CELL # ',3X,I4)
 3080 FORMAT (A13,I8)
 3090 FORMAT (12X, 'RAINFALL', 22X, 'SEDIMENT', 2X,/, 6X 
     1,'TIME', 1X, 'INTENSITY', 6X, 'FLOW', 6X, 'FLOW', 5X, 'CONC.'
     2,3X,'SED-PO4',3X,'DIS-PO4',3X,'SED-NH4',3X,'DIS-NH4',3X
     3,'SED-TKN',3X,'DIS-NO3',/, 6X, 'MIN.', 5X, 'MM/HR', 5X, 'MM/HR'
     4,7X,'CMS', 7X, 'PPM',7X,'PPM',7X,'PPM',7X,'PPM',7X,'PPM',7X,'PPM'
     5,7X,'PPM')
 3100 FORMAT (11(1X,F9.2))
 9000 END

C **** NRZ 7/23/95
C **** ADD IEEE HANDLER
*      integer function handler(sig,code,context)
*      integer sig, code, context(5)
*      write (*, '("exception at pc", I5 )' ) context(5)
*      end
  
      SUBROUTINE XDATA (NDT,KPR,N,CONV,CU,SF,IT,NN,ICR,NFI,CU2,ISTRUC,
     &SB,TMIN,TMAX,NRG,DX,GRF,NEXP,DC,PP,FILTS,CWID,AREA,AREA2,DT,NMAX,
     &CU1,DAYBEG,SIMDUR,ISR,YERBEG,CLAYAV,CALLBMP,CROP)
      IMPLICIT DOUBLE PRECISION A-H,O-Z

C
C ****** SUBROUTINE TO INPUT WATERSHED DATA.
C
C *** NRZ 9/12/94
C *** ADD VARIABLES FOR FERTILIZER INPUT

      COMMON /FERT/ IFERT

C *** NRZ 9/12/94

      COMMON /ZSEDI/ NPART,NWASH,NWASH1
      COMMON /ZSEDR/ VISCOS,AGRAV,SWH2O,YALCON,SE(8),VS(35000),DIA(8),
     1SG(8),FV(8),CY1(8),CY2(8),CY4(8),DIAMM(8),EQSDIA(8),EDMM(8),
     2F(30,8),CE1,CE2,CE3,CE4,CE5,CE6
!WB	Changed F(10,8) to F(30,8) to accomodate 30 soil types
      COMMON /CUMIN/ CUMIN1(35000),rbit0(35000),testi(35000),timpon
	1(35000),tpon(35000)
C
C **** MAXIMUM NUMBER OF SOIL TYPES IS 30.
C
      COMMON /CSOIL/ A(30),FC(30),GWC(30)
      COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     & ,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &  CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &  THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &  CRC(30),KE(30,30),ZC(30),BD(30)
       

C **** NRZ 9/12/94
C **** ADD VARIABLES TO ENTER SATURATED HYDRAULIC CONDUCTIVITY

      DIMENSION SK(30),KOPT(30) 

C **** NRZ 9/12/94
 
 
      COMMON /ETPES/LAI(20,11),ESU(30),LAI1(20),POTLAI(20)
     &,SUMLAI(20)
	COMMON /EDX/ EDX(30)
      COMMON /ROT/ IROT1,IROT(20,644)
      INTEGER IROT1,IROT
       DOUBLE PRECISION KS,KE,LF,LAI,LAI1

C *** NRZ 9/15/94
C *** CHANGE DIMENSION OF SOME VARIABLES TO CORRESPOND WITH 
C *** NMAX+ISTRUC+1+NCHAN
 
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
 
      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)
 
 
      COMMON/NITRO2/ O0SOIL(35000),ONPT(35000,8),ONI(35050,8),
     & ONSEL(35000),ON2(8),ONCELL(35000,8),ONE(8),ON0(35000,8)
 
      COMMON /SOLUB/ SP2(35000),PEXT(35000),PK(30)
     & ,RBETA(30),SPI(35050),CGEN1(35000)
     & ,T13(35000),SPSP(35000)
 
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)
 
      COMMON /TRANSF/POTMIN(35000),SOILN(35000),XMIN(35000),AMON(35000)
     & ,NIT(35000),DNI(35000),UPNH4(35000),UPNO3(35000),TDMN2(35000)
     & ,ROTR(35000),RFON(35000)
      DOUBLE PRECISION XMIN,NIT
      COMMON /TRAP/PMINP(35000),SOILP(35000),MINP(35000),PLAB(35000),
     &  UPPHOS(35000),TDMP2(35000),SORGP(35000),PSOL(35000),
     &  EDILAB(35000)
      DOUBLE PRECISION MINP
 
      COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)
 
C *** NRZ 9/15/94
      COMMON /ASMF/ ASMBF(30),FCAP1(30),TP1(30),RESWAT(30),DF1(30)
       DIMENSION TP(30), DF(30), ASM(30), FCAP(30)
C
C **** MAXIMUM NUMBER OF SURFACE AND CROP TYPES IS 20.
C
      COMMON /CROUGH/ ROUGH(20),HU(20),DIR(21),PIT(40,20),PER(20)
!WB	I'm not sure if the below is still true.
C
C **** MAXIMUM NUMBER OF OVERLAND ELEMENTS PLUS CHANNEL ELEMENTS
C **** IS 50.
!WB	below is no longer true becuase they aren't equivalenced anymore
C ****** IT IS EXPECTED THAT ARRAY "IEL" (IN SUBROUTINE DATA) WILL
C ****** BE OF SUCH A SIZE THAT IT WILL OVERLAY (BE EQUIVALENCED TO)
C ****** THE SPACE IN ARRAYS SI AND QI TOGETHER.  THEREFORE IT IS
C ****** NECESSARY THAT THESE TWO ARRAYS BE KEPT ADJACENT IN THEIR
C ****** COMMON BLOCK.  NOTE: THE ACTUAL NUMBER OF ELEMENTS THAT
C ****** CAN BE DIMENSIONED IN IEL WILL DEPEND ON THE WORD LENGTH
C ****** OF THE MACHINE BEING USED, E.G. ON A MACHINE WHICH USES
C ****** A SINGLE WORD INTEGER AND A DOUBLE WORD REAL, THE NUMBER
C ****** OF ELEMENTS IN IEL CAN BE FOUR TIMES THE NUMBER OF ELEMENTS
C ****** IN ARRAY SI.
C
C ****** NRZ 9/15/94
C ****** DIMENSIONS OF SI AND QI ARE CHANGED TO CORRESPOND WITH 
C ****** NMAX+ISTRUC+1+NCHAN
C
      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
C *** NRZ
C *** ADD COMMON BLOCK FOR PERCENTAGE OF CELL AREA "LEAKING" OUTSIDE THE
C *** WATERSHED

      COMMON /LEAKY/ OUTSID
	
	
C *** NRZ END
!WB	I'm not so sure that the below is still true.  See above
C
C ****** ARRAYS SI AND QI MUST BE DIMENSIONED TO A SIZE = NMAX+ISTRUC+2
C ****** TO HOLD, IN ORDER, SEDIMENT AND FLOW FROM THE WATERSHED OUTLET
C ****** ELEMENT, STRUCTURAL PRACTICES AND ANY "LEAKY" ELEMENTS.
C
      DIMENSION CROP(20,2), RN(20), DIRM(20), CBAR(20), SPER(30), NSTRUC
     1(4), STRNAM(3,4)
	CHARACTER*4 CROP
      
      COMMON / CROPAD/  DIRM2(20)
C
C **** MAXIMUM NUMBER OF RAINGAGES IS 40 WITH 200 VALUES PER GAGE.
C
	COMMON /CRGAGE/ RC(40,200),TC(40,200),R(40,21),FRA(40),JTR(40),
	1RATE(40),SR(40),NF(40),RATE2(40)
      
      DIMENSION  IRR(40),IG(40),XDATE(2)
      
      DIMENSION IEL(3,300,24), ITEMP(24)
      DIMENSION IELC(3,300,2), ITEMPC(2)
      DIMENSION FILTS(35000), CWID(35000),CWIDTMP(35000)      
      
	COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
	COMMON /PARTITION/PKDA(30),PKDP(30),PSP(30)
      COMMON /PLANTN/DATPLA(20),DATHAR(20),CP1(20),CP2(20),DMY(20)
     &  ,YP(20),ROTMAX(20),ROTDAY(20),RLAIMX(20)
     &  ,RES(20),RES20(20),RES90(20)

	COMMON /WETDEPOSIT/ NO3ZDEP(21,4),WATNHDEP(21,4),SOLUBPDEP(21,4),
	1TSSDEP(21,4)
	DOUBLE PRECISION NO3ZDEP, WATNHDEP, SOLUBPDEP,TSSDEP
	COMMON /ATMDEPO/ ATMDEP(21,4),TKNDEP(21,4),AMNDEP(21,4),
	1SEPDEP(21,4)
** NRZ (8/29/94)
** ADD COMMON STATEMENT FOR IMPOUNDMENT DIMENSIONS

      COMMON /IMPDIM/ BASE,WIDTH,SLOPE,ORIF,CI,FI,MAXHGT,NIMP
      DOUBLE PRECISION BASE(10),WIDTH(10),SLOPE(10),ORIF(10),CI(10),
     &FI(10),MAXHGT(10)
     
      COMMON /FWATER/ AFWEV,DFWEV

C *** ADD COMMON BLOCK FOR EXTRA OUTPUT OPTIONS

      COMMON /XPRINT/ NSBS,NPDAY(10)

** NRZ (8/29/94)
	
	INTEGER SUR,SOIL,TIAL(35000),RANE,CHAN(35000),DATPLA,DATHAR


C NRZ 9/5/94
C ADDED VARIABLES FOR CHANNEL NETWORKS
 
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)


      INTEGER CHNUM,CHOUT,CHNUMBER
      CHARACTER*13 OUTFIL(10)
      DIMENSION LCC(35000),LCR(35000)


C NRZ 9/5/94

      INTEGER DAYBEG,SIMDUR,YERBEG,ROTMAX,ROTDAY
C
C **** MAXIMUM NUMBER OF CHANNEL TYPES IS 30.
C
!WB	BEGINNING OF NEW VARIABLES FOR NEW DETACHMENT ROUTINES
!WB	soil variables:
	COMMON/SOILVAR/CLAY(30),SAND(30),SILT(30),VFSPER(30),VFS(30),
	1ORGMAT(30),MASSCF(30),RANROU(30),RANROUM(30)
	DOUBLE PRECISION MASSCF

!WB	rill erodibility variables:
	COMMON/RILLVARS/KRBASE(35000),KRBR(35000),BR(20),BURRES(20),
	1KRADJHLD(35000),KRCONS(35000),KRSC(35000),KRADJ(35000)
	DOUBLE PRECISION KRBASE,KRBR,KRADJHLD,KRCONS,KRSC,KRADJ

!WB	critical shear variables:
	COMMON/CRTSHEAR/TAUCB(35000),TAURR(35000),TAUCHLD(35000),TAUCONS
	1(35000),TAUSC(35000),TAUCADJ(35000),TAUEFF
	
!WB	interrill erodibility variables:
	COMMON/IRILLVARS/KIBASE(35000),KICAN(35000),KIGRCOV(35000),KICONS
	1(35000),KISC(35000),KIADJ(35000),CANOPY(20),AUCFACT(20),
     2HEIGHT(20),MAXPLHGT(20),HGTFACT(20),GROWFACT(20)
	DOUBLE PRECISION KIBASE,KICAN,KIGRCOV,KICONS,KISC,KIADJ,MAXPLHGT
	
!WB	interrill cover common block:
	COMMON /IRILLCOV/ INRCOV(20),INRCOVI(20),INRCOVF(20),INRFACT(20),
	1LROOT(21),DROOT(21),KDROOTI(35000),KLROOTI(35000),DDROOTI(21),
	2DDROOTF(21),DDRTFAC(21),LRFAC(21),LIVEROOT(21),KDROOTR(35000),
	3KLROOTR(35000)
	
	DOUBLE PRECISION INRCOV,INRCOVI,INRCOVF,INRFACT,LROOT,KDROOTI,
	1KLROOTI,LRFAC,LIVEROOT,KDROOTR,KLROOTR

!WB	rill erosion variables:
	COMMON/RILLEROS/NORILLS,RILLSPC(20),QEFF,RILLWID,MNSOIL(21),
     1MNTOT(21),FLOWDEP,HYDRAD,DCAP,FCFRAC(30),FOFD,FPOFD,FDPOFD,
	2FLDEPOLD,MNCHNSL(35000),MNCHNTOT(35000),MNCS(30),MNCT(30),MNCSTMP
	3(35000),MNCTTMP(35000),MAXWID,NOTILL(21),NOEROS(21),DWSOIL,
	4HYDRADOLD(35000)
	DOUBLE PRECISION MNSOIL,MNTOT,MNCHNSL,MNCHNTOT,MNCS,MNCT,MNCSTMP,
	1MNCTTMP,NORILLS,MAXWID

!WB	interrill erosion variables
	COMMON /IRILLEROS/RNOFIR,SEDDR(35000,8),DIINT(35000,8),DETR(8)
	1,DETF(8),DACT(35000,8)

!WB	PLANT GROWTH VARIABLES
	COMMON /PLANTS/ DAYNOW(35000),YEARNOW(35000),DYYRNOW
	1(35000),DAYTHEN(35000),YEARTHEN(35000),DYYRTHEN(35000),
     2DAYDIFF(35000),BEGROTDT(35000)

!WB	CHANNEL BOTTOM EROSION VARIABLES	
	COMMON /CHANEROS/WIDINC(35000),DOWNRATE(35000),
	1DEPTHINC(35000),IMPERM(30),ROCKBOT(35000),RBTEMP(35000),
     2BULKDENS(30),CHNSOIL(35000),CHNSL(35000),CHNSLTMP(35000)
	3,DEPRATE(35000),DEPPREV(35000),CONSTHLD(35000),XHOLD(35000)
     4,CONSTTMP(35000),XTMP(35000)

	DIMENSION CHNURB(35000),CHNURBTMP(35000)

	COMMON /ARMOUR/ARMOUR(35000),NOERODE(35000)
	1,NERODTMP(35000)

!WB	HYDROGRAPH PLOT VARIABLES
	COMMON /HYPLT/PRINHYD,IMPFLAG,QHYP(101,10),PHYP(101,10)
	1,DPHYP(101,10),A4SHYP(101,10),A4DHYP(101,10),ONHYP(101,10)
	2,A3HYP(101,10)
	CHARACTER(11) HYPNAM(10)

	DOUBLE PRECISION DIFF,RGTSID,LFTSID,IMPERM,NOERODE,NERODTMP

	INTEGER CNT,CNTER,CNTFLAG,NOTILL,INIT,NOEROS,CHNSL,CHNSOIL,
	1CHNSLTMP,PRINHYD

!WB	Sediment Erosion routine information:  Some equations and
!WB	calculations in the sediment subroutine are not placed in the
!WB	location that will allow optimal calculation efficiency.  This is
!WB	recognized, and was done in order to ease understanding of the 
!WB	methodology at the cost of computational efficiency.

!WB	END OF NEW VARIABLES FOR NEW DETACHMENT ROUTINES

!RZ	IRRIGATION VARIABLES
	COMMON /IRRIG/ IRRFLAG,IRRCROP,DEFLIMIT(20),STARTDAY(20),
	1ENDDAY(20),FREQ(20),IRREFF(20),IRRATE(20),DURATION(20),
     1IRRTARGET(30),LIMIT(20),IIRRI,IRRCYCLE(20),LASTIRR(20),SKIPFLAG,
     1CROPNOIRR(20),IRRFLAG2(20)
	INTEGER SKIPFLAG,STARTDAY,ENDDAY,FREQ,LIMIT,CROPNOIRR
	DOUBLE PRECISION IRREFF,IRRATE,DURATION,IRRTARGET

!RZ	URBAN BMP VARIABLES
	DIMENSION CALLBMP(35000)
	INTEGER CALLBMP

	COMMON /BMP2/ PONDAREA(300),NRO(300),H2ODEPTH(300),
	6ORAREA(300),WEIRVOL(300),ORVOL(300),ORTOP(300),
	7MAXFLOW(300),SOLP(300),SOLNH4(300),SOLNO3(300),
	8LOST(300),WLOST(300),ORBOT(300),TIPE(300),
	9PIPEN(300),PIPED(300),PIPEL(300),RISD(300),PIPEAREA(300),
	1RISH(300)
	INTEGER TIPE

	COMMON /BMP3/ POND(35000),STREAM(300),SUB(300)
	INTEGER POND,SUB
	
	COMMON /BMP4/ ENDNO3SI,MYSHADOW(35000),MAXPOND
	INTEGER MAXPOND


	DIMENSION A1DUMMY(3,300,24), A2DUMMY(35000), A3DUMMY(35000),
	1A5DUMMY(3,300,2)
	INTEGER A1DUMMY, A2DUMMY

	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB

	INTEGER NOOFCHAN,HASOPENED,DIAGFLAG
	DIMENSION DIAGFLAG(35000)
      DIMENSION WID(30), CN(30), PP(14), TITLE(11)
      LOGICAL STRUC
      CHARACTER*4 C1, C2, C3, C4, C5, C6, PRI, UN, UNITS, PR, TEST
      CHARACTER*4 PP, TITLE, STRNAM, XDATE
      CHARACTER*2 IG, IELC, ITEMPC, ISTL
	CHARACTER*4 CDUMMY
	CHARACTER*2 A5DUMMY

      DATA C1,C2,C3,C4,C5,C6,PRI,UN/' RAI','  SI','  SO','  SU','  CH',
     1'  EL','PRIN','METR'/
      DATA ISTL/'TI'/
	
	DATA CDUMMY/'    '/


C **** NOW, STORE THE NAMES OF THE STRUCTURAL PRACTICES.
C
      DATA STRNAM/'PTO ','TERR','ACES','POND','S, L','AKES','G. W',
	1'ATER','WAYS','FIEL','D BO','RDER'/
      STRUC=.FALSE.



C
C ****** NUMBER OF STRUCTURAL PRACTICES PERMITTED.  ARRAYS STRNAM AND
C ****** NSTRUC MUST BE REDIMENSIONED IF ISTRUC IS MODIFIED.  ALSO, THE
C ****** ADDITIONAL STRUCTURE NAMES MUST BE ADDED TO THE DATA STATEMENT.
C
      ISTRUC=4	
!WB   # of structural practices
      IT=0
!WB   this appears to be a place holder for an array named PP
      OUTSID=0.
!WB	the number of cells flowing outside the watershed
      TMAX=0.
!WB	maximum time of the hydrograph
      TMIN=1.E+10
!WB	minimum time of the hydrograph.  It's big for a reason, that
!WB	is it is reset later to a smaller value.
	HASOPENED=0
!RZ	this is a variable to control the reading of the bmp file; must be
!RZ	initialized to zero here, will be changed in bmp routine

C
C **** INPUT UNITS USED IN SIMULATION AND OUTPUT PRINT CONTROL.
C
      READ (1,800) UNITS,PR
!WB	read the units and print flags      
C 
C **** NRZ 
C **** INPUT OUTPUT PRINT OPTIONS

      READ (1,801) NSBS
!WB	read the storm by storm output flag
      READ (1,801) (NPDAY(NZ),NZ=1,10)
!WB	read the additional days according to the above flag, up to 10 days
  801 FORMAT (24X,10(1X,I7)) 
C
C **** INPUT NUMBER OF RAINGAGES AND DATE OF EVENT.
C
      READ (1,802) PRINHYD
!WB	FLAG TO INDICATE WHETHER TO PRINT HYDROGRAPHS.  ADDED 14 AUG 1999
  802 FORMAT (21X,I2)
      READ (1,810) TEST,NRG,XDATE
!WB	read the test (=' rai'), # of rain gages, not sure about xdate
      IF (NRG.GT.40) GO TO 540
      IF (TEST.NE.C1) GO TO 580
!WB	C1 equals ' rai'      
	READ (1,1666) DAYBEG,YERBEG
!WB	read the beginning day and year of simulation
      READ (1,1667) SIMDUR
!WB	read the simulation duration
      DO 20 I=1,NRG
      READ(1,830) IG(I)
!WB	read from 1 to # of rain gages, the descriptor of each rain gage
  20  CONTINUE
C
C ****** DEFINE DEFAULT SIMULATION REQUIREMENTS.  MAXIMUM NUMBER OF
C ****** HYDROGRAPH PRINT POINTS IS 101 (THIS IS THE NUMBER THAT WILL BE
C ****** OUTPUT).  NORMAL TIME STEP IS 60 SECONDS AND NORMAL TIME STEP
C ****** FOR INFILTRATION IS 180 SECONDS.  MAXIMUM EXPECTED RUNOFF RATE
C ****** IS 2 INCHES (50.8 MM) PER HOUR.  IF A SEGMENTED CURVE ERROR
C ****** OCCURS DURING SIMULATION, INCREASE SF BY 50 PERCENT UNTIL THAT
C ****** PROBLEM CEASES (IT MAY NOT BE THE ONLY PROBLEM, THOUGH).
C ****** FOR WATERSHEDS WITH LARGE ELEMENTS (GREATER THAN 5 ACRES),
C ****** MILD TOPOGRAPHY (LESS THAN 1 PERCENT AVERAGE SLOPES), OR
C ****** MANY ELEMENTS (MORE THAN 1000), THE SIMULATION TIME STEP, DT,
C ****** SHOULD BE INCREASED TO NO MORE THAN 300 SECONDS (5 MINUTES).
C ****** SIMILARLY, FOR SMALL ELEMENTS (LESS THAN 1 ACRE), SEVERE
C ****** TOPOGRAPHY, OR WATERSHEDS WITH ONLY A FEW ELEMENTS, THE
C ****** SIMULATION TIME STEP SHOULD BE DECREASED TO 15 - 30 SECONDS.
C
C.... INPUT SIMULATION REQUIREMENTS
C
      READ (1,810) TEST
      IF (TEST.NE.C2) GOTO 580
!WB	C2 = ' si'
	READ (1,1030) NDT,DT,NFI,SF
!WB	# of lines of hydrograph print,sim time increment ,max # of 
!WB	time increments b/t infil recalc's, segment factor
      IF (UNITS.EQ.UN) IT=7
!WB	UN = 'metr'
      IF (PRI.EQ.PR) WRITE(2,630) DT,NFI,SF,PP(IT+1),PP(IT+2),NRG
      NFI=NFI/IFIX(SNGL(DT))
!WB	NFI = same / DT as an integer (IFIX converts by truncating)
C
C **** INPUT INFILTRATION AND SOIL DATA.
C
      READ (1,810) TEST
      IF (TEST.NE.C3) GO TO 580
!WB	C3 = ' so'
      READ (1,780) ISR
!WB	ISR = # of soil types    
	READ (1,780) ISRURB
!RZ	ISRURB= # OF URBAN SOIL TYPES, WHICH ARE THE FIRST SOILS IN DESCRIPTION SECTION  
	IF (PRI.EQ.PR) WRITE (2,750) PP(IT+1),PP(IT+2),PP(IT+1)
      IF (ISR.GT.30) GO TO 530
      ASMBAR=0.
      FPBAR=0.
!WB	I'm guessing that these are average values 
      DO 60 I=1,ISR
!WB	do from i=1 to # of soil types
!RZ	if the urban flag is triggered, the first soil type is urban, therefore
!RZ	go to the urbanized subroutine to read the variables.  This subroutine also
!RZ	calculates the needed variables from the next loop (DO 57); thus, the test in
!RZ	DO 57 skips to the end of the loop without going to the subroutine.
	IF (I.LE.ISRURB) THEN
		URBAN = 1
		IDUMMY=0
		DUMMY=0.
		CALL URBANIZED(URBAN,IDUMMY,IDUMMY,A1DUMMY,IDUMMY,IDUMMY,IDUMM
	1Y,IDUMMY,IDUMMY,IDUMMY,CDUMMY,I,UNITS,A3DUMMY,A5DUMMY,DUMMY,DUMMY,
	2DUMMY,DUMMY,DUMMY,IDUMMY,IDUMMY,A2DUMMY,A2DUMMY,CROP)
		GO TO 60
	END IF

      READ (1,790) TP(I),FCAP(I),FC(I),A(I),DF(I),ASM(I)
!WB	read TP=porosity for soil type i, FCAP=field cap for soil i as a 
!WB	fraction of pore space, FC=wilting point for soil it as a fraction
!WB	of pore space, A=ratio of sat hyd cond of the top layer and sat hyd
!WB	cond for underlying layer for soil i, DF=depth of soil horizon,
!WB	ASM=antecedent soil moisture as a fraction of pore space for soil i,

C *** NRZ 9/12/94
C *** ADD LINE TO READ SATURATED HYDRAULIC CONDUCTIVITY FROM INPUT FILE

      READ (1,791) KOPT(I),SK(I) 
!WB	I'm not really sure, but i'm guessing hydraulic conductivity?
C *** NRZ 9/12/94
	FCFRAC(I)=FCAP(I)*TP(I)
!WB	THE FIELD CAPACITY ON A VOLUME BASIS = FIELD CAP AS A FRACTION OF 
!WB	PORE SPACE * FRACTIONAL PORE SPACE
      ASMBF(I)=ASM(I)
!WB	antecedent soil moisture as a fraction of pore space
      FCAP1(I)=FCAP(I)
!WB	field capacity as a fraction of pore space
      DF1(I)=DF(I)
!WB	depth of soil horizon
      SPER(I)=0.
!WB	steady state infiltration rate (mm/h)
!RZ	I believe this is wrong.  I think SPER is a counter to determine how many cells
!RZ	have a particular soil type.  SPER stands for Soil PERcent.
      READ(1,795) CL(I),SA(I),ST(I),OM(I),WCF(I),VFSPER(I)
!WB	CL = clay content of the soil, SA = sand content of the soil (%),
!WB	ST = silt content of the soil (%), OM = organic matter content (%)
!WB	WCF = weight of the coarse fragment (%),VFSPER = percent of very
!WB	fine sand in the soil.
*PK REPRESENT SOIL PH
C----
      BD(I)=2.65*(1.-TP(I))
!WB	bulk density g/cm3
 
C
CC.....WATER TEMPERATURE ASSUMED TO BE 20 DEG.C. (68 DEG.F.).....
CC..........AT OTHER TEMPERATURES ADJUST VISCOS AND SWH2O..........
C
      AGRAV=32.174
!WB	acceleration due to gravity
      VISCOS=0.0000108
!WB	water viscosity
      SWH2O=62.32
!WB	specific weight of water
      IF(UNITS.NE.UN) GO TO 58
!WB	UN = 'METR' , so if its not metric, jump on down
      AGRAV=9.8066352
      VISCOS=0.000001003352832
C     SWH2O=9789.69088
      SWH2O=999.1677535
   58 CONTINUE
   60 CONTINUE
C
      DO 57 I=1,ISR
!RZ	URBAN: if the soil type is urban, skip all these calculations.  They have to do with
!RZ	soil interactions and are not present for urban 'soil' types.
	IF(I.LE.ISRURB) GO TO 57
!RZ
*************************************************
*ADDING THE CRUST THICKNESS ASSUMED TO BE 0.005M
      ZC(I)=0.5
*************************************************
 
 
*****************************
***POROSITY
***************
 
 
      PHI(I)=TP(I)
!WB	porosity = porosity
****VOLUME OF COARSE FRAGMENT (>2MM)
	 VCF(I)=100.*(WCF(I)/2.65)/(100.-(WCF(I)/BD(I))+(WCF(I)/2.65))
* WHERE WCF IS THE WEIGHT OF COARSE FRAGMENT (%)
****CORRECTION FACTOR FOR COARSE FRAGMENT
	 CFC(I)=1.0-(VCF(I)/100.0)
****CATION EXCHANGE CAPACITY/%CLAY
	 CEC(I)=(0.0059*CL(I)+0.041)/(.6*CL(I))
	 IF(CEC(I).LT.0.15) CEC(I)=0.15
****CORRECTION FOR ENTRAPPED AIR
	EAC(I)=1.0-(3.8+0.00019*CL(I)**2.-0.0337*SA(I)+0.126*CEC(I)
     &  *CL(I)+OM(I)*(SA(I)/200.)**2.)/100.
 
**************************
****EFFECTIVE POROSITY
	 PHIC(I)=PHI(I)*CFC(I)*EAC(I)
**************************
 
****************************
****CAPILLARY FRONT POTENTIAL
*****************************
      XF(I)=6.531-7.33*PHIC(I)+.001583*CL(I)**2.0+3.81*PHIC(I)**2.0
     & -.0498*SA(I)*PHIC(I)-.000799*SA(I)**2.0*PHIC(I)
     &-.0000140*SA(I)**2.0*CL(I)-.00348*CL(I)**2.0*PHIC(I)
     &  +.00034*CL(I)*SA(I)+.0016*CL(I)**2.0*PHIC(I)**2.0
     &  +.00161*SA(I)**2.0*PHIC(I)**2.0
 
************************
	PSIF(I)=DEXP(XF(I))
***************************************
!WB	PSIF = cap potential at the infil wetting front (mm)
*CONVERTING PSIF TO MM
	PSIF(I)=10.*PSIF(I)
************************
 
******CONSTANT C USED TO COMPUTE THE SATURATED HYDRAULIC CONDUCTIVITY
 
	CBF(I)=-0.17+0.181*CL(I)-0.00000069*SA(I)**2.0*CL(I)**2.0
     &    -.00000041*SA(I)**2.0*ST(I)**2.0+0.000118*SA(I)**2.0*BD(I)**2.
     &    +0.00069*CL(I)**2.0*BD(I)**2.0+0.000049*SA(I)**2.0*CL(I)
     &    -0.000085*ST(I)*CL(I)**2.0
 
****RESIDUAL SOIL WATER
	 THETAR(I)=(0.2+0.1*OM(I)+0.25*CL(I)*CEC(I)**0.45)*(BD(I)/100)
     &   *EAC(I)*CFC(I)
	 asmbf(i)=asmbf(i)-(thetar(i)/tp(i))
	  RESWAT(I)=THETAR(I)/TP(I)
 
****
* UPPER STAGE OF SOIL EVAPORATION (MM DAY ** -0.5)
 
**       ESU(I)= 9.*((4.165+0.02456*SA(I)-0.01703*CL(I)-0.0004*SA(I)
**   1          *SA(I))-3.)**0.42
	 ESU(I)=9.*(3.5-3.)**0.42
*COMPUTE THE MAXIMUM EVAPORATIVE DEPTH
	 EDX(I)=90.-0.77*CL(I)+0.006*SA(I)*SA(I)
************************************
****SATURATED HYDRAULIC CONDUCTIVITY
	  KS(I)=((PHIC(I)-THETAR(I))**3.0/(1-PHIC(I))**2.0)
     &       *(BD(I)/THETAR(I))**2.0*0.0002*CBF(I)**2.0
************************************
****MACROPOROSITY FACTOR
	Z(I)=DEXP(0.96-.032*SA(I)+.04*CL(I)-0.032*BD(I))
	IF(Z(I).LE.0.4) Z(I)=0.4
* SEE WEPP MANUAL
****CRUST FACTOR
	ZC(I)=1.
	SCF(I)=0.0099+.0721*ZC(I)+0.0000068*SA(I)**2.+.0000212*SA(I)
     &     **2.0*ZC(I)+.0003151*SA(I)*ZC(I)**2.0
****DEPTH TO WETTING FRONT
*** DEPTH TO WETTING FRONT MUST BE GREATER THAN CRUST DEPTH (1CM)
 
	LF(I)=14.7-(0.0015*SA(I)**2.)-0.3*CL(I)*BD(I)
	IF(LF(I).LE.ZC(I)) LF(I)=ZC(I)
 
****CORRECTION FACTOR FOR PARTIAL SATURATION OF THE SUBCRUST SOIL
	CS(I)=0.74+0.0019*SA(I)
****CRUST REDUCTION FACTOR
	CRC(I)=LF(I)/((LF(I)-ZC(I))/CS(I)+ZC(I)/SCF(I))
 
*CONVERTING KS FROM CM/HR TO MM/HR
      KS(I)=KS(I)*10.

C *** NRZ 9/12/94
C *** ASSIGN USER ENTERED VALUE OF SATURATED HYDRAULIC CONDUCTIVITY

      IF (KOPT(I).EQ.1) KS(I) = SK(I)
!WB	KOPT must be a flag for the K option, 
C *** NRZ 9/12/94

      LF(I)=LF(I)*10.
* this is the depth of the first soil layer
*      DF(I)= 250.
*COMPUTING PARTITION FACTOR FOR DISSOLVED AND ADSORBED AMMONIUM
       PKDA(I)=1.34+0.083*CL(I)
*COMPUTING PARTITION COEFFICIENT FOR PHOSPHORUS
       PKDP(I)=100.+2.5*CL(I)
*      PKDP(I)=5.1+2.2*CL(I)+26.4*(PK(I)-6.)*(PK(I)-6.)
*      WRITE(6,*) PK(I),PKDP(I)
       PSP(I)=0.46-0.0916*DLOG(CL(I))
       IF(PSP(I).LT.0.05)PSP(I)=0.05
       IF(PSP(I).GT.0.75) PSP(I)=0.75
!WB	phosphorus sorption coefficient 
C----
      IF (PRI.EQ.PR) WRITE (2,640) I,TP(I),FCAP(I),FC(I),KS(I),DF(I)
     1,ASM(I)
!WB	I = counter to # of soil types, TP = porosity for soil type i,
!WB	FCAP = field cap, FC = wilting point, KS = sat hydr cond, DF = 
!WB	depth of soil horizon, ASM = antecedent soil moisture
  57    CONTINUE
 

C
C .... ADDITIONAL CALCULATIONS FOR EXTENDED SEDIMENT MODEL
C
      WRITE(2,1040)
      READ(1,1050)NPART,NWASH
!WB	NPART = # of particle size classes, NWASH = # of washload particles
      WRITE(2,1060)NPART,NWASH
      NWASH1=NWASH+1
      IF(NWASH.EQ.NPART) NWASH1=1
      VISCOS=1./VISCOS
!WB	VISCOS = kinematic viscosity of water (m2/s)
      READ(1,1070)(DIAMM(IC),SG(IC),FV(IC),IC=1,NPART)
!WB	DIAMM = particle diameter (MM), SG = spec grav, FV = fall velocity
      DO 70 IC=1,NPART
	IF(UNITS.EQ.UN) GO TO 61
	DIA(IC)=DIAMM(IC)*.0032808399
!WB	particle diameter (m)
	GO TO 62
   61   DIA(IC)=DIAMM(IC)*0.001
   62   IF(FV(IC).LE.0.00000001) GO TO 63
	GO TO 70
C
CC.........CALCULATION OF PARTICLE FALL VELOCITIES..........
C
   63   FV(IC)=AGRAV*(SG(IC)-1.)*VISCOS*DIA(IC)**2/18.
	X1=DIA(IC)*VISCOS
	REYN=FV(IC)*X1
!WB	particle reynold's #
	IF(REYN.LE.0.1) GO TO 70
	X2=DSQRT(4.*AGRAV*(SG(IC)-1.)*DIA(IC)/3.)
	DO 69 I=1,10
	  CD=24./REYN+3./DSQRT(REYN)+.34
!WB	CD = drag coeff. used in determining particle fall velocity
	  FV(IC)=X2/DSQRT(CD)
	  REYN=FV(IC)*X1
   69   CONTINUE
   70 CONTINUE
C
CC.........CALCULATION OF EQUIVALENT SAND DIAMETERS.........
C
      DO 78 IC=1,NPART
	IF(SG(IC).GT.2.645) GO TO 77
!WB	if spec gravity of particle size gt 2.645
	X4=FV(IC)*VISCOS
!WB	X4 = fall velocity * kin viscos of water
	DS=DSQRT(10.90909091*FV(IC)/(AGRAV*VISCOS))
!WB	sand diameter? because its not the rate of sed inflow
	REYN=X4*DS
!WB	reynolds # = X4 * sand diameter
	IF(REYN.LE.0.1) GO TO 76
	X3=FV(IC)**2/(AGRAV*2.2)
	DO 75 II=1,20
	  DS=X3*(24./REYN+3./DSQRT(REYN)+.34)
	  REYN=X4*DS
   75   CONTINUE
   76   EQSDIA(IC)=DS
!WB	equivalent sand diameter of particle i (m)
	GO TO 78
   77   EQSDIA(IC)=DIA(IC)
   78 CONTINUE
      X3=304.8
      IF(UNITS.EQ.UN) X3=1000.
      DO 79 IC=1,NPART
   79 EDMM(IC)=EQSDIA(IC)*X3
      WRITE(2,1080)PP(IT+4)
      WRITE(2,1090)(IC,DIAMM(IC),EDMM(IC),SG(IC),FV(IC),IC=1,NPART)
      WRITE(2,1100)
      DO 85 J=1,ISR
      READ(1,1110)(F(J,I),I=1,NPART)
!WB	fraction of particles of type i in original soil
  85  WRITE(2,1120)J,(F(J,I),I=1,NPART)
 
**********************************************************************
* INPUT SPECIFIC SURFACE AREA FOR PHOSPHORUS COMPONENT
* SPECIFIC SURFACE AREA MUST BE IN M^2/G
 
       WRITE(2,*)'SPECIFIC AREA FOR DIFFERENT PARTICLE SIZE'
       DO 86 J=1,ISR
	 IF (URBSOIL(J).EQ.1) THEN
		WRITE(2,1111) 0.,(SSA(J,I),I=1,NPART)
		GO TO 86
	 END IF
       READ(1,1111) SSAT(J),(SSA(J,I),I=1,NPART)
!WB	SSA = spec surf area for part class i for soil type j, SSAT = total
!WB	SSA for soil type j
       WRITE(2,1111) SSAT(J),(SSA(J,I),I=1,NPART)
 86    CONTINUE
 
       DO 81 J=1,ISR
       SASA=0.
!WB	SASA = unknown; rz this is the sum of surface area for each particle size class;
!RZ	assuming you determine your fraction of soil in each type correctly (i.e., does 
!RZ	not add up to something other than 1), this will be the same as SSAT.
	IF (URBSOIL(J).EQ.1) THEN
		GO TO 81
	END IF
	DO 88 I=1,NPART
	  SSA(J,I)=SSA(J,I)*F(J,I)
	  SASA=SASA+SSA(J,I)
 88     CONTINUE
	DO 82 I=1,NPART
	 SSA(J,I)=SSA(J,I)*SSAT(J)/SASA
 82     CONTINUE
 81    CONTINUE
**********************************************************************
 
C
C **** NRZ 9/12/94
C **** MODIFY INPUT LINE TO INCLUDE FERTILIZER FILE FLAG
C **** INPUT DRAINAGE AND GROUNDWATER CONSTANTS.
C
C     READ (1,980) NEXP,DC,GRF
      READ (1,980) NEXP,DC,GRF,IFERT,IIRRI
!WB	NEXP = ? (rwz:called drainage exponent; see Huggins&Monke 1966 p44) 
!RWZ	nexp appears to be a relic from the original version of answers, and
!RWZ  is no longer used in the current model,
!WB	DC = tile drainage coefficient, GRF = fractional
!WB	rate of baseflow release, IFERT = fert app flag, IIRRI = irrigation appl. flag
      IF (PRI.EQ.PR) WRITE (2,990) NEXP,DC,PP(IT+1),GRF
      IF (IFERT.EQ.1) OPEN (9,FILE='FERTILIZER.INP',STATUS='OLD')
	IF (IIRRI.EQ.1) OPEN (378,FILE='IRRIGATION.INP',STATUS='OLD')
C **** NRZ 9/12/94
** NRZ (8/29/94)
** ADDED IMPOUNDMENT INPUT STATEMENT
C
C **** INPUT IMPOUNDMENT DATA

      READ (1,981) NIMP
      WRITE(2,*) 'THE NUMBER OF IMPOUNDMENTS IS ',NIMP
      IF (NIMP.GT.0) THEN
        READ(1,*)
        READ(1,*)
      ENDIF
      DO 12000 NCHC=1,NIMP
        READ (1,982) NCH,BASE(NCH),WIDTH(NCH),SLOPE(NCH),ORIF(NCH),
     &  MAXHGT(NCH),CI(NCH),FI(NCH),AFWEV
!WB	See the input variable guide for a description of this subroutine.
12000 CONTINUE

** NRZ (8/29/94)

C
C **** INPUT CROP AND SURFACE ROUGHNESS DATA.
C
      READ (1,810) TEST
      IF (TEST.NE.C4) GO TO 580
!WB	C4 = ' SU' 
      READ (1,940) ICR
      WRITE(2,*) 'THE NUMBER OF CROPS IS',ICR
!rz	URBAN IDEA - INSERT A READ HERE TO DETERMINE THE NUMBER OF URBAN 
!RZ	CROP TYPES; THEN FOR THOSE FIRST CROP TYPES IN THE 87 LOOP JUMP TO
!RZ	THE URBAN SUBROUTINE
	READ (1,940) URBCR
!RZ	read the number of urban crops
	WRITE (2,*) 'THE NUMBER OF URBAN CROPS IS', URBCR
      IF (PRI.EQ.PR) WRITE (2,950) PP(IT+1),PP(IT+1),PP(IT+1)
      IF (ICR.GT.20) GO TO 550
      DO 87 I=1,ICR
      CBAR(I)=0.
!WB	percent of watershed in crop i
!RZ	IF THERE IS AN URBAN CROP, IT HAPPENS FIRST; DO A SEPARATE READ IN THE URBAN SUBROUTINE
!RZ	FOR THE URBAN CROP
	IF (I.LE.URBCR) THEN
		URBAN = 2
		IDUMMY=0
		DUMMY=0.
		CALL URBANIZED(URBAN,IDUMMY,IDUMMY,A1DUMMY,IDUMMY,IDUMMY,IDUMM
	1Y,IDUMMY,IDUMMY,ISR,PR,I,CDUMMY,A3DUMMY,A5DUMMY,DUMMY,DUMMY,DUMMY,
     2DUMMY,DUMMY,IDUMMY,IDUMMY,A2DUMMY,A2DUMMY,CROP)
		RN(I)=MNTOT(I)
!RZ WB	RN(I) = manning's n for surface type I
!RZ	SET HERE BECAUSE RN IS NOT A COMMON VARIABLE AND IS NEEDED LATER
		GO TO 87
	END IF
      READ (1,620) CROP(I,1),CROP(I,2),PIT(1,I),PER(I),ROUGH(I),HU(I),
     1DIRM(I)
!WB	CROP(I,1),CROP(I,2) = alphanumeric name of crop i
!WB	PIT(1,I) = interception storage for cover for surface type i (mm)
!WB	PER(I) = fraction of element area covered by foliage for surface type i
!WB	ROUGH(I) = surface depth-storage parameter for surface i
!WB	HU(I) = maximum height differential on soil surface (mm)
!WB	DIRM(I) = maximum physical retention depth for cropping practice i
      DIRM2(I)=DIRM(I)
!WB	max physical ret depth for crop practice i = same
      READ(1,623) AC(I),AO(I),BC(I),BO(I),INRCOVI(I),INRCOVF(I),
	1LIVEROOT(I),DDROOTI(I),DDROOTF(I)
!WB	AC(I) = canopy area (%)
!WB	AO(I) = area outside canopy (%)
!WB	BC(I) = bare area under canopy (%)
!WB	BO(I) = bare area outside canopy (%)
!WB	INRCOVI(I) = INTERRILL AREA COVERED BY GROUND COVER AT BEG OF SEASON
!WB	INRCOVF(I)=INTERRILL AREA COVERED BY GROUND COVER AT END OF SEASON
!WB	LIVEROOT(I)=MASS OF LIVE ROOTS IN THE 0 TO 0.15 M OF THE SOIL SURFACE
!WB	IN KG/M^2
!WB	DDROOTI(I) = MASS OF DEAD ROOTS AT THE BEG OF THE COVER PERIOD IN THE
!WB	0 TO 0.15 M OF THE SOIL	SURFACE IN KG/M^2
!WB	DDROOTF(I) = MASS OF DEAD ROOTS AT THE END OF THE COVER PERIOD IN THE
!WB	0 TO 0.15 M OF THE SOIL SURFACE.
      IF (DDROOTI(I).LT.DDROOTF(I)) THEN
	WRITE (*,1962) DDROOTI(I),DDROOTF(I)
	PAUSE
	STOP
	ENDIF
	INRCOVI(I)=INRCOVI(I)/100.
	INRCOVF(I)=INRCOVF(I)/100.
	READ(1,624) (LAI(I,I111),I111=1,11)
!WB	leaf area index
      READ(1,625) DATPLA(I),DATHAR(I),CP1(I),CP2(I),DMY(I),YP(I)
     & ,ROTMAX(I),RLAIMX(I)
!WB	DATPLA(I) = planting date
!WB	DATHAR(I) = harvest date
!WB	CP1(I) = exponent for nitrogen content
!WB	CP2(I) = exponent for nitrogen content
!WB	DMY(I) = dry matter ratio
!WB	YP(I) = yield potential (kg/ha)
!WB	ROTMAX(I) = maximum rooting depth for crop i (mm)
!WB	RLAIMX(I) = maximum lai

!WB	***** READ IN THE PARAMETERS FOR THE NEW SED ROUTINE *********
	READ(1,626) RANROU(I),BR(I),MAXPLHGT(I),GROWFACT(I),RILLSPC(I),
	1MNSOIL(I),MNTOT(I),NOTILL(I),NOEROS(I)
	
!WB	RANROU=RANDOM ROUGHNESS OF THE SOIL SURFACE(MM), BR=BURIED RESIDUE
!WB	W/IN 0 TO 0.15 M OF THE SOIL SURFACE (KG/HA), MAXPLHGT=MAXIMUM
!WB	PLANT CANOPY HEIGHT (M), GROWFACT=FRACTION OF GROWTH PERIOD 
!WB	REQUIRED FOR THIS CROP TO REACH MATURITY, RILLSPC=RILL SPACING
!WB   (M OR M/RILL WHICH SAYS M B/T RILLS), MNSOIL=MANNING'S N
!WB   FRICTION FACTOR FOR THE	BARE SOIL, MNTOT=MANNING'S N FRICTION
!WB   FACTOR FOR THE SURFACE WITH COVER.  NOTILL=A TILLAGE FLAG THAT 
!WB	INDICATES THE CROP COVER IS A NO-TILL CROP.  THIS AFFECTS THE
!WB	RILL WIDTH CALCULATION.  NOEROS=A FLAG INDICATING THAT A CROP
!WB	IS A NON-ERODIBLE PRACTICE (I.E.-POND, COMMERCE)
	RN(I)=MNTOT(I)
!WB	RN(I) = manning's n for surface type 1, I MOVED THIS FROM WHERE
!WB	IT WAS READ ORIGINALLY DUE TO SOME LAST MINUTE CHANGES.

	RANROUM(I)=RANROU(I)/1000
!WB	CONVERT RANDOM ROUGHNESS TO M FROM MM
	DO K=1,4
	READ (1,629) ATMDEP(I,K), TKNDEP(I,K), AMNDEP(I,K), SEPDEP(I,K), 
	1NO3ZDEP(I,K), WATNHDEP(I,K), SOLUBPDEP(I,K), TSSDEP(I,K)
	END DO

!WB	ERROR CHECKS
	IF (MNSOIL(I).GT.MNTOT(I)) THEN
	WRITE (2,1950) MNSOIL(I),MNTOT(I),I 
	WRITE (*,1950) MNSOIL(I),MNTOT(I),I
 	STOP
	ENDIF
	IF (NOTILL(I).NE.0) THEN
	IF (NOTILL(I).NE.1) THEN
	WRITE (*,1952)
	WRITE (2,1952)
	PAUSE
	STOP
	ENDIF
	ENDIF
	IF (NOEROS(I).NE.0) THEN
	IF (NOEROS(I).NE.1) THEN
	WRITE (*,1954)
	WRITE (2,1954)
	PAUSE
	STOP
	ENDIF
	ENDIF
	IF (BR(I).GT.1) THEN
	WRITE (*,1956)
	WRITE (2,1956)
	PAUSE
	ENDIF
!WB	ERROR CHECKS
***********************************************************************
* COMPUTE A EFFECTIVE HYDRAULIC CONDUCTIVITY FOR EACH SOIL
* CROP COMBINATION)
 
****CANOPY FACTOR
	CF(I)=1.+AC(I)/(AC(I)+AO(I))
!WB	CF = 1+canopy area / (canopy area + area outside of canopy)
 
      DO 84 KKK=1,ISR
 
 
************************************
****EFFECTIVE HYDRAULIC CONDUCTIVITY
 
 
** SEARCHING FOR THE CORRECT HYDRAULIC CONDUCTIVITY
*************************************************************
***********************************************************
 
	KE(KKK,I)= KS(KKK)*
     &            ( CF(I)*(AC(I)/100.)
     &           *(BC(I)*CRC(KKK)/AC(I)+Z(KKK)*(1-BC(I)/AC(I)))
     &           +(AO(I)/100.)
     &           *(BO(I)*CRC(KKK)/AO(I)+Z(KKK)*(1-BO(I)/AO(I))))
*****************************************************************

 84   CONTINUE
 
      IF (ROUGH(I).GT.1.0.OR.ROUGH(I).LE.0.) GO TO 590
      IF (PRI.EQ.PR) WRITE (2,960) I,CROP(I,1),CROP(I,2),PIT(1,I),PER(I)
     1,ROUGH(I),HU(I),DIRM(I)

      
   87 CONTINUE
!WB   ******* PRINT SECTION FOR NEW SEDIMENT VARIABLES *******
      DO I=1,ICR
	IF (PRI.EQ.PR) THEN
	IF (I.EQ.1) WRITE (2,975)
	WRITE (2,976) I,RANROU(I),BR(I),MAXPLHGT(I),GROWFACT(I)
     1,RILLSPC(I)
	END IF
	END DO
	DO I=1,ICR
	IF (PRI.EQ.PR) THEN
	IF (I.EQ.1) WRITE (2,977)
	WRITE (2,978) I,MNSOIL(I),MNTOT(I),NOTILL(I),NOEROS(I)
	ENDIF
	END DO
	DO I=1,ICR
	IF (PRI.EQ.PR) THEN
	IF (I.EQ.1) WRITE (2,1958)
	WRITE (2,1960) I,INRCOVI(I),INRCOVF(I),LIVEROOT(I),DDROOTI(I),
	1DDROOTF(I)
	ENDIF
	END DO
	WRITE (2,*)
!WB ***** END OF PRINT SECTION FOR NEW SEDIMENT VARIABLES *****

C **** RWC
C      INPUT ROTATION DESCRIPTION
       READ(1,940) IROT1
       DO 89 I=1,IROT1
        WRITE(2,*) 'READING IN THE ROTATION PARAMETERS FOR',I

C **** NRZ 7/20/95
C **** MODIFIED ROTATION INPUT TO ALLOW 8 ADDITIONAL END DATES
C	READ(1,1800) IROT(I,1),(IROT(I,I1111),I1111=2,41)
!TMN  MODIFIED ROTATION INPUT TO ALLOW FOR UP TO 644 END DATES
!TMN  THIS WILL GIVE UP TO 107 SIMULATION YEARS WITH 3 END DATES PER YEAR
! 	READ(1,1800) IROT(I,1),(IROT(I,I1111),I1111=2,57)
      READ(1,1800) IROT(I,1),(IROT(I,I1111),I1111=2,644)

   89  CONTINUE

C
C **** INPUT CHANNEL DATA.
C
      READ (1,810) TEST
      IF (TEST.EQ.C6) GO TO 80
!WB	 '  EL'
!WB	if there are no channel elements, then they are overland 
!WB	elements, jump down to 80 to read those
      IF (TEST.NE.C5) GO TO 580
!WB	 '  CH', if the flag doesn't equal el or ch, then something
!WB	is wrong, so jump down and stop the program
C **** NRZ 9/11/94
C **** ADD INPUT FOR NUMBER OF CHANNEL NETWORKS

      READ (1,920) NCHAN

C **** NRZ 9/11/94

      READ (1,920) M
!WB	M = # of types of channels 
	NOOFCHAN=M
      IF (M.GT.30) GO TO 510
!WB	if there are more than 10 types of channels, then jump down 
!WB	and stop the program !!!!!shouldn't there be only 9 channel
!WB	types?
      READ (1,760) (WID(I),MNCS(I),CN(I),IMPERM(I),ARMOUR(I),I=1,M)
!WB	WID = width of channel type, CN = manning's n for channel type i
!WB	MNCS=MANNING'S N FRICTION FACTOR FOR BARE SOIL FOR THE CHANNEL,
!WB	MNCT=MANNING'S N FF FOR SOIL+VEGETATION IN CHANNEL, IMPERM=
!WB	DEPTH TO IMPERMEABLE LAYER IN THE CHANNEL, ARMOUR = FRACTION
!WB	OF CHANNEL SOIL THAT IS UNERODIBLE, OR EROSION RESISTANT
	
	DO I=1,M
	MNCT(I)=CN(I)
!WB	SET THE MANNING'S N CHANNEL SOIL + VEG VARIABLE EQUAL TO CN (SAME)
	ENDDO
	IF (MNCS(I).GT.MNCT(I)) THEN
	WRITE (*,1950) MNCS(I),MNCT(I),'CHAN ',I
	STOP
	ENDIF
	IF (PRI.EQ.PR) WRITE (2,650) PP(IT+4),(I,WID(I),MNCS(I),
	1MNCT(I),IMPERM(I),ARMOUR(I),I=1,M)
C
C **** INPUT OUTFLOW ELEMENT POSITION.
C
      READ (1,820) TEST,TITLE
!WB	why read test and title of the farm
!RWZ	test to determine you're in the right place; title
!RWZ	reads the title "baseline sensitivity analysis" for the output file
      IF (TEST.NE.C6) GO TO 580
!WB	C6 = '  EL'
C **** NRZ 9/11/94
 
C **** OPEN A SCRATCH OUTPUT FILE FOR EACH CHANNEL OUTLET AND THE "LEAKY"
C **** CELLS
      
      DO 91 NCH=1,NCHAN+1
	NUNIT=10+NCH
	IF (NCH.LE.NCHAN) THEN
	  WRITE(OUTFIL(NCH),301) 'CHANNEL',NCH,'.OUT'
  301     FORMAT (A7,I1,A4)
	ELSE
	  WRITE(OUTFIL(NCH),302) 'LEAKYCELL.OUT'
  302     FORMAT (A13)
	ENDIF
	OPEN (NUNIT,FILE=OUTFIL(NCH))
!WB	I feel as though this should be above the if then loop, but 
!WB	this seems to work.  Something to look into.  I commented this
!WB	line out and the program wrote the proper file anyway.
!RZ	No, the IF THEN sets the name of the output file; then the open
!RZ	statement actually opens a file with that name.  Just like is done
!RZ	in the ascii builder.
   91 CONTINUE
 
C **** MODIFY INPUT LINE TO ACCEPT MULTIPLE OUTLETS

C  80 READ (1,610) DX,NIOUT,NJOUT
C *** NRZ
C *** The length of the side of each square element is DX
   80 READ (1,609) DX
      READ (1,610) (NIOUT(NCH),NJOUT(NCH),NCELLS(NCH),NCH=1,NCHAN)
!WB	NIOUT = row # of catchment outflow element, NJOUT = column #
!WB	of outlet cell for channel network i, NCELLS = # of cells in 
!WB	channel network i (entered as input)

C **** NRZ 9/11/94
C
C **** EVALUATE CONSTANTS FOR USE WITH METRIC OR ENGLISH UNITS.
C **** METRIC UNITS.
C
      DX2=DX*DX

C *** NRZ
C *** The area of each cell (in ha) is computed here
      AREA2=DX2/1.E+4
!WB	area2 is supposed to be element or channel area, but instead it
!WB	looks like area in ha
      CU1=DX2/1.E+3
!WB	conversion from mm to m3
      CU2=DT/DX2*500.
!WB	conversion for twice m3?, looks like time increment / (cell
!WB	size in m2 * 500)
      CU=DX2/3.6E+6
!WB	conv from mm/h to m3/s? = cell area in m2 / 3.6E6
      CONST=DX/(2./DT*DX2)**1.6667
!WB	flow depth units conversion factor = cell width / (2./cell 
!WB	width * cell area in m2) ^1.6667
      IF (UNITS.EQ.UN) GO TO 90
!WB	jump over the next section if the units are metric
C
C **** CONVERT TO ENGLISH UNITS.
C
      CU1=CU1/.012
      CU=CU/.012
      CU2=CU2*.012
      CONST=1.486*CONST
      AREA2=AREA2/4.3560
C
C **** INPUT INDIVIDUAL ELEMENT TOPOGRAPHICAL DATA.
C
* CHANGING ORIGINAL VALUE OF NPAR AND NPAR2 FROM 13 & 11 TO 20,18
  90  NPAR=26
      NPAR2=24
!WB	NPAR and NPAR2 are counters for the # of parameters, and are 
!WB	used for data manipulation
C
C **** CHANGE DIMENSION STATEMENT BELOW IF JMAX IS CHANGED.
C
      JMAX=300
!WB	max # of columns
      NMAX=35000
!WB   max # of cells, overland flow + channel segments
      N=0
!WB	probably a counter reset
      II=0
!WB	II is a counter / place holder
      SCMIN=9.
!WB	minimum slope value, probably in channels
      SCMAX=0.
!WB	max value of slope, probably in channels
      SCBAR=0.
!WB	average value of slope, probably in channels
      SMIN=9.
!WB	min elemental and channel slope in watershed
      SMAX=0.
!WB	final accum sed loss from catchment (kg)? maybe max slope
      SBAR=0.
!WB	average catchment slope
      TBAR=0.
!WB	percent of elements tiled
      DO 100 J=1,JMAX
  100 IEL(3,J,3)=0
!WB	make sure you reset the last element flag of element counter flag
!WB	to 0 for all elements
C
C **** INPUT FIRST ROW OF ELEMENTAL DATA.
C
* ADDED PHOSPHORUS INPUT ITEMP(12,13)
 
      READ (1,680) (ITEMP(K),K=1,7),(ITEMPC(L),L=1,2),(ITEMP(K),K=8,16)
      READ (1,681) (ITEMP(K),K=17,24) !RZ URBAN: add 21, URB(I) flag
!WB	ITEMP(1) = element #
!WB	ITEMP(2) = column # of last watershed element in the row
!WB   ITEMP(3) = 9 in this column indicates last element in list
!WB   ITEMP(4) = slope steepness in tenths of a percent (2.9% = 29)
!WB   ITEMP(5) = direction of steepest slope, in c!WB degrees from r-horizon
!WB   ITEMP(6) = channel network designator AND SOIL TYPE
!WB   ITEMP(7) = I1 = rotation # 
!WB   ITEMPC(1) = rain gauge designator
!WB   ITEMPC(2) = tile drainage designator
!WB   ITEMP(8) = SS(I) = channel slope
!WB   ITEMP(9) = PRACT = # of structural practice type (BMP practice?)
!WB   ITEMP(10) = TRAP = trapping efficiency of ponds / bmps
!WB   ITEMP(11) = CHAN = channel # perhaps?
!WB   ITEMP(12) = SORGP = soil organic P (kg/ha)
!WB   ITEMP(13) = EDI = effective depth of interaction
!WB   ITEMP(14) = PMINP = active mineral P (kg/ha)
!WB   ITEMP(15) = SOILP = stable soil P (kg/ha)
!WB   ITEMP(16) = PLAB = labile P (kg/ha)
!WB   ITEMP(17) = POTMIN = potentially mineralizable soil N (kg/ha)
!WB   ITEMP(18) = AMON = total NH4 present in soil (kg/ha)
!WB   ITEMP(19) = SOILN = stable soil organic N (kg/ha)
!WB   ITEMP(20) = SZNO3 = nitrate present in soil (kg/ha) 
!RZ	ITEMP(21) = URB = urban cell flag
!RZ	ITEMP(22) = STORM = stormwater drain flag
!RZ	ITEMP(23) = DRDEST = stormwater drain destination cell
!RZ	ITEMP(24) = CURB = curb flag
C **** NRZ 9/11/94
C **** MODIFIED CALL FOR MULTIPLE OUTLETS
!WB	the input cell data is read in to the itemp arrays, and then
!WB	you jump down to the subroutine relem and roll 2 into 1 and
!WB	then 3 into 2.  Then, in relem, you move the itemp array 
!WB	elements into the third row.  Then you are returned.  You go
!WB	through this twice because the first time you roll the data
!WB	into lines 2 and 1 when they are originally empty.  Then you
!WB	go through again, roll 2 into 1, 3 into 2 and then itemp into
!WB	line 3.  In relem, you read all the column elements in a row
!WB	before being returned to the xdata subroutine.
!WB	Then you can do calculations (2&3 have data in them).
!RZ	ACTUALLY, 1 HAS PREVIOUS ROW DATA, 2 HAS CURRENT ROW DATA, AND 
!RZ	 3 HAS NEXT ROW DATA
!WB   The elements of IEL
!WB	are put in as (i,j,k) where i = row #, j = column #, 
!WB	k = parameter value, except for 3 (i,j,3) which is reset
!WB	to an element 3 counter, and (i,1,2) which is set to
!WB   the column # of the last element in that row

      CALL RELEM (IEL,ITEMP,N,ISR,ICR,NMAX,JMAX,NPAR,IELC,ITEMPC,
     1NPAR2)
C
C **** PUT WATERSHED ELEMENTAL DATA INTO SINGLE DIMENSIONED ARRAYS.
C

C **** MODIFIED CALL FOR MULTIPLE OUTLETS

  110 CALL RELEM (IEL,ITEMP,N,ISR,ICR,NMAX,JMAX,NPAR,IELC,ITEMPC,
     1NPAR2)
C 110 CALL RELEM (IEL,ITEMP,N,MOUT,NIOUT,NJOUT,ISR,ICR,NMAX,JMAX,NPAR,
C    1IELC,ITEMPC,NPAR2)

C **** NRZ 9/11/94
      JS=IEL(2,1,2)
!WB	column # for last column on current element row which is set in 
!WB	the relem subroutine.  
!WB*************************************************
!WB	beginning of do loop for the current row's calculations
!WB*************************************************
      DO 270 J=1,JS
!WB	do this for the # of columns?
      JM1=J-1
      I=IEL(2,J,3)
!WB	I is reset to an element # counter (it holds the # counter)
!WB	in the relem subroutine.  Also, mout(nch) is set equal to niout
!WB	and njout in the relem subroutine.
      IF (I.EQ.0) GO TO 270
!WB	if the element counter = 0, jump out of this loop, but I'm
!WB	not sure when this would be true.
      SL(I)=DBLE(IEL(2,J,4))/1000.
!WB	overland element slope
      IF (SL(I).LT.SMIN) SMIN=SL(I)
      IF (SL(I).GT.SMAX) SMAX=SL(I)
      SBAR=SBAR+SL(I)

C **** NRZ 9/5/94
C **** COMPUTE CHANNEL NETWORK DESIGNATOR AND CHANNEL WIDTH NUMBER
C **** FROM 5-DIGIT NUMBER IEL(2,J,6)

      CHNUM(I)=IEL(2,J,6)/1000000
!WB	chnum is the channel # designator
      CHAN(I)=MOD(IEL(2,J,6),1000000)/10000
!WB	chan(I) = (IEL(2,J,6)-int(IEL(2,J,6)/1000000)*1000000)/10000
!WB	so this is the 3rd number in decimal form of the channel #
!WB	designator (for ex: CHAN(I) of 10201 is 2.01), CHAN(I) is 
!WB	the width designator for the channel (it's a type 1 or 2, etc)
	IF (CHAN(I).GT.0) THEN
      CHNSL(I)=(MOD(MOD(IEL(2,J,6),1000000),10000))/100
!WB	CHNSL(I)= SOIL TYPE # OF CHANNEL CELL
	IF (CHNSL(I).GT.ISR) THEN
	WRITE (2,865) CHNSL(I),I,ISR 
	WRITE (*,865) CHNSL(I),I,ISR 
	PAUSE
	STOP
	ENDIF
	ENDIF
C **** NRZ 9/5/94

      IF (CHAN(I).GT.30) WRITE (2,1020) CHAN(I),I
!WB	if the channel # is greater than 10, then write it
!WB	I feel like this should be an error statement, or should
!WB	do something aside from simply writing the cell width & #
      SS(I)=DBLE(IEL(2,J,8))/1000.
!WB	SS is channel slope / 1000
********************************************************************
* PUT PHOSPHORUS AND NITROGEN INPUT VALUE INTO DIMENSIONED ARRAYS
* P0SOIL=INITIAL PHOSPHORUS CONTENT OF SOIL
* EDI EFFECTIVE DEPTH OF INTERACTION
* INPUT ARE DONE IN KG/HA
* CONVERT EVERYTHING TO KG
********************************************************************
       CONFAY=DX*DX/10000.
!WB	confay = (area in ha)
       SORGP(I)=IEL(2,J,12)
!WB    SORGP = soil organic P (kg/ha)
       SORGP(I)=SORGP(I)*CONFAY
       EDI(I)=IEL(2,J,13)
!WB   ITEMP(13) = EDI = effective depth of interaction
       PMINP(I)=IEL(2,J,14)
!WB   ITEMP(14) = PMINP = active mineral P (kg/ha)
       PMINP(I)=PMINP(I)*CONFAY
       SOILP(I)=IEL(2,J,15)
!WB   ITEMP(15) = SOILP = stable soil P (kg/ha)
       SOILP(I)=SOILP(I)*CONFAY
       PLAB(I)=IEL(2,J,16)
!WB   ITEMP(16) = PLAB = labile P (kg/ha)
       PLAB(I)=PLAB(I)*CONFAY
       POTMIN(I)=IEL(2,J,17)
!WB   ITEMP(17) = POTMIN = potentially mineralizable soil N (kg/ha)
       POTMIN(I)=POTMIN(I)*CONFAY
       AMON(I)=IEL(2,J,18)
!WB   ITEMP(18) = AMON = total NH4 present in soil (kg/ha)
       AMON(I)=AMON(I)*CONFAY
       SOILN(I)=IEL(2,J,19)
!WB   ITEMP(19) = SOILN = stable soil organic N (kg/ha)
       SOILN(I)=SOILN(I)*CONFAY
       SZNO3(I)=IEL(2,J,20)
!WB   ITEMP(20) = SZNO3 = nitrate present in soil (kg/ha) 
       SZNO3(I)=SZNO3(I)*CONFAY
	 URB(I)=IEL(2,J,21)
	 STORM(I)=IEL(2,J,22)
	 CURB(I)=IEL(2,J,24)
!RZ	URBAN:: above are flags for urban cells, stormwater drains, and curbs, respectively
C
C **** IF CHANNEL SLOPE NOT SPECIFIED, ASSUME IT'S HALF OVERLAND SLOPE.
C
      IF (SS(I).LE.0.) SS(I)=.50*SL(I)
      TIAL(I)=0
!WB	tile drainage flag = false; rwz this is not a logical operator
      IF (IELC(2,J,2).NE.ISTL) GO TO 120
!WB	ISTL = 'TI' = IS TiLe
      TIAL(I)=256
!WB	this is supposed to be the tile drainage flag
      TBAR=TBAR+1.
!WB	TBAR = percent of elements tiled?
  120 M=DBLE(IEL(2,J,5))/90.+1.
!WB	the prev line reads the flow angle, divides it by 90 and adds 1,
!WB	and then rounds the number, it tells the quad #
      MM1=M-1
!WB	this is set up to tell how many quads come before M
C
C **** EVALUATE OUTFLOW PROPORTIONS TO ADJACENT COLUMN AND ROW ELEMENTS.
C
      ANG=(DBLE(IEL(2,J,5))-90.*DBLE(MM1))*.01745329
!WB	the ang calculates the angular difference from the nearest (previous)
!WB	horizontal or vertical axis, in rads (!RWZ .01745329 is pi/180)
      X=SIN(ANG)+COS(ANG)
!WB	not really sure what this is for yet
!WB	this is opposite/hyp + adj / hyp = opp+adj / (hyp)
      IX=CHAN(I)
!WB	IX is the width #
      IF (IX.EQ.0) GO TO 130
!WB	if the channel width/type is 0, go to 130
!WB	and skip over the channel conveyance calculations
C
C **** EVALUATE CONVEYANCE FOR CHANNEL ELEMENTS.
C
!WB	this section appears to create a separate counter that keeps
!WB	track of channel segments.  As this loop goes through performing
!WB	calculations, if there is a channel segment it is recorded here
!WB	and its width, slope (which may be a little awry), and 
!WB	conveyance are calculated (which uses the variable PIV).
      II=II+1
!WB	II appears to be a counter, and it only works if the element
!WB	has a channel element in it
	CHNUMBER(II)=CHNUM(I)
!WB	THIS DESIGNATES THAT THE CHANNEL DESIGNATOR # OF ELEMENT II IS EQUAL
!WB	TO THE CHANNEL DESIGNATOR # OF THE CURRENT ELEMENT.  THIS IS USED 
!WB	TO EXTRACT CWID,SS,PIV LATER.
      CHNSOIL(II)=CHNSL(I)
!WB	CHNSOIL(II)=CHANNEL SOIL TYPE
	CHNURB(II)=URB(I)
!RZ LOOK AT ME
	MNCHNSL(II)=MNCS(IX)
!WB	MNCHNSL=MANNING'S N FRIC FACT. FOR THIS CHANNEL SOIL, INPUT ABOVE
	MNCHNTOT(II)=MNCT(IX)
!WB	MNCHNTOT=MANNING'S N FRIC FACT. FOR THIS CHANNEL SOIL + VEG
	CWID(II)=WID(IX)
!WB	width of segment i = width of identifier IX
      ROCKBOT(II)=IMPERM(IX)
!WB	ROCKBOT = DEPTH TO IMPERMEABLE LAYER
	NOERODE(II)=ARMOUR(IX)
!WB	NOERODE = THE FRACTION OF THE CHANNEL CELL THAT IS NONERODIBLE,
!WB	OR ARMORED.  THIS IS USED TO ADJUST DETACHMENT IN THE CHANNEL
!WB	EROSION MODULE.
	SS(II)=SS(I)
!WB	channel slope for element is equal to slope for channel, I is 
!WB	reclassified to be the # of the element
      IF (SS(I).LT.SCMIN) SCMIN=SS(I)
      IF (SS(I).GT.SCMAX) SCMAX=SS(I)
!WB	these set the slope in the channel cell.
      SCBAR=SCBAR+SS(I)
!WB	average slope?
      PIV(II)=CONST/CN(IX)/X*(DX/WID(IX)/X)**0.6667*DSQRT(SS(I))
!WB	PIV is used to record conveyance = flow depth conversion / 
!WB	 (manning's N for channel width
!WB	 #) / (sin ang + cos ang) * (cell width / width / (sin ang + cos ang)
!WB	 ^0.6667*sqrt(element slope))
!RZ	In other parts of the program, PIV is the air-filled pore space; I think
!RZ	this calculation, which is similar to the conveyance calculation B(I) is 
!RZ	trying to somehow represent the open channel as an air-filled space that water
!RZ	can fill.
	CONSTHLD(II)=CONST
	XHOLD(II)=X
!WB	THE ABOVE VARIABLES ARE USED TO HOLD PLACES SO THAT CONVEYANCE
!WB	CAN BE CALCULATED FOR EACH TIME STEP WHEN ITS RAINING AND THE 
!WB	PROPER FLOW CAN BE EXTRACTED AND ADJUSTED FOR CHANNEL WIDENING
C
C **** NOW DETERMINE THE ELEMENT(S) THAT RECEIVE OUTFLOW FROM THE
C **** CURRENT ELEMENT.  NOTE:  IT IS LEGAL FOR AN ELEMENT WITH A
C **** SHADOW CHANNEL ELEMENT TO SHOW FLOW, AT THIS TEST POINT, THAT
C **** WOULD OTHERWISE BE OUTSIDE THE CATCHMENT.
C
C **** NRZ 9/11/94
C **** THIS SECTION HAS BEEN MODIFIED TO ACCEPT MULTIPLE OUTLETS
C **** LINE 130 FINDS THE APPROPRIATE ERROR CHECK BASED ON THE QUADRANT
C **** THAT THE OUTFLOW IS DIRECTED FROM

      NOUTFL=0 

130	IF (CALLBMP(I).EQ.1) THEN
		IF (SUB(POND(I)).EQ.1) THEN
		CONTINUE
		GOTO 220
	END IF
	END IF
!WB	flow out of watershed flag
      GO TO (140,150,150,140,140), M
!WB	If M is equal to 1,2,3,4,5 then the 
!WB	program is directed in that manner. 
!RZ	This determines which way the water flows in the row direction.  
  140 DO 141 NCH=1,NCHAN 
!WB	do from 1 to the # of channels
      IF (NOUTFL.EQ.1) GOTO 142
!WB	if the flow out of the watershed flag = true, then goto 142 
      IF ((J.GE.JMAX.OR.IEL(2,J+1,3).EQ.0).AND.CHAN(I).EQ.0.AND.
     1IEL(2,J,5).NE.270.AND.I.NE.MOUT(NCH)) THEN
!WB	if the column # of the element is ge the max # of columns or if
!WB	the element # of the next column equal 0 and the channel width
!WB	designator equals 0 and the flow direction doesn't equal 270 
!WB	and the element counter # ne the outlet cell of the channel.
!WB	shouldn't the first message be an error message?
!RZ	This isn't an error message, it just lets the user know that the
!RZ	flow is routed partially out of the watershed.  JMAX is the max
!RZ	number of columns, so if you have this condition, you are on the
!RZ	edge of the watershed; the 2,J+1,3 is the cell beside you, if
!RZ	this is zero, this also indicates that you are on the edge of
!RZ	the watershed (cells outside the watershed have zero for this
!RZ	value because there is an array slot for them never filled); 
!RZ	if iel(2,j,5) is 270, this indicates the flow is totally in
!RZ	the column direction (think quadrants) so later on RFL will
!RZ	be zero for this cell and the cell will not actually leak
	WRITE (2,770) IEL(2,J,1),J
!WB	write element # row, column, flows out of the watershed
	NOUTFL=1 
!WB	set the outflow flag equal to 1
      ENDIF
  141 CONTINUE
  142 NR(I)=IEL(2,J+1,3)
!WB	element # receiving flow from element i in the row direction
      IF ((J.GE.JMAX.OR.IEL(2,J+1,3).EQ.0).AND.(CHAN(I).NE.0).AND.
     1IEL(2,J,5).NE.270.AND.(IEL(2,J,5).NE.0).AND.(IEL(2,J,5).NE.360).
     2AND.I.NE.MOUT(NCH)) THEN
		IF(M.EQ.1) NR(I)=IEL(1,J+1,3)
		IF(M.EQ.4) NR(I)=IEL(3,J+1,3)
		DIAGFLAG(I)=1
	END IF
!RZ	The above if-then was added 4/22/2002 by Rebecca Zeckoski (also all
!RZ	corresponding segments after 152,162, and 172) to allow channel
!RZ	segments to exist on watershed boundaries.  As the user should know
!RZ	ANSWERS allows channel cells to flow diagonally; HOWEVER, previously
!RZ	the way this section worked a channel cell flowing diagonally on 
!RZ	a watershed boundary was termed a leaky cell and caused the program
!RZ	to crash, because the actual element receiving flow was not 
!RZ	designated (became NMAX+ISTRUC+2, really messed things up).  NOW,
!RZ	the program checks as before for a cell on the boundary,
!RZ	only this time, it is looking for a channel cell (chan(i).ne.0) and
!RZ	if the flow is exactly horizontal, an error is still given because
!RZ	realistically that should not happen, indicates an error in the input
!RZ	file possibly caused by not aligning the landuse and/or soils layers
!RZ	correctly in ArcView.
      NOUTFL=0
!WB	reset the outflow flag to 0
      GO TO (160,160,170,170,160), M
!WB	still not really sure what this is supposed to do
!RZ	I think it tells the program where to go based on the aspect of the 
!RZ	cell - i.e., which direction to route the flow in the column direction
!RZ	(think quadrants)
  150 DO 151 NCH=1,NCHAN
!WB	do from 1 to # of channels
      IF (NOUTFL.EQ.1) GOTO 152
!WB	if the outflow flag = 1, goto 152
	IF ((J.LE.1.OR.IEL(2,JM1,3).EQ.0).AND.CHAN(I).EQ.0.AND.
     1IEL(2,J,5).NE.90.AND.I.NE.MOUT(NCH)) THEN
!WB	if the column # of the current element le 1 or if the element
!WB   # of the previous column equals 0 and the channel width # equals
!WB	to 0 and the flow direction ne 90 and the element # ne the outlet
!RZ	see discussion at 140 for explanation
	WRITE (2,770) IEL(2,J,1),J
!WB	write that this cell flows out of the watershed at its row and
!WB	column
	NOUTFL=1
!WB	reset the leaky cell flag to 1 and continue
      ENDIF
  151 CONTINUE
  152 NR(I)=IEL(2,JM1,3)
!WB	the element # receiving flow from this cell in the row direction
!WB	is the previous cell #
	IF ((J.LE.1.OR.IEL(2,JM1,3).EQ.0).AND.(CHAN(I).NE.0).AND.
     1IEL(2,J,5).NE.90.AND.(IEL(2,J,5).NE.180).AND.I.NE.MOUT(NCH)) THEN
		IF (M.EQ.2) NR(I)=IEL(1,JM1,3)
		IF (M.EQ.3) NR(I)=IEL(3,JM1,3)
		DIAGFLAG(I)=1
	END IF
      GO TO (160,160,170,170,160), M
!WB	directing flow based on the value of M (1,2,3,4,5? or 1,2,3,4,0?)
!RWZ  it is 1,2,3,4,5; the quadrant #; only get a 5 if the flow angle
!RWZ	is 360 b/c of way quadrants are assigned (see line# 120 in this 
!RWZ	subroutine to see how M is calculated); quadrants 1,2,5 have positive
!RWZ	'y' values; quadrants 3 and 4 have negative 'y' values - sends the
!RWZ	program to the column routing portion of flow routine calculations
  160 DO 161 NCH=1,NCHAN
      IF (NOUTFL.EQ.1) GOTO 162
      IF (IEL(1,J,3).EQ.0.AND.IEL(2,J,5).NE.0.AND.CHAN(I).EQ.0.AND.
     1IEL(2,J,5).NE.360.AND.I.NE.MOUT(NCH)) THEN
!WB	if the element number of the cell above this one equals 0 and 
!WB	the slope ne 0 and channel width # equal 0 and slope ne 360 and
!WB	the element # ne the outlet of a channel
	WRITE (2,770) IEL(2,J,1),J
!WB	write that this cell leaks
	NOUTFL=1
      ENDIF
  161 CONTINUE
  162 NC(I)=IEL(1,J,3)
!WB	mark the element # receiving flow from this cell in the column 
!WB	direction equal to element # above it
      IF (IEL(1,J,3).EQ.0.AND.IEL(2,J,5).NE.0.AND.(CHAN(I).NE.0).AND.
     1IEL(2,J,5).NE.360.AND.(IEL(2,J,5).NE.0).AND.(IEL(2,J,5).NE.90).
     2AND.I.NE.MOUT(NCH)) THEN
		IF(M.EQ.1) NC(I)=IEL(1,J+1,3)
		IF(M.EQ.2) NC(I)=IEL(1,JM1,3)
		DIAGFLAG(I)=1
	END IF
      GO TO 180
!WB	jump over the next section
  170 DO 171 NCH=1,NCHAN
      IF (NOUTFL.EQ.1) GOTO 172
      IF (IEL(3,J,3).EQ.0.AND.IEL(2,J,5).NE.180.AND.I.NE.MOUT(NCH).AND.
     1CHAN(I).EQ.0) THEN
!WB	if the element # below this cell equals 0 and the slope doesn't
!WB	equal 180 and the element # ne a channel outlet and the chan width
!WB   # equals 0; 
!RZ	see discussion at 140; this time we are checking for all
!RZ	flow occurring in the row direction (iel(2,j,5)=180)
	WRITE (2,770) IEL(2,J,1),J
!WB	write that this cell leaks
	NOUTFL=1
!WB	set the outflow flag = 1
      ENDIF
  171 CONTINUE
C *** NRZ 9/11/94

  172 NC(I)=IEL(3,J,3)
!WB	route the flow in column direction to the cell below it
      IF (IEL(3,J,3).EQ.0.AND.IEL(2,J,5).NE.180.AND.(IEL(2,J,5).NE.270).
	1AND.I.NE.MOUT(NCH).AND.(CHAN(I).NE.0)) THEN
		IF(M.EQ.3) NC(I)=IEL(3,JM1,3)
		IF(M.EQ.4) NC(I)=IEL(3,J+1,3)
		DIAGFLAG(I)=1
	END IF

  180 IF (ANG.GT..78539816) GO TO 190
!WB	if angle from the axis is greater than 45 degrees
      RFL(I)=.5*SIN(ANG)/COS(ANG)
!WB	fraction of discharge from element flowing in row direction
!WB	is equal to 0.5 (opposite/hyp) / (adjacent/hyp) = 0.5 (opp/adj)
!WB	angles less than 45 degrees will always be within 45 degrees of
!WB	a major axis, on the plus side (ex: 90+45, 180+45, etc)
      GO TO 200
  190 RFL(I)=1.-.5*SIN(1.5707963-ANG)/COS(1.5707963-ANG)
!WB	fraction of discharge from element flowing in row direction = 
!WB	1-0.5*sin(90-ang)/cos(90-ang)
  200 GO TO (210,220,210,220,210), M
!WB	M is the quadrant #
  210 RFL(I)=1.-RFL(I)
!WB	fraction of flow in row direction equals 1-the above calculation
C
C **** ELIMINATE FALSE RECEIVING ELEMENTS WHICH MAY CAUSE OUT-OF-RANGE
C **** SUBSCRIPTS FOR SOME BOUNDARY ELEMENTS.
C

  220 IF (RFL(I).LT.0.01) NR(I)=NC(I)
!WB	if the fraction of discharge from element in row direction is 
!WB	less than 0.01, then the number of the element receiving flow in
!WB	the row direction is equal to the number of the element receiving
!WB	flow in the column direction
      IF (RFL(I).GT.0.99) NC(I)=NR(I)
!WB	similar to above, but other direction


!RZ	CALL THE URBANIZED SUBROUTINE IF THE URBAN W/CURBS FLAG IS TRIGGERED
!RZ	OR IF THE STORMWATER DRAIN FLAG IS TRIGGERED
	IF ((IEL(2,J,22).EQ.1).OR.(IEL(2,J,24).EQ.1)) THEN
	URBAN = 3
	IDUMMY=0
	DUMMY=0.
	CALL URBANIZED(URBAN,J,JM1,IEL,JMAX,NPAR2,ISTRUC,IDUMMY,
	1IDUMMY,IDUMMY,CDUMMY,I,CDUMMY,A3DUMMY,IELC,DUMMY,DUMMY,DUMMY,DUMMY
	1,DUMMY,IDUMMY,IDUMMY,LCC,LCR,CROP)
	END IF
C
C **** "LEAKY" ELEMENTS (THOSE WITH PARTIAL FLOW OUTSIDE THE WATERSHED)
C **** MUST DIVERT THAT PARTIAL FLOW INTO A SPECIAL PSUEDO ELEMENT.
C
C **** NRZ 9/11/94
C **** MODIFY CHECK FOR ALL OUTLETS

      DO 223 NCH=1,NCHAN
	IF (NC(I).GT.0.OR.I.EQ.MOUT(NCH)) GO TO 230
!WB	if the number of element receiving flow from this element in the 
!WB	column direction gt 0 or the element # is a an outlet, goto 230.
!WB	This says that the element isn't a leaky element or it's a 
!WB	channel outlet.
  223 CONTINUE
C
C **** THIS ELEMENT LEAKS, DIVERT IT INTO SPECIAL "BOTTOMLESS PIT".
C **** MARK THIS CELL AS LEAKY IN THE COLUMN DIRECTION WITH FLAG ARRAY 
C **** LCC

       NC(I)=NMAX+ISTRUC+2
!WB	the element # receiving flow from this element is equal to the 
!WB	max # of cells + # of structures + 2
!WB	shouldn't this be equal to NMAX + ISTRUC + NCHAN + 2 ?
!RZ	NO - NMAX is the maximum number of POSSIBLE cells (35000) - this 
!RZ	includes overland flow and channel cells.
!RZ	On further reflection - there is a discrepancy in the definition
!RZ	of NMAX and NCHAN in the program.  So this may or may not be correct.
       LCC(I)=1      
!WB	LCC = flag indicating cell leaks
!RZ	Leaky Cell Column
C
C **** ADD TO TOTAL NON-CONTRIBUTING AREA.
C
       OUTSID=OUTSID+1.-RFL(I)
!WB	the flow to outside the watershed = same + column flow from this 
!WB	element
C **** NRZ
C **** MODIFY CHECK FOR ALL OUTLETS
C  230 IF (NR(I).GT.0.OR.I.EQ.MOUT) GO TO 240
  230 DO 233 NCH=1,NCHAN
	IF (NR(I).GT.0.OR.I.EQ.MOUT(NCH)) GO TO 240
!WB	if the element # receiving flow from this element in the row 
!WB	direction is gt 0 or the element # is equal to a channel outlet
!WB	this and the above statement say that if the receiving element
!WB	is numbered 0 and is not a channel outlet then its a leaky cell
  233 CONTINUE

C **** NRZ 
C **** MARK THIS CELL AS LEAKY IN THE ROW DIRECTION WITH FLAG ARRAY 
C **** LCR
C
      NR(I)=NMAX+ISTRUC+2
!WB	the element # receiving flow in the row direction is equal to 
!WB	the max # of overland cells+# of structures+2
!WB	shouldn't this equal NMAX + ISTRUC + NCHAN + 2 ?
!RZ	NO-NMAX is the maximum number of POSSIBLE cells - 35000 - which 
!RZ	includes overland flow and channel cells
!RZ	On further reflection - there is a discrepancy in the definition
!RZ	of NMAX and NCHAN in the program.  So this may or may not be correct.
      LCR(I)=1
!WB	flag it as leaky in the row direction
!RZ	Leaky Cell Row
      OUTSID=OUTSID+RFL(I)
!WB	add its contribution to flow outside the watershed
C **** NRZ 9/15/94
C
C **** GET CROP/MGMT NUMBER.
C
  240 I1=IEL(2,J,7)
!WB	I1 is the rotation #
      CBAR(I1)=CBAR(I1)+1.
!WB	CBAR is supposed to be percent of watershed in crop i
!WB	Each time that you go through this loop, you add 1 (a cell)
!WB	of each crop type to the percent of watershed in crop i.
C
C **** PUT CROP/MANAGEMENT NUMBER IN LOW BYTE AND SOIL TYPE NUMBER IN
C **** NEXT BYTE OF (SOIL:SUR).
C **** NRZ 3/26/95
C **** CROP/MANAGEMENT NUMBER IS THE ROTATION NUMBER - NOT CROP NUMBER
C
C **** NRZ 9/5/94
C **** DIVIDE IEL(2,J,6) BY 10000 TO ACCOUNT FOR ADDITION OF CHANNEL 
C **** NETWORK DESIGNATOR

C     K=MOD(IEL(2,J,6),100)
      K=MOD(MOD(MOD(IEL(2,J,6),1000000),10000),100)
!WB	K = SOIL TYPE # OF OVERLAND FLOW CELL
C **** NRZ 9/5/94

      SPER(K)=SPER(K)+1.
!WB	steady state infiltration rate for the soil type = same +1
!WB	so every time you go through and this soil type is present,
!WB	you add 1 to that value.  Maybe its a percent of the
!WB	watershed with that ss infil rate?
!RZ	I believe this is wrong.  I think SPER is a counter to tell how many cells
!RZ	have a particular soil type.  Here SPER is incremented each time a cell of each 
!RZ	particular type comes along.  SPER stands for Soil PERcent.
      SOIL(I)=(K*256)+I1
!WB	soil type for element i = (soil type # * 256) + rot #
C **** NRZ 3/26/95
C **** FAYCAL MADE THIS CHANGE, THIS IS MY COMMENT
C **** IROT(I1,2) IS THE CROP # FOR THE FIRST CROP IN ROTATION I1
!WB	CORRECT COVER CHOSEN IN MAIN ROUTINE
*     SUR(I)=(K*256)+IROT(1,2)
      SUR(I)=I1*256+IROT(I1,2)
!WB   surface type on element i = (rot # * 256) + first crop in rot I1
C **** NRZ 3/26/95

!RZ	URBAN:::ASM AND FCAP ARE NOT DEFINED FOR URBAN SOIL TYPES
	IF (URBSOIL(K).EQ.1) GO TO 249
      ASMBAR=ASMBAR+ASM(K)
!WB	average ASM = same + asm of soil type #
      FPBAR=FPBAR+FCAP(K)
!WB	the variable list says that this isn't used
!RZ	URBAN
249	CONTINUE
C **** NRZ 8/5/95
C **** RN(I1) SHOULD BE MANNING'S N FOR THE CROP # OF THE CROP IN THE CURRENT
C **** ROTATION.  AS CODED BEFORE, IT WAS MANNING'S N FOR THE ROTATION #, WHICH
C **** MAY NOT HAVE BEEN DEFINED IF THERE WERE MORE ROTATIONS THAN CROPS.
!WB	actually, RN(IROT(I1,2)) is manning's n of the first crop in the
!WB	rotation #, so this may not be correct
*     B(I)=CONST*DSQRT(SL(I))*X/RN(I1)
      B(I)=CONST*DSQRT(SL(I))*X/RN(IROT(I1,2))
!WB	conveyance B(I) = depth conversion * sqrt (slope of element) *
!WB	sin(ang) + cos(ang) / reynold's # of 1st crop in the rotation
C
C **** MAKE SPECIAL ADJUSTMENTS TO ACCOUNT FOR STRUCTURAL PRACTICES,
C **** BUT FIRST SEE IF ANY ARE PRESENT IN THIS ELEMENT.
C
	IF (IEL(2,J,9).NE.0) CALL STRUCT (I,J,RFL(I),IEL,JMAX,
     1NPAR,NMAX,STRUC,NSTRUC,ISTRUC,X,DX,WID,SS(II+1),SS(I),PIV(II+1),CN
     2,CWID(II+1),CHAN(I),CONST,SL(I),II,SCMIN,SCMAX,SCBAR,ANG,IELC,NPAR
     32,CALLBMP,HASOPENED)
!WB	if the structural flag ne 0, then a structure is present and the
!WB	appropriate subroutine needs to be called.

	DO 250 K=1,NRG
      IF (IELC(2,J,1).EQ.IG(K)) GO TO 260
!WB	if the element of the array equals the raingage designator name
  250 CONTINUE
      WRITE (2,600) IELC(2,J,1),IEL(2,J,1),J,IG(1)
      K=1
!WB	this says that if the IELC doesn't equal the raingage designator
!WB	name, then write that the raingage identifier is missing
C
C **** PUT RAINGAGE NUMBER IN LOW BYTE AND TILE NUMBER IN NEXT BYTE
C **** OF (TIAL:RANE).
C
  260 RANE(I)=TIAL(I)+K
!WB	number of rain gage applicable to element i = tile flag + (K=1)
!WB	should rane(I) be dimensioned to 2000 also?
!RZ	it seems to me that K<>1!  If the program gets to K=1, it is b/c
!RZ	the raingage identifier is missing; K is set to a default of 1 in that case.
!RZ	normally K would be the raingage number for the soil!
  270 CONTINUE
!WB*************************************************
!WB		end of do loop for doing the current row's calculations
!WB*************************************************
      JS=IEL(3,1,2)
!WB	this is the last column # of the third row I think
      IF (ITEMP(3).NE.999.AND.IEL(3,JS,1).NE.ITEMP(1)) GO TO 110
!WB	if the last element in a row flag ne 999 (its only supposed to 
!WB	be a 9) and the row number of the last column in the IEL array
!WB	ne the row # currently read in the itemp(1) array, then go back
!WB	to the top to redo subroutine relem
      ITEMP(3)=999
!WB	okay, you set itemp(3) equal to 999, which flags the program
!WB	that you are on the last row in the watershed
      IF (JS.NE.JMAX) GO TO 110
!WB	if the last column # of the row ne the maximum column #, go back
!WB	to the top and redo subroutine relem
      IF (N+II.GT.NMAX) GO TO 520
!WB	if the # overland flow cells + channel segments is greater than
!WB	the max # of cells, then jump down and stop the program
      X=N
      ASMBAR=ASMBAR/X
      FPBAR=FPBAR/X
      SB=AREA2
      AREA=AREA2*(X-OUTSID)
      CONV=CU*(X-OUTSID)
      SBAR=SBAR/X
!WB	I guess that this is part of the statistical output from the 
!WB	watershed
      IF (II.GT.0) SCBAR=SCBAR/DBLE(II)
      NN=N+1
!WB	this says that if the II counter (for channels) is gt 0, then
!WB	relabel NN to be the low counter for the channel networks
C
C **** OUTPUT STATISTICAL SUMMARY OF WATERSHED CHARACTERISTICS.
C
      TBAR=TBAR/X

* NRZ 9/11/94
* CHANGE OUTPUT PRINT LINE TO PRINT MULTIPLE OUTLET CELLS
C     WRITE (2,690) TITLE,SB,PP(IT+3),N,II,AREA,PP(IT+3),SMIN,SBAR,SMAX,
C    1SCMIN,SCBAR,SCMAX,TBAR,DC,PP(IT+1),ASMBAR,FPBAR,GRF,MOUT,NIOUT,NJO
C     2UT
      WRITE (2,690) TITLE,SB,PP(IT+3),N,II,AREA,PP(IT+3),SMIN,SBAR,SMAX,
     1SCMIN,SCBAR,SCMAX,TBAR,DC,PP(IT+1),ASMBAR,FPBAR,GRF
      WRITE (2,695) (NCH,MOUT(NCH),NIOUT(NCH),NJOUT(NCH),NCH=1,NCHAN)
      WRITE (2,*)
* NRZ 9/11/94

      WRITE (2,700) PP(IT+1),PP(IT+2)
      DC=DC*CU/24.
!WB	tile drainage coefficient = same * (mm/h to m3/s) / 24
      SB=CONST*DSQRT(SBAR)/RN(1)
!WB	SB = average overland flow conveyance coeff
!WB	SB=depth conversion*sqrt(average catchment slope)/Manning's n 
!WB	for surface type 1
!WB	check the Reynold's # for accurate selection
      J=0
      DO 330 I=1,ICR
!WB	ICR = # of cropping practices
      IF (CBAR(I).LE.0..AND.I.LT.ICR) GO TO 330
!WB	cbar is the percent of watershed in crop i, I is the # of  
!WB	cropping practices
      CBAR(I)=CBAR(I)/X
!WB	X is the # of overland flow cells
      IF (J.GE.ISR) GO TO 320
!WB	this seems to be an imbedded count/do-while loop is greater
!WB	than # of soil types, when the # of cropping practices exceeds
!WB	the # of soil types, jump down to 320
  280 J=J+1
      DO 300 JJ=J,ISR
!WB	do to # of soil types
      IF (SPER(JJ).LE.0.) GO TO 300
!WB	if steady-state infiltration rate less than or equal 0
!RZ	I believe this is wrong.  SPER is the number of cells with soil type
!RZ	JJ; therefore, if SPER<=0., there are no cells with the particular soil
!RZ	type and the rest of the calculations don't need to be done.  SPER probably 
!RZ	stands for Soil PERcent.
!RZ	URBAN:::SKIP CLAY AND FC CALCULATIONS IF THE SOIL TYPE IS URBAN
	IF (URBSOIL(JJ).EQ.1) GO TO 281
      CLAYAV=CLAYAV+CL(JJ)*SPER(JJ)/100.
!WB	average clay = same + clay content of soil type * steady-state
!WB	infil rate / 100
!RZ	SPER = number of cells with JJ soil type, not steady-state infil rate
!RZ	SPER probably stands for Soil PERcent; thus, this is accumulating clay average
!RZ	(percent clay in soil jj * number of cells with soil jj / 100
!RZ	makes it a percent?  something like that, you're adding a fraction
!RZ	to the total clay average for the entire watershed

*FC REPRESENT THE WILTING POINT
      FPBAR=FC(JJ)
!WB	the notes say that FPBAR is not used = wilting point
281	CONTINUE

      SPER(JJ)=SPER(JJ)/X
!WB	steady-state infil rate = same / # of cells?  Represents 
!WB	percent of watershed in that rate?
!RZ	I believe this is wrong.  SPER is the number of cells with soil type JJ,
!RZ	so this determines the fraction of the watershed with soil type JJ.  SPER
!RZ	probably means Soil PERcent.
      IF (CBAR(I).LE.0.) GO TO 290
!WB	if the percent of watershed in crop practice i is le 0, skip the
!WB	write statement
      WRITE (2,710) CROP(I,1),CROP(I,2),CBAR(I),PER(I),RN(I),JJ,S
     1PER(JJ),KS(JJ),DF(JJ)
      CBAR(I)=0.
!WB	reset the % of watershed in crop i to 0.  It gets set above.
      GO TO 310
  290 WRITE (2,720) JJ,SPER(JJ),KS(JJ),DF(JJ)
      GO TO 310
	
  300 CONTINUE
      J=ISR
      GO TO 320
  310 J=JJ
      IF (I.LT.ICR) GO TO 330
!WB	if the cropping practice counter # is lt # of cropping practices
!WB	then jump down to 330 and go back to the top (b/c 330 is end of loop)
      IF (J.LT.ISR) GO TO 280
!WB	if the J counter in this loop is lt # soil types, go back to
!WB	the top and redo the soil properties loop
  320 IF (CBAR(I).GT.0.) WRITE (2,730) CROP(I,1),CROP(I,2),CBAR(I),PER(I
     1),RN(I)
  330 CONTINUE
!WB	end of this loop
C *** NRZ 9/15/94
C *** PRINT OUTPUT HEADER TO ALL OUTPUT FILES

      DO 332 NCH=1,NCHAN+1
	 NUNIT=NCH+10
	 WRITE(NUNIT,1700) 
	 WRITE(NUNIT,*) ' DAY  RAIN  RUNOFF SEDIMENT   NO3   DIS-NH4'
     &,' SED-NH4 DIS-PO4 SED-PO4 SED-TKN'
	 WRITE(NUNIT,*) '       MM     MM     KG/HA     KG      KG'
     &,'      KG      KG      KG       KG'
  332 CONTINUE

C *** ASSIGN AN OUTLET CELL FOR EACH CHANNEL NETWORK OUTLET

      DO 335 NCH=1,NCHAN+1
	IF (NCH.LE.NCHAN) THEN
	  CHOUT(NCH)=N+II+NCH
	  NR(MOUT(NCH))=CHOUT(NCH)
	  NC(MOUT(NCH))=CHOUT(NCH)
!WB	these set the element # receiving the flow from the outlet
!WB	cell equal to the channel out #
!RZ	Recall this is network outlet, not channel outlet
!WB	what about ISTRUC?
	ELSE
	  CHOUT(NCH)=N+II+NCH 
!WB	This is used to track the leakycell.out a couple of lines down.
!WB	chout is dimensioned to 9!!!!

	ENDIF
  335 CONTINUE

!WB	THE NEXT SECTION RENUMBERS THE CHANNEL CELLS NUMBERED N+1 UP TO 
!WB	II.  THEY ARE ORIGINALLY NUMBERED LINEARLY ACCORDING TO WHETHER
!WB	OR NOT THEY HAVE A CHANNEL CELL IN THEM.  IN THE ABOVE SECTION,
!WB	THEY ARE EXTRACTED FROM THE LINEAR ORDER.  BELOW, THE VALUES ARE
!WB	ATTRIBUTED TO THEM, HOWEVER THE VALUES ARE NOT RENUMBERED ACCORDING
!WB	TO THE CHANNEL SERIES TO WHICH THEY BELONG (THEY ARE STILL IN 
!WB	LINEAR ORDER), SO THIS ROUTINE RENUMBERS THEM INTO ORDER BY
!WB	CHANNEL SEG TO WHICH THEY BELONG. 

!WB	BEGIN RENUMBER CHANNEL SEGMENTS
	IF (II.NE.0) THEN
	I1=1
      DO NCH=1,NCHAN	
      DO CNT=1,II
		IF (CHNUMBER(CNT).EQ.NCH) THEN	!SHOULD BE CHANNEL NETWORK IDENTIFIER
		PIVTMP(I1)=PIV(CNT)
		CWIDTMP(I1)=CWID(CNT)
		SSTMP(I1)=SS(CNT)
		MNCSTMP(I1)=MNCHNSL(CNT)
		MNCTTMP(I1)=MNCHNTOT(CNT)
		RBTEMP(I1)=ROCKBOT(CNT)
		CHNSLTMP(I1)=CHNSOIL(CNT)
		CONSTTMP(I1)=CONSTHLD(CNT)
		XTMP(I1)=XHOLD(CNT)
		NERODTMP(I1)=NOERODE(CNT)
		CHNURBTMP(I1)=CHNURB(CNT)
		I1=I1+1
		ENDIF
		END DO
	END DO
	ENDIF
!WB	END RENUMBER CHANNEL SEGMENTS


C *** NRZ 9/15/94

* CHECK TO SEE IF THERE ARE ANY CHANNEL SEGMENTS
      IF (II.NE.0) GO TO 340
      N2=N
!WB	if there are no channel segments, set the high N equal to the
!WB	# of overland flow cells, and jump over the continuity section
      GO TO 410
C
C **** DETERMINE SHADOW ELEMENT CONTINUITY.
C **** FIND CHANNEL SEGMENTS.
C
C **** NRZ 9/5/94
C **** REPEAT CHANNEL SEGMENT CONTINUITY CHECK FOR EACH CHANNEL
C **** NETWORK ON THE FARM

  340 DO 405 NCH=1,NCHAN+1
      DO 350 J=1,N
C **** IF CELLS LEAK, ROUTE THEM TO THE LEAKY CELL OUTLET CELL
	IF (NCH.EQ.NCHAN+1) THEN
	  IF (LCC(J).EQ.1) NC(J)=CHOUT(NCH)
!WB	if the leaky cell column direction flag = 1, then the # of the 
!WB	element receiving flow in the column direction = the outlet cell
!WB   for the channel
	
	  IF (LCR(J).EQ.1) NR(J)=CHOUT(NCH)
!WB	if the leaky cell in the row direction flag = 1, then the 
!WB	number of the element receiving flow in the row direction is
!WB	equal to the outlet cell of the channel
	ENDIF
      IF ((CHAN(J).EQ.0).OR.(CHNUM(J).NE.NCH)) GO TO 350
!WB	if channel width # = 0 or channel # designator ne the 
!WB	channel counter, so if there is no channel in this cell or
!WB	if the channel # of the loop isn't the same as the channel
!WB	in this cell.  This extracts all channel cells of one type.
C
C **** USE THE ROW FLOW POINTER TO REMEMBER ORIGINAL ELEMENT NUMBER
C **** OF THIS CHANNEL ELEMENT, SINCE THE FLOW COMPONENT IN THE ROW
C **** DIRECTION IS 0.
C
      NR(NN)=J
	WRITE(2,*) NN,J
!WB	the original overland flow cell # is equal to 
!WB	the element counter #, is originally set to n+1
!WB	NN is another counter used to track channel cells
	MYSHADOW(NN)=J

	IF (CALLBMP(J).EQ.1) THEN
	CALLBMP(NN)=1
!	CALLBMP(J)=0
	POND(NN)=POND(J)
!	POND(J)=0
		IF (SUB(POND(J)).EQ.0) THEN
			POND(J)=MAXPOND+1
			MAXPOND=MAXPOND+1
			SUB(POND(J))=1
			SUB(POND(NN))=0
		END IF

      !RZ	URBAN:make sure the callbmp flag is passed to the channel cell if necessary; 
!RZ	Okay, here's the new deal.  Overland flow is calculated on the shadow cells and
!RZ	we don't want that.  So we need the pond and callbmp designations to remain with the
!RZ	o.f. cells so that in the main program overland flow will not be calculated, and 
!RZ	instead all water coming onto those cells will be directed to nr and nc.  For these
!RZ	particular cells (see later), nr and nc are reassigned to be the channel cells. The
!RZ	channel cells have their nc assigned as the outlet cell of the o.f. cell, which 
!RZ	we specified in subroutine bmps as the pond collection point.  Now the one exception
!RZ	to this happy little scenario is when this is actually the pond collection point
!RZ	(hence the sub(pond(j)).eq.0 check).  In this case, we need the pond characteristics
!RZ	to be assigned to the channel cell, as this is where everything is going to end up
!RZ	going.  SO, we give the o.f. cell a dummy pond number that has no values, and 
!RZ	reassign the part of larger (sub) variable to a 1 to indicate it is now part of 
!RZ	a larger pond.  Maxpond just keeps track of these dummy pond numbers to make sure
!RZ	none of the original pond numbers are overwritten.  The part of larger (sub) variable
!RZ	is set to 0 for the channel cell to indicate that it now is the pond collection point,
!RZ	it contains all the pond characteristics, and when the main program hits this cell it
!RZ	will perform the pond calculations.  Hopefully that makes sense to you :-).
	END IF 

      NN=NN+1
  350 CONTINUE
      IF (NCH.EQ.NCHAN+1) GOTO 405
!WB	if the channel counter equals the leakycell place holder, goto 405
C
C **** MOVE CHANNEL PARAMETERS TO END OF ARRAYS.
 
C **** NRZ 
C **** CHANGE LOWER BOUND (N1) OF CHANNEL CELL SECTION OF ARRAY TO 
C **** ACCOUNT FOR NEXT CHANNEL NETWORK

      IF (NCH.NE.1) THEN
	NLOW=N2+1
      ELSE
	NLOW=N+1
      ENDIF

      N1=NLOW

C **** NRZ

      N2=NN-1

      DO 390 I=N1,N2

C **** NRZ 3/25/95
C **** I1 IS THE NUMBER OF THE CHANNEL SEGMENT IN THIS NETWORK (i.e. IF 
C **** THIS IS NETWORK #2 AND NETWORK #2 HAS 10 CHANNEL SEGMENTS, I1 WILL
C **** RANGE FROM 1-10)
      I1=I-N
      B(I)=PIVTMP(I1)
!WB	this is conveyance? = the PIV variable is set equal to the 
!WB	channel conveyance (I believe) in previous lines
      CWID(I)=CWIDTMP(I1)
!WB	channel width of this cell is equal to the channel width of the 
!WB	segment      
	SL(I)=SSTMP(I1)
!WB	slope of the overland cell = slope of the channel segment
	MNCHNSL(I)=MNCSTMP(I1)
!WB	THIS IS THE MANNING'S N FOR BARE CHANNEL SOIL.
	MNCHNTOT(I)=MNCTTMP(I1)
!WB	THIS IS THE MANNING'S N FOR CHANNEL SOIL + VEG.
	ROCKBOT(I)=RBTEMP(I1)
!WB	DEPTH TO IMPERMEABLE LAYER FOR CHANNEL CELL
	CHNSOIL(I)=CHNSLTMP(I1)
!WB	CHNSOIL = SOIL TYPE FOR CHANNEL CELL
	SOIL(I)=CHNSOIL(I)*256
!WB	THIS SETS THE SOIL TYPE IN THE CHANNEL CELL INTO THE SOIL ARRAY
	URB(I)=CHNURBTMP(I1)
	CONSTHLD(I)=CONSTTMP(I1)
	XHOLD(I)=XTMP(I1)
!WB	THE PREVIOUS TWO VALUES HOLD PLACE FOR CONVEYANCE CALCULATIONS IN THE MAIN
!WB	ROUTINE
	ARMOUR(I)=NERODTMP(I1)
!WB	FRACTION OF THE CHANNEL SOIL THAT IS NONERODIBLE
C **** NRZ 3/25/95
C **** NR(I) IS THE ORIGINAL OVERLAND FLOW CELL #, NOT "NUMBER RECEIVING
C **** ROW FLOW FROM (I)"

      J=NR(I)
!WB	recall J, which is an element with a channel series.  The series
!WB	of the channel depends on how many times you've been through the
!WB	outer loop

      I1=NC(J)
!WB	I1 is equal to the element # that receives flow in the column
!WB	direction from the overland flow element
      I2=NR(J)
!WB	I2 is equal to the element # that receives flow in the row 
!WB	direction from the overland flow element that contains a channel
!WB	of type that depends on the counter
C
C **** IF CERTAIN STRUCTURES ARE PRESENT IN AN ELEMENT WITH A SHADOW
C **** ELEMENT, IT IS LIKELY THAT THE RECEIVING CHANNEL ELEMENT WILL
C **** NOT BE GETTING THE MAJOR OUTFLOW.
C
      IF (I1.GT.NMAX) GO TO 360
!WB	If the # of the element that receives flow from the marker used
!WB	to designate a channel in an element exceeds the max # of cells,
!WB	then it implies that a structural element lies on the boundary
!WB	of this cell which contains a channel.  Jump down to 360, set
!WB	the receiving element column # equal to the receiving element
!WB	row #, which means set the column flow equal to row flow.  I would
!WB	think that this one should also point to 380.
      IF (I2.GT.NMAX) GO TO 380
!WB	if the # of the element that receives flow from the marker used
!WB	to designate a channel in an element exceeds the max # of cells,
!WB	then it implies that a structural element resides on the 
!WB	boundaries of this marker cell, and that you should check to see
!WB	if the receiving cell from this marker cell contains a channel
!WB	or if the marker cell is an outlet cell.  If not it stops the
!WB	program.
C
C **** THIS ELEMENT DOES NOT CONTAIN A STRUCTURE; THEREFORE, THE
C **** RECEIVING CHANNEL ELEMENT SHOULD BE IN THE DIRECTION OF THE
C **** PREDOMINANT FLOW COMPONENT.
C
      IF (RFL(J).LT.0.207107) GO TO 380
!WB	flow in the row direction from the marker cell is 
!WB	predominantly column
      IF (RFL(J).GT.0.792893) GO TO 360
!WB	flow in the row direction from the marker cell is 
!WB	predominantly row
C
C ****** FLOW DIRECTION IS PREDOMINANTLY DIAGONAL.
C ****** IF ROW FLOW DESTINATION NUMBER IS LESS THAN CURRENT ELEMENT
C ****** NUMBER, THE DIAGONAL POINTS TO THE LEFT AND THE DIAGONAL
C ****** DESTINATION ELEMENT CAN BE COMPUTED BY SUBTRACTING ONE FROM
C ****** THE CONVENTIONAL OVERLAND FLOW COLUMN DESTINATION NUMBER.
C
      IF (DIAGFLAG(J).EQ.1) THEN
		IF ((NR(J).NE.J+1).AND.(NR(J).NE.J-1)) THEN
			I1=I2
		END IF
		GO TO 380
	END IF
!RZ	the above if was added 4/22/2002 by Rebecca Zeckoski as part of the
!RZ	new lines allowing diagonal flow for channel elements on the 
!RZ	watershed boundary.  If diagflag(j) is 1, the flow has already 
!RZ	been calculated to be diagonal and a renumbering at this point 
!RZ	would cause the flow to go to the wrong receiving cell.  See
!RZ	the section above (140,150,160,170) to see how the flow direction
!RZ	has been calculated.
!RZ	The nested if then checks whether the column or row cell has the 
!RZ	diagonal cell.  If the row cell is not adjacent to this cell (as it
!RZ	would have to be if the flow destination had not been changed in 
!RZ	the row direction to accomodate diagonal cells), this indicates
!RZ	that nr holds the diagonal cell and therefore i1, the receiving element
!RZ	of j, is reset to the cell in the nr position; otherwise, the column
!RZ	cell holds the diagonal element and i1=i1 (no change).
      IF (I2.LT.J) GO TO 370
      I1=I1+1
      GO TO 380
  360 I1=I2
!WB	element # that receives flow in the col direction from the 
!WB	marker element = element
!WB   # that receives flow in the row direction from the marker cell.
      GO TO 380
  370 I1=I1-1
!WB	if the element # receiving row flow from J (marker cell)
!WB	is less than the marker element J #, then 
!WB	the element # that receives flow from the marker cell is equal
!WB	to the # that it originally was, subtract 1.  This is legitimate
!WB	because the o.f. routings do not calculate diagonal flow, and
!WB	therefore you will never be more than 1 column away from this 
!WB	element
C
C **** MAKE CERTAIN THE RECEIVING ELEMENT IS A CHANNEL ELEMENT.
C
C **** NRZ 9/11/94
C **** THE FOLLOWING CHECK FOR DISCONTINUOUS CHANNELS IS PERFORMED FOR 
C **** EACH POSSIBLE OUTLET OF THE CHANNEL NETWORKS


C NRZ 3/5/95
  380 IF (CHAN(I1).LT.1.AND.J.NE.MOUT(NCH)) THEN
	WRITE(2,*) I1,J,CHAN(I1),CHAN(J)
	GO TO 560
	END IF
!WB	if the channel width lt 1 and the element counter # ne the outlet
!WB	cell, goto 560 and stop the program
C **** NRZ 9/11/94
C
C **** TEMPORARILY ASSIGN THE ORIGINAL OVERLAND FLOW ELEMENT 
!WB*** destination NUMBER
C **** AS THE DESTINATION FOR THE SHADOW OUTFLOW.  THIS IS NECESSARY
C **** UNTIL NEW NUMBERS ARE ASSIGNED TO ALL SHADOW ELEMENTS.
C
      NC(I)=I1
!WB	the element # receiving flow in the column direction from this
!WB	channel cell (I from N1 to N2) is equal to the calculated
!WB	column receiving # derived from the original o.f. cell
C
C **** MAKE ALL OVERLAND FLOW FROM THIS ELEMENT GO INTO ITS SHADOW
C **** ELEMENT, UNLESS IT CONTAINS A STRUCTURAL PRACTICE.
C
      NR(J)=I
!WB	the element # that receives flow from this marker element in the
!WB	row direction is equal to the number of this channel element
      NC(J)=I
!WB	the element # that receives flow from this marker element in the
!WB	column direction is equal to the number of this channel seg.
  390 CONTINUE
C
C **** FIND REAL CHANNEL SEGMENT NUMBER INTO WHICH EACH CHANNEL
C **** SEGMENT FLOWS. (rz instead of o.f. number of receiving cell)
C
      DO 400 J=N1,N2
      I=NC(J)
!WB	set I equal to the element # receiving flow from this element
!WB	in the column direction.  This is equal to I1 from a few lines
!WB	above, it says to recall the outflow element # for the channel
!WB	segment.
      NC(J)=NR(I)
!WB	set the element # receiving flow in the column direction equal
!WB	to the element # receiving flow in the row direction
!WB	from the original overland flow cell
C
C **** IF THIS ELEMENT CONTAINS A STRUCTURAL MEASURE, ITS CORRECT
C **** CHANNEL ELEMENT NUMBER MAY BE PRESENT ONLY IN ARRAY NC.
C
C      IF (NC(J).GT.NMAX) NC(J)=NC(I)
C
C **** FORCE ALL CHANNEL FLOW TO USE ONLY COLUMN FLOW DIRECTIONS.
C
C **** NRZ 9/5/94
C **** INCORPORATE EXTRA OUTLETS AND DIRECT FLOW TO CORRECT FINAL
C **** RECEIVING ELEMENT

  400 RFL(J)=0.
!WB	set the fraction of flow in the row direction equal to 0

      J=NR(MOUT(NCH))
!WB	set the # J equal the element # receiving flow in the row 
!WB	direction from the outlet cell #
      NC(J)=CHOUT(NCH)
!WB	set the element # receiving flow in the column direction from 
!WB	the row element # above equal to the channel out variable for
!WB	the channel #
C **** END OF MULTIPLE CHANNEL LOOP AND REASSIGN LOW VALUE OF CHANNEL
C **** ELEMENT ARRAY

  405 CONTINUE
      N1=N+1

C **** NRZ 9/5/94
C
C **** OUTPUT DATA CONCERNING ANY STRUCTURAL PRACTICES.
C
!WB	you are sent here to 410 if there are no channel segments
  410 IF (.NOT.STRUC) GO TO 430
!WB	the .struc flag must be set to 'true' if there are any practices
      WRITE (2,1000)
      DO 420 I=1,ISTRUC
      IF (NSTRUC(I).NE.0) WRITE (2,1010) I,(STRNAM(J,I),J=1,3),NSTRUC(I)
  420 CONTINUE
C
C **** EVALUATE INITIAL CONDITIONS.
C
  430 DO 440 I=1,N2
      S(I)=0.
!WB	storage at start of time increment for element I is equal to 0
  440 FLINS(I)=0.
!WB	infiltration into the element is equal to 0
C
C **** CONVERT SOIL CONSTANTS.
C
      DO 450 I=1,ISR
!WB	do from 1 to # of soil types 
!RZ	URBAN:
	IF (URBSOIL(I).EQ.1) GO TO 450
!RZ	if the soil type is flagged as urban, skip calculations and go to end of loop
      TP(I)=TP(I)*CU1*DF(I)
!WB	porosity = same * conv * depth of soil horizon
      TP1(I)=TP(I)
*     A(I)=CU*A(I)*(DT/TP(I))**P(I)
      GWC(I)=(1.-FCAP(I))*TP(I)/DT
!WB	volume of air filled pore space at field capacity for soil i
  450	CONTINUE
C
C **** INITIALIZE VALUES SPECIFIC TO INDIVIDUAL ELEMENTS.
C
      Y=1./X
!WB	y = the inverse of the # of overland flow cells?
      DO 460 I=1,N
      K=2
      IS=SOIL(I)/256
      IC=MOD(SUR(I),256)
!RZ	URBAN::If the cell is urban, no airfilled pore space/area for infiltration
	IF (URB(I).EQ.1) THEN
		PIV(I)=0.0
	    GO TO 460
	END IF
      PIV(I)=(1.-ASM(IS))*TP(IS)/DT
	
  460 CONTINUE

C
C **** CONTINUE FOR SURFACE INITIAL CONDITION.
C
C
CC....CALCULATION OF COEFFICIENTS FOR YALINS EQUATION........
C
      DO 505 IC=1,NPART
	CY1(IC)=EQSDIA(IC)*VISCOS
!WB	CY1 = equiv sand diameter of particle * kinematic viscosity of water
	CY2(IC)=1.65*AGRAV*EQSDIA(IC)
!WB	CY2 = 1.65 * acceleration due to gravity * equiv sand diam
	CY4(IC)=2.65*EQSDIA(IC)*SWH2O
!WB	CY4 = 2.65 * equiv sand diam * spec wght of water
  505 CONTINUE
      SGD2=DSQRT(AGRAV*.5)
!WB	SGD2 = sqrt(accel due to gravity * 0.5)
      DO 506 IC=1,N
	K=MOD(SUR(IC),256)
!WB	K = surface type of element - INT(same / 256) * 256
!rz	=cover type 
	VS(IC)=SGD2*DSQRT(SL(IC)*DT/DX2)
!WB	VS = SGD2*sqrt(slope*time increment / area of cell)
  506 CONTINUE
      IF(N2.EQ.N) GO TO 508
!WB	if there are no channels, go to 508
      DO 507 IC=N1,N2
	VS(IC)=SGD2*DSQRT(SL(IC)*DT/(DX*CWID(IC)))
!WB	VS = SGD2 * sqrt (slope * time increment / (cell width * chan width))
  507 CONTINUE
  508 CONTINUE

!RZ	THE FOLLOWING SUBROUTINE WAS CREATED PER DR. THEO DILLAHA'S ORDERS TO 
!RZ	TRACK CHANGES IN ANSWERS OF THE INPUT PARAMETERS DUE TO SOME CONCERN THAT
!RZ	THE PROGRAM WAS CHANGING THE INPUT PARAMETERS DURING EXECUTION
!	CALL CHCKDT(UNITS,PR,NRG,XDATE,SIMDUR,IG,NDT,DT,NFI,SF,ISR,
 !    &DF1,KOPT,SK,DC,GRF,IFERT,NCH,ICR,CROP,NOOFCHAN,DX,ITEMP,RN,NEXP,
  !   &ITEMPC,DAYBEG,YERBEG,WID)

      RETURN
C
C **** ERROR MESSAGES.
C
  510 WRITE (2,930)
      STOP
  520 WRITE (2,840)
      STOP
  530 WRITE (2,860)
      STOP
  540 WRITE (2,850)
      STOP
  550 WRITE (2,870)
      STOP
  560 WRITE (2,890) J
      STOP
  570 WRITE (2,900) NRG,J
      STOP
  580 WRITE (2,910) TEST
      STOP
  590 WRITE (2,970) ROUGH(I),CROP(I,1),CROP(I,2)
      STOP
C
C **** FORMATS.
C
  600 FORMAT (1X,'RAIN DATA MISSING FOR GAGE ',A2,12H, AT ELEMENT,I4,1H
     1,,I4,7H: GAGE ,A2,' DATA USED')

** NRZ 9/11/94
** MODIFIED INPUT FORMAT TO INCLUDE MULTIPLE CHANNELS
C 610 FORMAT (16X,F7.2/17X,I4,8X,I4)
  609 FORMAT (16X,F7.2)
  610 FORMAT (27X,I4,8X,I4,5X,I5)
** NRZ 9/11/94

!620 FORMAT (11X,2A4,6X,F3.2,6X,F3.2,5X,F3.2,4X,F4.2,4X,F5.3)
  620 FORMAT (11X,2A4,6X,F5.2,6X,F4.2,5X,F4.2,4X,F6.2,4X,F5.3)
  !RWZ changed 10/15/01 to accomodate new Questions format
 ! 623 FORMAT(1X,6(F4.1,1X),3(F4.2,1X))
  623 FORMAT (1X,6(F5.1,1X),3(F4.2,1X))
!WB	ADDED INTERRILL COVER FACTORS
  624 FORMAT(1X,11(F4.2,1X))
  625 FORMAT(1X, I3, 1X, I3, 1X, F4.2, 1X, F6.3, 1X, F5.2, 1X, F7.1, 
     + 1X, I3, 1X, F4.2)
!  626 FORMAT(1X,F5.1,1X,F5.3,1X,F5.2,1X,F5.2,1X,F5.2,1X,F5.3,1X,F5.3,
  626 FORMAT(1X,F5.1,1X,F5.3,1X,F5.3,1X,F5.2,1X,F5.2,1X,F5.3,1X,F5.3,
     11X,I2,1X,I2)
  629 FORMAT (7X,8(F5.2,1X))
!WB	READ IN THE NEW SEDIMENT ROUTINE VARIABLES  
  630 FORMAT (/1X,27HSIMULATION TIME INCREMENT =,F6.1,8H SECONDS/1X,
     *38HINFILTRATION CAPACITY CALCULATED EVERY,I5,8H SECONDS/1X,
     *22HEXPECTED RUNOFF PEAK =,F8.2,2A4,/,1X,20HNUMBER OF RAIN GAGES,
     *3X,'= ',I4)
  640 FORMAT (I4,2PF9.1,F11.1,0PF11.2,8X,F7.2,F9.1,2PF10.1,0PF9.2)
  650 FORMAT (/1X,18HCHANNEL PROPERTIES/1X,4HTYPE,3X,5HWIDTH,3X,
	111HMANN N SOIL,4X,10HMANN N TOT,4X,7HIMPERM.,2X,7HPERCENT
     2,/,9X,A4,32X,5HDEPTH,4X,6HARMOUR,/,(I4,F8.1,4X,F5.3,10X,
     3F5.3,9X,F5.3,4X,F4.2))
!WB	FORMAT STATEMENT 650 EDITED TO INCLUDE MAN. OUTPUT, IMPERM LAYER
  660 FORMAT (//5X,33HRAINFALL HYETOGRAPH FOR EVENT OF ,2A4)
  670 FORMAT (/5X,12HGAGE NUMBER ,A2/5X,11HTIME - MIN.,7X,15HRAINFALL RA
     1TE -,2A4/(F14.1,F24.2))

C NRZ 9/5/94
C CHANGED FORMAT STATEMENT TO INCLUDE AN EXTRA 2 DIGITS FOR THE CHANNEL
C NETWORK NUMBER

C 680 FORMAT (2I3,I2,I3,3I4,3X,A2,1X,A2,2X,I4,I3,2I4,I6,I2,I5,I5,I5)
!WB  680 FORMAT (2I3,I2,I3,I4,1X,I5,I4,3X,A2,1X,A2,2X,I4,I3,2I4,I6,I2,I5,I5
!WB     &,I5)
  680 FORMAT (2I3,I2,I3,I4,1X,I7,I4,3X,A2,1X,A2,2X,I4,I3,2I4,I6,I2,I5,I5
     &,I5)

C NRZ 9/5/94
C

  681 FORMAT(3I5,I6,1X,2(I1,1X),I5,1X,I1) 

C *** NRZ 9/11/94
C *** MODIFY OUTPUT FOR MULTIPLE CHANNEL NETWORKS
C 690 FORMAT (/,5X,11A4,/,5X,'WATERSHED CHARACTERISTICS',/,' NUMBER OF',
C    1F6.2,A4,' OVERLAND FLOW ELEMENTS =',I5,/,1X,'NUMBER OF CHANNEL SEG
C    2MENTS = ',I3,/,1X,'AREA OF CATCHMENT =',F8.1,A4,/,1X,'CATCHMENT SL
C    3OPE: MIN =',2PF7.2,'  AVE =',F7.2,'  MAX =',F7.2,' PERCENT',/,1X,'
C    4CHANNEL SLOPE:   MIN =',F7.2,'  AVE =',F7.2,'  MAX =',F7.2,' PERCE
C    5NT',/,1X,'PERCENT OF AREA TILED =',F6.1,' WITH A D.C. OF',0PF5.2,A
C    64,'/24H',/,' MEAN ANTECEDENT SOIL MOISTURE =',2PF4.0,', FIELD CAPA
C    7CITY =',F4.0,' PERCENT SATURATION',/,' GROUNDWATER RELEASE FRACTIO
C    8N =',0PF7.4,/,1X,'OUTLET IS ELEMENT',I5,' AT ROW',I4,' COL',I4)
  690 FORMAT (/,5X,11A4,/,5X,'WATERSHED CHARACTERISTICS',/,' NUMBER OF',
     1F6.2,A4,' OVERLAND FLOW ELEMENTS =',I5,/,1X,'NUMBER OF CHANNEL SEG
     2MENTS = ',I5,/,1X,'AREA OF CATCHMENT =',F8.1,A4,/,1X,'CATCHMENT SL
     3OPE: MIN =',2PF7.2,'  AVE =',F7.2,'  MAX =',F7.2,' PERCENT',/,1X,'
     4CHANNEL SLOPE:   MIN =',F7.2,'  AVE =',F7.2,'  MAX =',F7.2,' PERCE
     5NT',/,1X,'PERCENT OF AREA TILED =',F6.1,' WITH A D.C. OF',0PF5.2,A
     64,'/24H',/,' MEAN ANTECEDENT SOIL MOISTURE =',2PF4.0,', FIELD CAPA
     7CITY =',F4.0,' PERCENT SATURATION',/,' GROUNDWATER RELEASE FRACTIO
     8N =',0PF7.4)
  695 FORMAT (1X,'OUTLET ',I2,' IS ELEMENT',I5,' AT ROW',I4,' COL',I4)
C *** NRZ 9/11/94

  700 FORMAT (/,' SURFACE COVER/MANAGEMENT CONDITIONS',8X,'SOIL ASSOCIAT
     1ION PROPERTIES',/,3X,'CROP  PERCENT PERCENT     N',14X,'NO. PER
     2CENT   KS',4X,'  CONTROL  ',/,9X,'PRESENT  COVER',25X,'PRE
     3SENT',2A4,2X,'DEPTH MM')
  710 FORMAT (1X, 2a4, 2P, F6.1, F7.0, 0P, 4X, F6.3, 10X, I4, 2P, 
     + F7.1, 2X, 0P, F7.2, 2X, F8.1)
  720 FORMAT (I46,2PF7.1,2X,0PF7.2,2X,F8.1)
  730 FORMAT (1X, 2A4, 2P, F6.1, F7.0, 4X, 0P, F6.3)

!TMN  (4/25/00) 
!TMN  740 FORMAT (A1,F9.0,F10.2)
!TMN  CHANGED TO ACCOMODATE TWO DECIMALS ON THE INTENSITY (ALSO
!TMN  CHANGED IN THE BREAKPOINT DATA AND TO MATCH THE FORMATTING 
!TMN  OF THE BREAKPOINT DATA SO TAMIE CAN SLEEP AT NIGHT!!!
  740 FORMAT (A1,F8.0,1X,F9.2)
  750 FORMAT (//1X,15HSOIL PROPERTIES/1X,4HSOIL,2X,8HPOROSITY,2X,10HFIEL
     1D CAP.,2X,22HWILT. POINT  HYDRAULIC,2X,7HCONTROL,2X,10HANTECEDENT,
     21X,/7X,8H(PERCENT,3X,8H(PERCENT,3X,8H(PERCENT,4X,7HCONDUC
     3.,5X,4HZONE,5X,8HMOISTURE,3X,/9X,5HVOL.),6X,5HSAT.),
     47X,5HSAT.),6X,2A4,3X,A4,3X,13H(PERCENT SAT))
  760 FORMAT (13X,F4.1,14X,F6.3,9X,F6.3,1X,F4.2,1X,F4.2)
!WB	760 MODIFIED TO INCLUDE MANNING F.F. FOR CHANNEL SOILS,IMPERM LAYER
  770 FORMAT (8H ELEMENT,I4,1H,,I4,27H FLOWS OUT OF THE WATERSHED)
  780 FORMAT (18X,I4)
  790 FORMAT (10X,F3.2,6X,F3.2,6X,F5.2,5X,F5.3,6X,F5.1,7X,F3.2)

C *** NRZ 9/12/94
C *** ADD FORMAT LINE TO ENTER SATURATED HYDRAULIC CONDUCTIVITY

  791 FORMAT (23X,I1,9X,F5.2)  

C *** NRZ 9/12/94

  795 FORMAT (1X,F4.1,1X,F4.1,1X,F4.1,1X,F4.2,1X,F4.1,1X,F4.1)
  797 FORMAT (1X,4(F7.5,1X))
  800 FORMAT (1X,A4,52X,A4)
  810 FORMAT (A4,15X,I2,25X,2A4)
  820 FORMAT (A4,24X,11A4)
  830 FORMAT (16X,A2)
  840 FORMAT (' NUMBER OF SHED+CHAN ELEMENTS EXCEEDS,10H DIMENSION')
  850 FORMAT (' RAINFALL DATA EXCEEDS DIMENSION')
  860 FORMAT (' NO. OF SOILS EXCEEDS DIMENSION')
  865 FORMAT (' CHANNEL SOIL ',I3,' AT CELL ',I5,' EXCEEDS DIMENSION
     1 OF TOTAL SOIL TYPES')
!WB	ADDED IN CASE CHANNEL SOIL PROPERTIES EXCEED DIMENSION
  870 FORMAT (' NO. OF CROPS EXCEEDS DIMENSION SPEC')
  890 FORMAT (39HCHANNELS DISCONTINUOUS NEAR ELEMENT NO.,I5)
  900 FORMAT (1X,'HYETOGRAPH DATA MISSING OR INCORRECT',24H FIRST COLU
     1MN NOT 0 OR 1/I4,40H GAGES REQUESTED. BAD LINE BEGINS WITH: ,A2)
  910 FORMAT ('INCORRECT INPUT SEQUENCE',36H OR HEADER CARD.  CARD BEGI
     1NS WITH: ,A4)
  920 FORMAT (30X,I3)
  930 FORMAT (' NO. OF CHANNEL TYPES EXCEEDS DIMENSION')
  940 FORMAT (31X,I3)
  950 FORMAT (/7H COVER /20HMANAGEMENT PRACTICES/3X,4HCROP,6X,
     19HMAX. POT.,3X,7HPERCENT,2X,6HROUGH.,2X,6HROUGH.
     2,2X,9HMAX. RET.,2X,/11X,12HINTERCEPTION,
     33X,5HCOVER,3X,6HCOEFF.,2X,6HHEIGHT,2X,5HDEPTH,5X,
     4/14X,A4,23X,A4,4X,A4)
  960 FORMAT (1X,I2,1X,2A4,F7.2,2PF12.0,0PF8.2,F8.1,F10.3,F10.2)
  970 FORMAT (20H ROUGHNESS COEFF. OF,F8.2,27H IS OUT OF RANGE FOR CROP:
     1 ,2A4)
  975 FORMAT (/,1X,4HCROP,3X,6HRANDOM,6X,6HBURIED,3X,9HMAX PLANT,3X,
     16HGROWTH,3X,4HRILL,/,1X,1H#,6X,9HROUGHNESS,3X,
     27HRESIDUE,2X,6HHEIGHT,6X,6HFACTOR,3X,7HSPACING,3X,/,8X,4H(MM),8X,
     38H(KG/M^2),1X,3H(M),18X,8H(M/RILL))
  976 FORMAT (1X,I2,F11.2,1X,F11.2,F7.2,8X,F4.2,5X,F4.2)
  977 FORMAT (/,1X,4HCROP,3X,11HMANNING'S N,3X,11HMANNING'S N,3X,
     110HNO-TILLAGE,3X,7HNO-EROS,/,8X,4HSOIL,10X,5HTOTAL,9X,
     24HFLAG,9X,4HFLAG)
  978 FORMAT (1X,I2,5X,F5.3,9X,F5.3,8X,I2,11X,I2)
 1958 FORMAT (/,1X,4HCROP,3X,9HINTERRILL,3X,9HINTERRILL,3X,9HLIVE ROOT,
	13X,9HDEAD ROOT,3X,9HDEAD ROOT,/,1X,1H#,6X,9HCOVER INI,3X,
     29HCOVER FIN,3X,4HMASS,8X,9HMASS INIT,3X,10HMASS FINAL)
 1960 FORMAT (1X,I3,4X,F4.2,8X,F4.2,8X,F4.2,8X,F4.2,8X,F4.2)
!WB	ADDED 1958 AND 1960 TO PRINT THE COVER EROS PARAMETERS
C *** NRZ 9/12/94
C *** MODIFY FORMAT LINE TO INCLUDE FERTILIZER FILE FLAG
C 980 FORMAT (20X,I2/39X,F5.2/31X,E10.3)
  980 FORMAT (20X,I2/39X,F5.2/31X,E10.3,/21X,I2,/21X,I2)
C *** NRZ 9/12/94
C *** NRZ (8/29/94)
C *** ADDED FORMAT STATEMENTS FOR IMPOUNDMENT DATA

  981 FORMAT (/,1X,25X,I2)
  982 FORMAT (1X,I7,3(1X,F6.1),2(1X,F7.1),1X,F6.1,1X,F5.3,1X,F11.3)

C *** NRZ (8/29/94)

  990 FORMAT (/1X,19HDRAINAGE EXPONENT =,I2/1X,22HTILE DRAINAGE COEFF. =
     1,F5.2,A4,4H/24H/1X,30HGROUNDWATER RELEASE FRACTION =,E10.3)
 1000 FORMAT (/3X,28HSTRUCTURAL MEASURES INCLUDED,/10X,4HTYPE,9X,6HNUMBE
     1R)
 1010 FORMAT (I7,2X,3A4,I6)
 1020 FORMAT (1X,11HCHANNEL NO.,I5,15H AT ELEMENT NO.,I5)
 1030 FORMAT (39X,I4/17X,F5.1/39X,I5/23X,F7.2)
 1040 FORMAT(/20X,'PARTICLE SIZE DISTRIBUTION DATA'/)
 1050 FORMAT(/36X,I2/36X,I2/)
 1060 FORMAT(14X,37H    NUMBER OF PARTICLE SIZE CLASSES =,I2/
     *14X,37H    NUMBER OF WASHLOAD CLASSES      =,I2)
 1070 FORMAT(1X,F15.8,F15.3,F15.7)
 1080 FORMAT(3X,5HCLASS,3X,6HDIA,MM,7X,9HEQSAND,MM,10X,2HSG,3X,
     *14HFALL VELOCITY,,A4,2H/S)
 1090 FORMAT(5X,I1,4X,F6.3,2F15.3,F15.7)
 1110 FORMAT(1X,8F6.3)
 1100 FORMAT(1X,47HPARTICLE SIZE DISTRIBUTION OF SOILS AS DETACHED/
     *2X,52HCLASS    1     2     3     4     5     6     7     8)
 1120 FORMAT(1X,4HSOIL,I2,8F6.3)
 1111 FORMAT(1X,9F8.4)
 1666 FORMAT(1X,35X,I3,1X,I4)

! TMN 1667 FORMAT(1X,28X,I4) ! CHANGED FROM I4 TO I8 TO ACCOMODATE
! TMN LONGER RUNS 
 1667 FORMAT(1X,28X,I8)
 1700 FORMAT(///,30X,22H**** DAILY OUTPUT ****,///)
 1710 FORMAT(2X,4HYEAR,1X,3HJUL,3X,8HRAINFALL,2X,6HRUNOFF,2X,8HSEDIMENT
     &,2X,8H NITRATE,2X,8HDIS. NH4,2X,8H SED.NH4,2X,8HSED.ORGN/
     &,7X,3HDAY,6X,2HMM,7X,2HMM,6X,5HKG/HA,5X,4HMG/L,5X,4HMG/L,7X
     &,4HG/HA,5X,4HG/HA,/,56X,6HSED. P,6X,6HSOL. P,/,58X,4HG/HA,7X,
     &4HMG/L)

C *** NRZ 7/29/95
C *** MODIFIED FORMAT LINE TO INCLUDE 7 ROTATION END DATES PER LINE
C1800 FORMAT(1X,I2,1X,5(I2,1X,I7,1X)/4X,5(I2,1X,I7,1X)/4X,5(I2,1X,I7,1X)
C    & /4X,5(I2,1X,I7,1X))

!TMN  MODIFIED FORMAT FOR ROTATION END DATES TO ALLOW FOR 301 END DATES
!TMN  WITH A TOTAL OF 29 LINES PER ROTATION
! 1800 FORMAT(1X,I2,1X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
!     & /4X,7(I2,1X,I7,1X))
1800  FORMAT(1X,I2,1X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)/4X,7(I2,1X,I7,1X)
     & /4X,7(I2,1X,I7,1X))

 1950 FORMAT (1X,'THE FRICTION FACTOR FOR CROP',F6.3,' EXCEEDS THE '
	1,/,' COMBINED FRICTION FACTOR:',F6.3,' FOR CROP #: ',I3
     2,/,' PLEASE CHANGE THIS.')
!RZ	changed 'soil' to 'crop' in above error message because soil is wrong
 1952 FORMAT ('THE NOTILL FLAG IS NOT A 0 OR A 1.  PLEASE CHECK'
	1,/,'THE MAIN INPUT FILE.  THE PROGRAM HAS STOPPED.')
 1954 FORMAT ( 'THE NO EROSION FLAG IS NOT A 0 OR A 1.  PLEASE'
	1,/,' CHECK THE MAIN INPUT FILE.  THE PROGRAM HAS STOPPED.')
 1956 FORMAT ('THE BURIED RESIDUE FACTOR APPEARS TO BE INPUT 
     1IMPROPERLY'
     2,/,' AS ITS VALUE EXCEEDS 1 KG/M2, OR 10,000 KG/HA.')
 1962 FORMAT ('THE DEAD ROOT MASS AT THE END OF THE CROP/COVER: ',
	1F6.3,/,' EXCEEDS THE INITIAL DEAD ROOT MASS FOR THE 
     2CROP/COVER: ',F6.3,' FOR COVER # ', I3,/,' AND THE PROGRAM
     3 HAS TERMINATED')
C
      END
      SUBROUTINE STRUCT (I,J,RFL,IEL,JMAX,NPAR,NMAX,STRUC,NSTRUC,I
     1STRUC,X,DX,WID,SSII,SSI,PIV,CN,CWID,CHAN,CONST,SL,II,SCMIN,SCMAX,S
     2CBAR,ANG,IELC,NPAR2,CALLBMP,HASOPENED)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
C
C ****** SUBROUTINE TO ADJUST PARAMETERS TO REFLECT STRUCTURAL PRACTICES
C ****** INSTALLED WITHIN AN ELEMENT.
C
      DIMENSION IEL(3,JMAX,NPAR2), NSTRUC(ISTRUC), WID(10), CN(10)
      DIMENSION IELC(3,JMAX,2)
	DIMENSION ADUMMY(101)
	DIMENSION CALLBMP(35000)
      INTEGER CHAN,PRACT,CALLBMP,BMPLOC,SIMDUR,HASOPENED
      LOGICAL STRUC
      CHARACTER*2 IELC

	COMMON /BMP2/ PONDAREA(300),NRO(300),H2ODEPTH(300),
	6ORAREA(300),WEIRVOL(300),ORVOL(300),ORTOP(300),
	7MAXFLOW(300),SOLP(300),SOLNH4(300),SOLNO3(300),
	8LOST(300),WLOST(300),ORBOT(300),TIPE(300),
	9PIPEN(300),PIPED(300),PIPEL(300),RISD(300),PIPEAREA(300),
	1RISH(300)
	INTEGER TIPE

	COMMON /BMP3/ POND(35000),STREAM(300),SUB(300)
	INTEGER POND,SUB

	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)


C
C **** SWITCH TO APPROPRIATE HANDLER FOR EACH STRUCTURAL TYPE.
C
      PRACT=IEL(2,J,9)
      IF (PRACT.GT.ISTRUC.OR.PRACT.LT.0) GO TO 90
      STRUC=.TRUE.
      NSTRUC(PRACT)=NSTRUC(PRACT)+1
      GO TO (10,60,70,80), PRACT
C
C **** HANDLE PONDS AND TILE-OUTLET TERRACES BY USING A TRAP EFFICIENCY
C **** APPROACH, FOR BOTH SEDIMENT AND WATER.
C
C **** CASE 1 IS FOR A PTO.
C
   10 TRAP=.90
C
C **** CHECK FOR A POSSIBLE SHADOW CHANNEL ELEMENT.
C
   20 IF (CHAN.EQ.0) GO TO 40
C
C **** IT'S A CHANNEL ELEMENT, DOES IT REQUIRE DIAGONAL FLOW?
C
      IF (ANG.LT..3926991.OR.ANG.GT.1.178097) GO TO 40
C
C **** FLOW IS DIAGONAL, CHANGE DESTINATION ELEMENT NUMBERS.
C
      IF (NR(I).LT.I) GO TO 30
      NR(I)=NC(I)+1
      NC(I)=NC(I)+1
      GO TO 40
   30 NR(I)=NC(I)-1
      NC(I)=NC(I)-1
C
C **** THE PREDOMINANT OVERLAND DIRECTION IS MAINTAINED AND THAT
C **** ELEMENT WILL RECEIVE THE UNTRAPPED FLOW AND SEDIMENT.
C
!RZ	basically, you determine which is the predominant flow direction (RFL lt/gt 0.5)
!RZ	if the row is the predominant direction (50), then set the row flow to 1-trap
!RZ	which is all the water that escapes from the BMP, NR remains the same, and NC becomes
!RZ	a dummy cell to capture the trapped water, sediment, etc.
!RZ	if the column is the predominant direction (40), then set the row flow to trap (leaving
!RZ	column flow as 1-trap) and channel all the row flow (aka flow trapped by BMP) to a dummy
!RZ	row cell.  All non trapped flow is channeled to the receiving column cell.
   40 IF (RFL.GT..5) GO TO 50
      RFL=TRAP
      NR(I)=NMAX+1+PRACT
      RETURN
   50 RFL=1.-TRAP
      NC(I)=NMAX+1+PRACT
      RETURN
C
C **** PONDS ARE SIMILAR TO PTO'S, BUT HAVE A HIGHER TRAP EFFICIENCY.
C
   60 TRAP=.95
      GO TO 20
C
C **** GRASSED WATERWAYS DIRECTLY AFFECT ONLY THE VEGETAGED AREA OF
C **** THE ELEMENT IN WHICH THEY ARE LOCATED, BUT THEY MUST ALSO ASSURE
C **** THAT THIS ELEMENT HAS A SHADOW CHANNEL ELEMENT.
C
   70 IF (CHAN.NE.0) GO TO 80
C
C **** CURRENT ELEMENT DOES NOT HAVE A SHADOW CHANNEL ELEMENT, MAKE ONE.
C
      CHAN=IEL(2,J,11)
      IF (CHAN.EQ.0) CHAN=1
      II=II+1
      CWID=WID(CHAN)
      PIV=CONST/CN(CHAN)/X*(DX/CWID/X)**.6667*DSQRT(SSI)
      SSII=SSI
      IF (SSI.LT.SCMIN) SCMIN=SSI
      IF (SSI.GT.SCMAX) SCMAX=SSI
      SCBAR=SCBAR+SSI
C
C **** NOW ACCOUNT FOR VEGETATED AREA BY REDUCING THE SEDIMENT
C **** DETACHMENT BY FLOW FOR THIS ELEMENT BY AN AMOUNT PROPORTIONAL
C **** TO THE VEGETATED AREA.  SINCE FLOW DETACHMENT IS DIRECTLY
C **** PROPORTIONAL TO THE OVERLAND SLOPE, ADJUST THAT PARAMETER.
C
C **** FIELD BORDERS HAVE A SIMILAR EFFECT TO THE VEGETATED AREA
C **** OF GRASSED WATERWAYS.
C
   80 TRAP=DBLE(IEL(2,J,10))/DX
      IF (TRAP.GT..5) TRAP=.5
      SL=SL*(1.-TRAP)
      RETURN
C
C **** CHECK TO SEE IF IT'S A MANAGEMENT PRACTICE BEFORE SPOUTING OFF.
C
   90 IF (PRACT.GT.10.AND.PRACT.LT.13) RETURN
	IF (PRACT.GT.6.AND.PRACT.LT.10) THEN
		BMPLOC=1
		IDUMMY=0
		DUMMY=0.
		CALL BMPS(BMPLOC,IDUMMY,IDUMMY,ADUMMY,DUMMY,DUMMY,DUMMY,DUMMY
	1	,IDUMMY,DUMMY,IDUMMY,IDUMMY,IDUMMY,IDUMMY,IDUMMY,IDUMMY,DUMMY,
     2	DUMMY,HASOPENED,CALLBMP,IDUMMY)
		RETURN
	END IF
!RZ	IF THE PRACTICE IS 7,8,9 THEN IT IS AN URBAN PRACTICE, RESERVE FOR FUTURE USE
!RZ	The subroutine call reads the bmp input file and does the preliminary calculations
!RZ	for later in the program.  Dummy variables are used for most of the parameters in the
!RZ	call because no outside data is needed for the initialization section of the bmp subroutine.
      WRITE (2,100) IEL(2,J,9),IEL(2,J,1),J
      RETURN
C
  100 FORMAT (14H  PRACTICE NO.,I3,7H IN ROW,I4,5H, COL,I4,20H ILLEGAL A
     1ND IGNORED)
C
      END


      SUBROUTINE DRAIN (DR,DC,DIN,N,N1,N2,STD,TIAL,RFL,NR,NC)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
C
C ****** SUBROUTINE FOR SUBSURFACE DRAINAGE.
C
      DIMENSION DR(35000), DIN(35000), RFL(35000)
      INTEGER NR(35000),NC(35000),TIAL(35000)
C
C **** SET ALL CHANNEL INFLOWS TO ZERO.
C
      DO 10 I=N1,N2
   10 DIN(I)=0.
      STD=0.
C
C **** ROUTE DRAINAGE FROM TILES.
C
      DO 50 I=1,N
      DRANE=0.
      IF (TIAL(I).LT.256) GO TO 40  !rwz no tiles
      IF (DR(I).GT.DC) GO TO 20	!rwz amount draining > drainage coefficent
      DRANE=DR(I)	!does this if amount draining all goes into drain
      GO TO 30
   20 DRANE=DC	!amount drained limited by drainage coefficient
   30 STD=STD+DRANE
   40 DRANE=DRANE+DIN(I)  
      DD=RFL(I)*DRANE
      J=NR(I)
      K=NC(I)
      DIN(J)=DIN(J)+DD
      DIN(K)=DIN(K)-DD+DRANE
   50 DIN(I)=0.
      RETURN
C
      END

      FUNCTION FILT(PIV,FCAP1,GWC,DR,S,R,CU2,ROUGH,HU,NEXP,ASMPER,
     & KE,PSIF,PHIC,T,CU,LF,KS,K,kk,M,CUMIN1,rbit0,testi,timpon,
     & TPON,FILTS,DT,CU1,TP1,AZRAT)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
      DOUBLE PRECISION NS,KE,KS,LF
C
C **** POTENTIAL INFILTRATION CAPACITY -- WHOLE SURFACE COVERED.
C     IF (T.LE.O.) GOTO 50
C
C **** UNSATURATED INFILTRATION ZONE.
C
************************************
*********************************
******EFFECTIVE MATRIX POTENTIAL
	NS=PHIC*(1.0-ASMPER)*PSIF
***************************************
 
 
**DETERMINE THE CUMULATIVE INFILTRATION USING THE NEWTON ITERATION
**TECHNIQUE
**KE*T=F-NS*LN(1+F/NS); G=(F-KE*T)-NS*LN((NS+F)/NS)
** DG/DF= 1-NS/(F+NS)=F/F+NS
** F2=F1-G1/(DG/DF1)
*      if(m.eq.503)write(6,*) filts/cu
*     if(R.lt.0.) stop
 
      if (t.eq.0.) then
	 fmax=r
	 testi=0
	 test1=10
	 goto 2
      endif
       T2=T
       rbit=r/cu
 
	  if ((r.eq.0.).and.(testi.eq.1).and.(s.lt.0)) then
	  fmax=filts
	  testi=0
	  goto 2
	  endif
 
       if((ke.gt.rbit).and.(testi.eq.1).and.(s.gt.0)) then
	  testi=1
	  goto 8
       else
	 if((ke.gt.rbit).and.(testi.eq.1).and.(s.lt.0)) then
	  testi=0
	  goto 2
	endif
       endif
 
      if(rbit0.eq.r) goto 111
 
 
      if((ke.le.rbit).and.(testi.eq.1)) then
		 testi=1
		test1=13
		 goto 8
      endif
 
 
       if((ke.gt.rbit).and.(testi.eq.0)) then
	  fmax=filts
	  if(r.gt.0.)fmax=r
	  testi=0
	  goto 2
	endif
 
	  if ((r.eq.0.).and.(testi.eq.1).and.(s.lt.0)) then
	  fmax=filts
	  testi=0
	  goto 2
	  endif
 
 
 
 
      cumpon=ns/((rbit/ke)-1.)
 
	if((cumpon-cumin1).lt.0.) then
	      timpon=t2
	      Tpon=60*((cumin1)-NS*DLOG(1.0+(cumin1)/NS))/KE
	      goto 112
	endif
 
      timpon=(cumpon-cumin1)*60./rbit+t2
      Tpon=60*((cumpon)-NS*DLOG(1.0+(cumpon)/NS))/KE
	 test1=15
 
      goto 112
 
111    continue
 
      if(testi.eq.1) goto 8
 
      if ((ke.ge.rbit).and.(testi.eq.0.)) then
	   fmax=filts
	   if(r.gt.0) fmax=r
	   testi=0.
	   timpon=0.
	   tpon=0.
	 test1=16
	   goto 2
      endif
 
 
 112  if(t2.lt.timpon) then
	   fmax=r
	   testi=0
*         test1=17
	   goto 2
      endif
 
 
  8    t1=t2-timpon+tpon
       if(t1.lt.0.) then
	fmax=filts
	goto 2
       endif
       testi=1.
 77    if(cumin1.gt.0) then
		cumf=cumin1
       else
		cumf=0.1
       endif
 88     ZU1=(T1/60.)*KE-(CUMF-NS*DLOG(1.0+CUMF/NS))
	DEL=CUMF/(NS+CUMF)
	TEST=ZU1/DEL
	XX=CUMF+TEST
	IF(ABS(TEST).GT.0.000001) THEN
	CUMF=XX
	IF ((CUMF/NS).LT.-1.) THEN
		CUMINF=0.01
	WRITE(*,*) 'The infiltration calc. cannot converge on a solution.' 
	WRITE(*,*) 'Cum. inf. has been set to 0.01.  If this is not okay,'
	WRITE(*,*) 'vary the soil input parameters until this message no'
	WRITE(*,*) 'longer appears.  Soil Porosity seems to be important.'
	WRITE(2,*) 'The infiltration calc. cannot converge on a solution.' 
	WRITE(2,*) 'Cum. inf. has been set to 0.01.  If this is not okay,'
	WRITE(2,*) 'vary the soil input parameters until this message no'
	WRITE(2,*) 'longer appears.  Soil Porosity seems to be important.'
		PAUSE
		GO TO 7
	END IF
       GOTO 88
       ENDIF
       CUMINF=CUMF
 
   7    CONTINUE
	FMAX=KE*(1+NS/CUMINF)*CU
	ZXA=FMAX/CU
	FILT=FMAX
 
*  2    rbit0 = rbit
   2    FILT=FMAX
*        if (m.eq.76) write(5,888)ke,r/cu,t,timpon,tpon,fmax/cu,testi,
*     & cumin1,cumpon,filts/cu,s/cu,t2
 888   format(12(f10.4,1x),f3.1,5(f10.4,1x))
       rbit0=r
       cumpon=0.
       test1=0.
       IF (PIV) 30,40,10
 
 10   IF (PIV.LT.GWC) GO TO 20
      DR=0.
      RETURN
 
********************************
 20     CONTINUE
	RKFC=KS*AZRAT*(1-PIV*DT/TP1)**(-2.655/DLOG10(FCAP1))
	TI=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)/RKFC
*        computing drainage for one hour
      ZFAY=1./TI
      IF(ZFAY.GT.75.) TI=1./75.
 
	DR=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)*(1.-DEXP(-1/(TI)))*CU
	ASMFI=(1-PIV*DT/TP1)*TP1/CU1

	RETURN
********************************
C
C **** INFILTRATION ZONE SATURATED.
C
  30  PIV=0.
  40  RKFC=KS*AZRAT*(1-PIV*DT/TP1)**(-2.655/DLOG10(FCAP1))
      TI=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)/RKFC
      ZFAY=1./TI
      IF(ZFAY.GT.75.) TI=1./75.
	DR=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)*(1.-DEXP(-1./(TI)))*CU
 
      FMAX=DR
      FILT=FMAX
       testi=1
      RETURN
C
      END

      FUNCTION RAIN(RATE,PIT,PER)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
C
C ****** DETERMINATION OF NET RAINFALL RATE.
C
	IF (RATE.EQ.0.) GO TO 50
	
	IF (PIT) 40,50,10
!WB	IF (PIT) < = > 0, GOTO 40, 50, 10
   10 RIT=PER*RATE
!RZ	RIT=rainfall rate*percent vegetative cover; i.e., RIT=rainfall rate on plants
      IF (RIT-PIT) 20,30,30
!WB	IF (RIT-PIT) < = > 0, GOTO 20, 30, 30
!RZ	i.e.,if interception > rainfall, =rainfall, or <rainfall
!RZ	meaning, respectively, no effective rainfall under plants, interception capacity filled,
!RZ	and interception capacity exceeded so rainfall goes to soil under plants
   20 RAIN=RATE-RIT
      PIT=PIT-RIT
      RETURN
   30 RAIN=RATE-PIT
      PIT=0. !rz reassigned to zero because capacity filled
      RETURN
   40 PIT=0.
   50 RAIN=RATE
      RETURN
      END
C
C
CC.......SHIELDS DIAGRAM EXTENDED BY MANTZ (1977)................
C
      FUNCTION SHIELD(REYN)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
      IF(REYN.LE.  1. ) GO TO 30
      IF(REYN.LE.  6.0) GO TO 40
      IF(REYN.LE. 20. ) GO TO 50
      IF(REYN.LE.450. ) GO TO 20
  10  CONTINUE
      SHIELD=.06
      RETURN
  20  SHIELD=DEXP(-3.9793+.19212*DLOG(REYN))
      RETURN
  30  SHIELD=.1*REYN**(-.3)
      RETURN
  40  SHIELD=DEXP(-2.3026-.5546*DLOG(REYN))
      RETURN
  50  SHIELD=0.033
      RETURN
      END
C
      SUBROUTINE SED(XZW,XR,DT,XDIR,M,N,KK,DX,N2)
!WB	XZW = element or channel width, XR = net rainfall rate for raingage
!WB	i on surface type j, DT=TIME INCREMENT, XDIR = retention depth 
!WB	for cropping practice i, M = element # counter, N = # overland flow 
!WB	elements, KK = soil type for current element, DX = length of side
!WB	of square element,N2=# OF O.F. CELLS + CHANNEL CELLS      
	IMPLICIT DOUBLE PRECISION A-H,O-Z
C
 
C *** NRZ 9/15/94
C *** VARIABLES ARE CHANGED TO REFLECT NMAX+ISTRUC+1+NCHAN
!WB	NMAX = max # of cells, ISTRUC = counter for structural practices(+1)
!WB	NCHAN = # channels
	INTEGER YERBEG

	COMMON FLAG

      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
      
	COMMON /ZSEDI/ NPART,NWASH,NWASH1
      COMMON /ZSEDR/ VISCOS,AGRAV,SWH2O,YALCON,SE(8),VS(35000),DIA(8),
     1SG(8),FV(8),CY1(8),CY2(8),CY4(8),DIAMM(8),EQSDIA(8),EDMM(8),
     2F(30,8),CE1,CE2,CE3,CE4,CE5,CE6
!WB	Changed F(10,8) to F(30,8) to accomodate 30 soil types
C
      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
C
C *** NRZ 9/15/94
C NRZ 9/5/94
C ADDED VARIABLES FOR CHANNEL NETWORKS
 
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)
	INTEGER CHNUM,CHOUT,CHNUMBER

C NRZ 9/5/94

      DIMENSION SE1(8),SE2(8),DELTA(8),PS(8),TF(8),TFMSE2(8)
     *,DS1(8),DS2(8),S22(8)

!WB	THE NEXT 4 LINES WERE ADDED/INCLUDED FOR THE NEW
!WB	SEDIMENT SUBROUTINE
      DIMENSION FILTS(35000), CWID(35000),CWIDTMP(35000)
      COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
      INTEGER SUR,TIAL(35000),RANE,SOIL
      

!WB	BEGINNING OF NEW VARIABLES FOR NEW DETACHMENT ROUTINES
!WB	soil variables:
	COMMON/SOILVAR/CLAY(30),SAND(30),SILT(30),VFSPER(30),VFS(30),
	1ORGMAT(30),MASSCF(30),RANROU(30),RANROUM(30)
	DOUBLE PRECISION MASSCF

!WB	rill erodibility variables:
	COMMON/RILLVARS/KRBASE(35000),KRBR(35000),BR(20),BURRES(20),
	1KRADJHLD(35000),KRCONS(35000),KRSC(35000),KRADJ(35000)
	DOUBLE PRECISION KRBASE,KRBR,KRADJHLD,KRCONS,KRSC,KRADJ

!WB	critical shear variables:
	COMMON/CRTSHEAR/TAUCB(35000),TAURR(35000),TAUCHLD(35000),TAUCONS
	1(35000),TAUSC(35000),TAUCADJ(35000),TAUEFF
	
!WB	interrill erodibility variables:
	COMMON/IRILLVARS/KIBASE(35000),KICAN(35000),KIGRCOV(35000),KICONS
	1(35000),KISC(35000),KIADJ(35000),CANOPY(20),AUCFACT(20),
     2HEIGHT(20),MAXPLHGT(20),HGTFACT(20),GROWFACT(20)
	DOUBLE PRECISION KIBASE,KICAN,KIGRCOV,KICONS,KISC,KIADJ,MAXPLHGT
	
!WB	interrill cover common block:
	COMMON /IRILLCOV/ INRCOV(20),INRCOVI(20),INRCOVF(20),INRFACT(20),
	1LROOT(21),DROOT(21),KDROOTI(35000),KLROOTI(35000),DDROOTI(21),
	2DDROOTF(21),DDRTFAC(21),LRFAC(21),LIVEROOT(21),KDROOTR(35000),
	3KLROOTR(35000)
	
	DOUBLE PRECISION INRCOV,INRCOVI,INRCOVF,INRFACT,LROOT,KDROOTI,
	1KLROOTI,LRFAC,LIVEROOT,KDROOTR,KLROOTR

!WB	rill erosion variables:
	COMMON/RILLEROS/NORILLS,RILLSPC(20),QEFF,RILLWID,MNSOIL(21),
     1MNTOT(21),FLOWDEP,HYDRAD,DCAP,FCFRAC(30),FOFD,FPOFD,FDPOFD,
	2FLDEPOLD,MNCHNSL(35000),MNCHNTOT(35000),MNCS(30),MNCT(30),MNCSTMP
	3(35000),MNCTTMP(35000),MAXWID,NOTILL(21),NOEROS(21),DWSOIL,
	4HYDRADOLD(35000)
	DOUBLE PRECISION MNSOIL,MNTOT,MNCHNSL,MNCHNTOT,MNCS,MNCT,MNCSTMP,
	1MNCTTMP,NORILLS,MAXWID

!WB	interrill erosion variables
	COMMON /IRILLEROS/RNOFIR,SEDDR(35000,8),DIINT(35000,8),DETR(8)
	1,DETF(8),DACT(35000,8)

!WB	PLANT GROWTH VARIABLES
	COMMON /PLANTS/ DAYNOW(35000),YEARNOW(35000),DYYRNOW
	1(35000),DAYTHEN(35000),YEARTHEN(35000),DYYRTHEN(35000),
     2DAYDIFF(35000),BEGROTDT(35000)

!WB	CHANNEL BOTTOM EROSION VARIABLES	
	COMMON /CHANEROS/WIDINC(35000),DOWNRATE(35000),
	1DEPTHINC(35000),IMPERM(30),ROCKBOT(35000),RBTEMP(35000),
     2BULKDENS(30),CHNSOIL(35000),CHNSL(35000),CHNSLTMP(35000)
	3,DEPRATE(35000),DEPPREV(35000),CONSTHLD(35000),XHOLD(35000)
     4,CONSTTMP(35000),XTMP(35000)

	COMMON /ARMOUR/ARMOUR(35000),NOERODE(35000)
	1,NERODTMP(35000)

!WB	HYDROGRAPH PLOT VARIABLES
	COMMON /HYPLT/PRINHYD,IMPFLAG,QHYP(101,10),PHYP(101,10)
	1,DPHYP(101,10),A4SHYP(101,10),A4DHYP(101,10),ONHYP(101,10)
	2,A3HYP(101,10)
	CHARACTER(11) HYPNAM(10)

	DOUBLE PRECISION DIFF,RGTSID,LFTSID,IMPERM,NOERODE,NERODTMP

	INTEGER CNT,CNTER,CNTFLAG,NOTILL,INIT,NOEROS,CHNSL,CHNSOIL,
	1CHNSLTMP,PRINHYD
!RZ FOLLOWING ARE FOR MY NEW VARIABLES IN THIS SUBROUTINE
	DIMENSION FLOWDEPOLD(35000)
	DOUBLE PRECISION FLOWDEPOLD

	DIMENSION NEC(35000)

	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB

	DIMENSION A1DUMMY(3,300,24), A2DUMMY(35000), A3DUMMY(35000),
	1A4DUMMY(20,2),A5DUMMY(3,300,2)
	INTEGER A1DUMMY, A2DUMMY

	CHARACTER*4 CDUMMY,A4DUMMY
	CHARACTER*2 A5DUMMY
	DATA CDUMMY/'    '/


!WB	Sediment Erosion routine information:  Some equations and
!WB	calculations in the sediment subroutine are not placed in the
!WB	location that will allow optimal calculation efficiency.  This is
!WB	recognized, and was done in order to ease understanding of the 
!WB	methodology at the cost of computational efficiency.

!WB	END OF NEW VARIABLES FOR NEW DETACHMENT ROUTINES

!RZ	URBAN:::THERE IS AN ENTIRE SEPARATE SUBROUTINE FOR URBAN SEDIMENT
!RZ	SO GO THERE IF IT IS AN URBAN CELL
	IF(URB(M).EQ.1) THEN 
		URBAN=4
		IDUMMY=0
		DUMMY=0.
		CALL URBANIZED(URBAN,IDUMMY,IDUMMY,A1DUMMY,IDUMMY,IDUMMY,IDUMM
	1Y,IDUMMY,M,IDUMMY,CDUMMY,IDUMMY,CDUMMY,A3DUMMY,A5DUMMY,DX,XZW,XR,D
     2T,XDIR,N,N2,A2DUMMY,A2DUMMY,A4DUMMY)
		GO TO 410
	END IF

     
	NP=1
	
      IF(Q(M).GT.0.) GO TO 30
!WB	if the outflow from element i at start of time increment is
!WB	greater than 0, then jump on down to 30

C
C.......NO OUTFLOW, ALL SEDIMENT ASSUMED DEPOSITED............
C
      GO TO 10

    5 NP=NWASH1
!WB	you are sent to line 5 after line 50 if the summation of deltas 
!WB	is less than 0

   10 CONTINUE
      DO 20 IC=NP,NPART
!WB	the first time through, the IC=NP is =1, so this loop is performed
!WB	from 1 until the # of particle size classes
	SEL(M)=SEL(M)+.5*(SST(M,IC)+SI(M,IC))
!WB	accum sed in el i for a storm = same + 0.5*(sum of initial values in
!WB	sedi. continuity eqn + rate of sediment inflow into el i from 
!WB	adjacent elements)
 	SST(M,IC)=SI(M,IC)
!WB	sum of initial values in sediment continuity equation is equal to 
!WB	the rate of sediment inflow into element i from adjacent elements
!WB	the M, IC denotes the element # we are going through and the particle
!WB	size class #
!WB	the previous two lines indicate that the sed accum in an element is
!WB	equal to the accum sed from the previous time step + 0.5 (the sed 
!WB	inflow from the prev time step + sed inflow at current time step)
*DETERMINING THE NEWLY GENERATED SEDIMENT

	SEDNEW(M,IC)=0.
!WB	rate of new erosion occurring in cell for a particle class i (kg/sec)
!WB	and M,IC is element #, particle size class #
	STNEW(IC)=0.
!WB	soil storage for particle class i

C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=0.
!WB	rate of sediment movement from an element for this particle size 
!WB	(kg/s) class is equal to 0

C *** NRZ END
   20 CONTINUE
!WB	this is the end of the first section loop that sets the sediment
!WB	continuity equation for the cells equal to the sediment inflow
!WB	and then sets the new sed generated in cell equal to 0

      IF(NP.EQ.NWASH1.AND.NWASH.NE.0) GO TO 65
!WB	NWASH = # washload particle size classes, NWASH1 = NWASH+1
!WB	NWASH1 is a counter for particle size classes that are settleable
!WB	(remember that washload particles (NWASH) are not settleable unless
!WB	flow is 0), so if there are for example 5 particle size classes,
!WB	and two of those are settleable, then NWASH1 to NPART is a count
!WB	of settleable particles 
!WB	this sends you down to do washload calculations
      RETURN
C
C.......OUTFLOW...............................................
C
   30 CONTINUE
      SMDIR=S(M)-XDIR
!WB	 = storage at start of time increment for el i - ret. depth for 
!WB	cropping practice i (m3/s)
!WB	I think that this says that the amount of storage at the start
!WB	of the time increment minus the ret depth, so this tells if there
!WB	is water available to runoff
!RZ	SMDIR = Storage Minus xDIR
      IF(SMDIR.LE.0.) GO TO 10
!WB	if the above var is less than or equal to 0, then jump back up
!WB	and redo the intialization of the cont eqn, sed gen var.'s
!WB	so, from above, if there is no runoff, you jump back up and calc.
!WB	the sediment inflow into a cell, and reset the continuity eqn
!WB	equal to inflow to the cell

C
C.......CALCULATE TRANSPORT CAPACITY FOR EACH ...........
C................PARTICLE SIZE CLASS.....................
C
      SDEL=0.
!WB	summation of delta = 0
!WB	essentially, delta is the dimensionless excess of the tractive 
!WB	force, and Yalin made the assumption that the # of particles in
!WB	transport was equal to a linear function of delta
      VSTAR=VS(M)*DSQRT(SMDIR)
!WB	shear velocity = simplification var * sqrt(storage-ret. depth)
!WB	in the text, Vstar = (g R S)^0.5, where g is gravity, R is 
!WB	hydraulic radius assumed equal to flow depth, S is slope of 
!WB	the energy gradeline
!WB	
      CY5=VSTAR*XZW
!WB	simplifying constant = shear vel * element or channel width
!WB	
      DO 50 IC=NWASH1,NPART
!WB	
	REYN=CY1(IC)*VSTAR
!WB	constant(NWASH1)*shear velocity
!WB	this appears to be the Reynold's # calculation for the particle size
!WB	class
	YCR=SHIELD(REYN)
!WB	dimensionless critical shear = shields function of reynolds #

	DELTA(IC)=VSTAR**2/(CY2(IC)*YCR)-1.0
!WB	variable = shear vel^2 / [const(NWASH1)*dimensionless crit shear)-1
!WB	dimensionless excess of the tractive force = shear velocity^2 / 
!WB	simplifying constant (particle size class) * dimensionless critical
!WB	shear) - 1.0
	IF(DELTA(IC).LE.0) GO TO 45
!WB	if the dimensionless critical shear is less than or equal to 0	
!WB	then jump down to line 45 because there is no transport
	SIGMA=1.65908*DELTA(IC)*DSQRT(YCR)
!WB	sigma = 1.65098*delta(NWASH1)*DSQRT(dimensionless crit shear)
!WB	sigma is unnamed, and this equation differs from the paper by the 
!WB	factor 2.45*particle spec grav^-0.4, whereas this equation has the
!WB	constant 1.65908
!RZ	1.65908=2.45*2.65^(-0.4); particle specific gravity is assumed 2.65 in ANSWERS
	PS(IC)=YALCON*DELTA(IC)*(1.-DLOG(1.+SIGMA)/SIGMA)
!WB	variable = Yalin's constant*delta*(1-natural log(1+sigma)/sigma)
!WB	PS is unnamed, however this is used in the trans cap equation
!WB	from the paper
	SDEL=SDEL+DELTA(IC)
!WB	summation of delta = sum + delta
!WB	this is important because it is assumed that for a mixture, the # 
!WB	of particles of a size i in transport is proportional to delta i
	GO TO 50
  45    CONTINUE
	DELTA(IC)=0.
!WB	this one is where you are sent if Y<= Ycr (shear stress < crit value)
	PS(IC)=0.
!WB	essentially sets the transport capacity equal to 0
  50  CONTINUE
      IF(SDEL.LE.0.) GO TO 5
!WB	if the summation of delta is <= 0, go on back to the top to 
!WB	reapportion inflow and sum the sediment continuity eqn
      DO 60 IC=NWASH1,NPART
!WB	reset the count variable IC equal to the NWASH1 variable, and add
!WB	it up to number of particle size classes
	TF(IC)=PS(IC)*DELTA(IC)/SDEL*CY5*CY4(IC)
!WB	transport cap = var * delta / sum delta * const * const
!WB	this says that the transp cap is a function of the ratio of the 
!WB	amount of dimensionless critical shear of this particle size class
!WB	to the summed delta of all particle size classes.
  60  CONTINUE
C
  65  CONTINUE
!WB	you are sent here from above if nwash not equal 0 and NP 
!WB	equals NWASH1
      AREA=DX*XZW
!WB	area = length of size * el or channel width
!      IF(M.GT.N) GO TO 70
!WB	if element # counter > # overland flow el's, THIS ORIGINALLY RESET
!WB	THE FLOW AND RAINFALL DETACHMENT EQUAL TO 0.  NOW, THE RAIN-
!WB	FALL DETACHMENT IS RESET TO 0, WHILE FLOW DETACHMENT IS CALCULATED
!WB	FOR CHANNEL CELLS.
C
CC....CALCULATE RAINFALL DETACHMENT & POTENTIAL FLOW DETACHMENT....
C
!WB	************* NEW SEDIMENT DETACHMENT ROUTINE *****************
!WB	********************* flow detachment *************************
	JK=MOD(SUR(M),256)
!WB	jk extracts the crop descriptor #=cover type
	IF (M.GT.N) GO TO 9400

!WB	THIS SKIPS THE RILL WIDTH CALCULATION IF THE CELL IS A CHANNEL CELL.
	IF (RILLSPC(JK).EQ.0) RILLSPC(JK)=1.
!WB	ADDED 1/6/99 AS A DEFAULT.
	NORILLS=DX/RILLSPC(JK)
!WB	norills=the number of rills per cell.  
	QEFF=Q(M)/(NORILLS)	
!WB	effective flow = total flow on cell / # of rills per cell,
!WB	this should be flow per rill contributing area (the rill plus
!WB	the interrill area that contributes flow to the rill)
	RILLWID=1.13*QEFF**0.303
!WB	rillwid=rill width, see 1995 WEPP documentation, eqn 10.7.1
	IF (RILLWID.GT.MAXWID) THEN
!WB	THE MAX WIDTH IS SET EQUAL TO A VERY SMALL # RIGHT AFTER
!WB	A CROPPING ROTATION CHANGES (INDICATING OBLITERATION OF RILLS)
!WB	AND CONTINUES TO WIDEN DURING THE CROP GROWTH PERIOD.
	MAXWID=RILLWID
!WB	IF THE CURRENT RILLWID EXCEEDS THE MAXWID, THEN SET MAX = CURRENT
	ELSE
	RILLWID=MAXWID
!WB	IF A PREVIOUS WIDTH IS GREATER, THEN SET CURRENT = MAX WIDTH
	ENDIF
	IF (RILLWID.GT.RILLSPC(JK)) THEN
!WB	THIS IS A FLAG TO INDICATE THAT THE RILL WIDTH OF AN O.F. CELL IS
!WB	GREATER THAN RILL SPACING (I.E.-MORE
!WB	RILL THAN YOU HAVE SPACE.) 
	NORILLS=NORILLS/2
	RILLSPC(JK)=RILLSPC(JK)*2
	END IF

	IF (RILLWID.GT.RILLSPC(JK)) THEN 	
	WRITE (2,1000) M,RILLWID,RILLSPC(JK)
	WRITE (*,1000) M,RILLWID,RILLSPC(JK)
	PAUSE
	ENDIF
 9400 CONTINUE
	IF (M.GT.N) THEN
	QEFF=Q(M)
	RILLWID=XZW+WIDINC(M)
	JK=21
	MNSOIL(JK)=MNCHNSL(M)
	MNTOT(JK)=MNCHNTOT(M)
	NORILLS=1.
	IF (MNSOIL(JK).GT.MNTOT(JK)) THEN
	WRITE (2,1002) 
	WRITE (*,1002) 
	STOP
	ENDIF
!WB	IF THE CELL IS A CHANNEL CELL, THEN SET THE QEFF EQUAL TO FLOW 
!WB	RATE, AND RILLWID=CWID (PASSED AS XZW IN THE SUBROUTINE CALL),
!WB	IF THE CELL IS DESIGNATED NOEROS THEN SET THE WIDTH INCREASE = 0
!WB	THEN SET JK=21, WHICH IS THE LAST POSITION
!WB	IN THE ARRAY MNSOIL, AND USE THIS POSITION TO HOLD THE FRICTION 
!WB	FACTOR FOR EACH CHANNEL CELL.  SAME GOES FOR MNTOT.  FINALLY, THERE'S
!WB	AN ERROR STATEMENT IF MNSOIL EXCEEDS MNTOT.
	ENDIF
	DIFF=1.
	FLDEPOLD=1.0
	FLOWDEP=FLOWDEPOLD(M)
!	FLOWDEP=1.0
	CNTER=0
	CNTFLAG=100
	DEPINIT=0
	DWSOIL=(MNTOT(JK)*MNTOT(JK)*8*9.80665)/(HYDRADOLD(M)**0.33333333)
	IDAYOLD=0
	IF (DWSOIL.GT.10) THEN
	DWSOIL=10
	ENDIF
	IF (DWSOIL.LT.0.1) THEN
	DWSOIL=0.1
	ENDIF
!WB	SET THE INITIAL CONDITIONS FOR THE ITERATION.  THE ITERATION IS 
!WB	THE NEWTON-RAPHSON METHOD FOR MULTIPLE ROOTS PER 'NUMERICAL 
!WB	METHODS FOR ENGINEERS, 2ND ED.' BY CHAPRA AND CANALE, 1988, 
!WB	MC-GRAW HILL.
!WB	THE EQUATION IS THE DARCY-WEISBACH FRICTION FACTOR EQN, SOLVED
!WB	FOR THE HYD RAD, AND THEN SET EQUAL TO THE DEFN OF HYD RAD AND 
!WB	SOLVED FOR FLOW DEPTH.  AN INITIAL GUESS OF DWSOIL IS REQUIRED.
!WB	IT HAS BEEN ARBITRARILY SET TO = 0.1.  IT IS THEN CALCULATED
!WB	BASED ON THE MANNING'S N AND HYD RADIUS.
	IF (QEFF.LT.0.00001) THEN
	QEFF=0
	FLOWDEP=0
	GOTO 9005
	ENDIF
!WB	THIS WAS ADDED 1/5/99 AFTER SOME DIFFICULTIES IN THE SOLUTION 
!WB	TECHNIQUE IN SOLVING FLOWDEPTH FOR CHANNELS WITH VERY LOW QEFF
!WB	(LESS THAN 1e-8).  THE EXACT PROBLEM WAS UNDETERMINED, HOWEVER
!WB	THE SOLUTION TECHNIQUE WAS PROVEN FOR THE SAME PARAMETER VALUES
!WB	THAT CAUSED THE ERROR USING A SPREADSHEET WITH THE SAME ITERATION,
!WB	SO THE ERROR IS LIKELY DUE TO ROUNDING.
	DIFFLIMIT=0.00001
 9001	DO WHILE ((DIFF.GT.0.00001).OR.(FLOWDEP.LT.0))
!WB	DO THIS WHILE THE DIFFERENCE IN FLOW DEPTH B/T THIS CALC AND 
!WB	THE PREVIOUS CALCULATION IS GT 0.0001, AND WHILE THE FLOWDEPTH
!WB	IS NEGATIVE.  THE SECOND PART IS NECESSARY B/C THIS TECHNIQUE WILL
!WB	SOMETIMES PRODUCE NEGATIVE VALUES IN THE FIRST FEW ITERATIONS.	
	IF (CNTER.EQ.0) THEN
!WB	THIS SECTION SAVES THE INITIAL VALUES IN CASE THE ITERATION DOESN'T
!WB	CONVERGE.  IF AFTER 100,200,300,500 ITERATIONS W/O CONVERGENCE, THE 
!WB	ITERATION IS RETRIED WITH DIFFERENT INITIAL CONDITIONS.  IF, AFTER
!WB   10,000 ITERATIONS, THERE IS NO CONVERGENCE, THE PROGRAM CALLS AN 
!WB	ERROR MESSAGE AND STOPS.
	FLDEP=FLOWDEP
	RLWID=RILLWID
	DIF=DIFF
	FLDOLD=FLDEPOLD
	ENDIF

	FOFD=((FLOWDEP**3)*(RILLWID**3)*8*9.80665*SL(M))-(DWSOIL
	1*(QEFF**2)*2*FLOWDEP)-(DWSOIL*(QEFF**2)*RILLWID)
!WB	FOFD=f(FLOWDEP)
	FPOFD=(3*(FLOWDEP**2)*(RILLWID**3)*8*9.80665*SL(M))-(DWSOIL*
	1(QEFF**2)*2)
!WB	FPOFD=f'(FLOWDEP)
	FDPOFD=(6*FLOWDEP*(RILLWID**3)*8*9.80665*SL(M))
!WB	FDPOFD=f''(FLOWDEP)
	FLOWDEP=FLDEPOLD-((FOFD*FPOFD)/((FPOFD**2)-FOFD*FDPOFD))
!WB	Xi+1=Xi-((f(D)*f'(D))/(f'(D)^2-f(D)*f''(D))) WHERE D = FLOWDEPTH
	DIFF=ABS(FLOWDEP-FLDEPOLD)
!WB	DIFF=TEST VARIABLE FOR THE LOOP.
	FLDEPOLD=FLOWDEP
!WB	SET THE FLDEPOLD=FLOWDEP FOR THIS CALCULATION.
	CNTER=CNTER+1


	IF (CNTER.GT.10000) THEN
!WB	THIS DISPLAYS AN ERROR MESSAGE IF, AFTER 10000 ITERATIONS,
!WB	THE EQUATION DOES NOT CONVERGE.
!	FLOWDEP=FLOWDEPOLD(M)
	FLOWDEP = ABS(DEPTHINC(M))
	DIFF=0.0
	IF (LDAY.NE.IDAYOLD) THEN
		IDAYOLD=LDAY
		WRITE(2,*) M,LDAY,FLDEPOLD
	END IF
!	WRITE (2,1004) M,QEFF,RILLWID,SL(M),DWSOIL,FLDEPOLD
!	WRITE (*,1004) M,QEFF,RILLWID,SL(M),DWSOIL,FLDEPOLD
!	STOP
	ENDIF
	
	IF (CNTER.EQ.CNTFLAG) THEN
!WB	THIS RESTARTS THE CALCULATION WITH DIFFERENT INITIAL CONDITIONS
	DEPINIT=DEPINIT+0.10
	DIFFLIMIT=DIFFLIMIT+0.0000999
!	FLOWDEP=10.-DEPINIT
!	FLOWDEP=(QEFF*MNTOT(JK)/(DSQRT(SL(M))*RLWID))**(3./5.)-DEPINIT
	FLOWDEP=DEPINIT
	RILLWID=RLWID
	DIFF=DIF
	FLDEPOLD=DEPINIT
	CNTFLAG=CNTFLAG+100
	GO TO 9001
	ENDIF
	END DO

	FLOWDEPOLD(M)=FLOWDEP
!RZ	THIS WAS INSERTED 2/06/01.  NOW THE SUBROUTINE WILL USE FLOWDEP AS
!RZ	AN INITIAL GUESS FOR THE NEXT TIME STEP.  THIS WILL HELP NEWTON'S METHOD
!RZ	TO CONVERGE MORE QUICKLY THAN BEFORE.
	IF (FLOWDEP.LT.0) THEN
!WB	FLOWDEPTH CALCULATION ERROR MESSAGE, WHICH IS LIKELY DUE TO PROGRAM
!WB   ERROR, SUCH AS AN ARRAY THAT HAS "OVER-FLOW'ED".
	WRITE (2,1006) M,FOFD,FPOFD,FDPOFD,FLOWDEP,FLDEPOLD,RILLWID,QEFF,
	1SL(M),DWSOIL,DIFF
	WRITE (*,1006) M,FOFD,FPOFD,FDPOFD,FLOWDEP,FLDEPOLD,RILLWID,QEFF,
	1SL(M),DWSOIL,DIFF
	STOP
	ENDIF
 9005	CONTINUE
 9006	HYDRAD=(FLOWDEP*RILLWID)/(2*FLOWDEP+RILLWID)
!WB	hydrad= hydraulic radius

	HYDRADOLD(M)=HYDRAD
!WB	SAVE THE HYDRAD FOR THE DWSOIL CALC THE NEXT TIME STEP	
      IF (HYDRADOLD(M).EQ.0) HYDRADOLD(M)=0.1
!WB	IF QEFF = 0 , HYDRAD = 0, & DWSOIL IS DIV BY 0, SO RESET HYDRADOLD=0.1
	TAUEFF=9806.65*SL(M)*HYDRAD*((MNSOIL(JK)*MNSOIL(JK))
	1/(MNTOT(JK)*MNTOT(JK))) 
!WB	taueff = effective shear stress,9806.65 (kg*m-2*s-2) = 
!WB	specific weight of water
!WB	sl(M) is the element slope in m/m
!WB	degrees.  MNSOIL is the manning's n friction factor for 
!WB	the bare soil, while MNTOT includes the factor for cover.


	IF (TAUEFF.GT.TAUCADJ(M)) THEN
	DCAP=KRADJ(M)*(TAUEFF-TAUCADJ(M))*(NORILLS*RILLWID*DX)
!WB	THE ABOVE LINE SAYS THAT RILL DETACHMENT EQUALS THE DETACHMENT
!WB	CAPACITY TIMES THE RILL CONTRIBUTING AREA 
!RZ	Detachment CAPacity - see equation 16 in Wes Byne's thesis
	IF (M.GT.N) THEN
	DCAP=DCAP*(1-ARMOUR(M))
!WB	DETACHMENT CAPACITY IN A CHANNEL IS EQUAL TO DETACHMENT 
!WB	CAPACITY TIMES THE AMOUNT OF THE CHANNEL SOIL THAT IS 
!WB	ERODIBLE (ARMOUR IS THE NONERODIBLE PERCENTAGE)
	DOWNRATE(M)=(KRADJ(M)*(TAUEFF-TAUCADJ(M))/BULKDENS(KK))*
	1(1-ARMOUR(M))
!WB	DOWNRATE=RATE OF EROSION OF THE CHANNEL BOTTOM (M/S)	
	DEPRATE(M)=(DEPPREV(M)/BULKDENS(KK))/XZW
!WB	THIS IS THE DEPOSITION RATE AT THE PREVIOUS TIME STEP, USED
!WB	TO ADJUST THE DEPTHINC VAR FOR DEPOSITION.  THE CALCULATION IS:
!WB	((KG/S)/(KG/M^3)) / M WIDTH, ASSUMED 1 METER LENGTH ALONG 
!WB	CHANNEL BOTTOM, YIELDS UNITS M/S
	DEPTHINC(M)=DEPTHINC(M)+(DOWNRATE(M)*DT)-(DEPRATE(M)*DT)
!WB	DEPTHINC=DEPTH THAT THE CHANNEL BOTTOM HAS ERODED (METERS)
	IF (DEPTHINC(M).GT.ROCKBOT(M)) DEPTHINC(M)=ROCKBOT(M)
!WB	IF THE ERODED DEPTH IS GREATER THAN THE NONERODIBLE BOUNDARY,
!WB	THEN BOTTOM EROSION IS RESET EQUAL TO THE NONERODIBLE DEPTH,
!WB   THIS ALLOWS FOR DEPOSITION TO LESSEN THE ERODED DEPTH 
!WB   "INCREMENT".  IF DEPTHINC > NONERODIBLE DEPTH, EROSION 
!WB	SWITCHES TO THE WALLS
	DEPRATE(M)=0.
!WB	THIS MAKES SURE THAT AN 'OLD' VALUE OF DEPOSITION DOESN'T 
!WB	AFFECT CALCULATIONS
	IF (DEPTHINC(M).GE.ROCKBOT(M)) THEN
!WB	IF THE ERODED DEPTH IS G.E. THE DISTANCE TO AN IMPERMEABLE LAYER
	WIDINC(M)=WIDINC(M)+DOWNRATE(M)*DT
!WB	WIDINC=WIDTH THAT THE CHANNEL HAS ERODED.  NOTE THAT THE EROSION 
!WB	RATE IS THE SAME FOR DOWNWARD MOVEMENT AS FOR LATERAL MOVEMENT.
	DCAP=KRADJ(M)*(TAUEFF-TAUCADJ(M))*(2*FLOWDEP*DX)
!WB	BECAUSE THE CHANNEL BOTTOM IS CONSIDERED UNERODIBLE, DETACHMENT
!WB	CAPACITY IS CALCULATED ALONG THE CHANNEL WALLS,AND NORILLS=1.
!WB	RATE IS (KG/S)	
	DCAP=DCAP*(1-ARMOUR(M))
!WB	DETACHMENT CAPACITY TIMES THE ERODIBLE FRACTION OF SOIL (THIS
!WB	WAS INCLUDED FOR WALL EROSION TO SIMULATE LOWERED ERODIBILITY
!WB	OF CHANNEL SOIL)
	ENDIF
	ENDIF
	ELSE
	DCAP=0.
!WB	IF THE EFFECTIVE SHEAR STRESS DOESN'T EXCEED THE BASELINE, THERE
!WB	IS NO RILL DETACHMENT.
	ENDIF
	DO IC=1,NPART
	IF ((SST(M,IC).GT.TF(IC)).OR.((SST(M,IC).GE.0).AND.
	1(TF(IC).LE.0))) THEN
!WB	IF THE SED IN TRANSPORT IS GT TRANS CAP, YOU WILL HAVE
!WB	A NEGATIVE DCAP, SO SET DACT=0
!RZ	DACT=ACTual Detachment
	DACT(M,IC)=0
	ELSE
	DACT(M,IC)=DCAP*(1-(SST(M,IC)/TF(IC)))
!RZ	see equation 17 in Wes Byne's thesis.
	END IF

	IF (DACT(M,IC).GT.DCAP) THEN
!WB	THIS WOULD OCCUR IF THERE WAS A PROGRAM ERROR, FOR INSTANCE IF AN
!WB	ARRAY OVERFLOWED.
	WRITE (2,1008) DACT(M,IC),M,IC,DCAP
	WRITE (*,1008) DACT(M,IC),M,IC,DCAP
	STOP
	ENDIF
	END DO
 	IF (DACT(M,IC).GT.10) THEN
!WB	JUST A GENERAL ERROR CHECK, DACT IS IN KG/S
	WRITE (*,*) 'DACT(M,IC) GT 10',DACT(M,IC),M,IC
	PAUSE
	ENDIF
	IF (M.GT.N) GO TO 9405
!WB	IF ITS A CHANNEL CELL, THEN JUMP DOWN TO CHANNEL DETACHMENT
!WB	**************** Rainfall detachment **********************	
	RNOFIR=QEFF/(DX*RILLSPC(JK))
	IF (RNOFIR.GT.1) THEN
!WB	GENERAL ERROR CHECK
	WRITE (2,*) 'RNOFIR EXCEEDS 1',M
!	PAUSE
!RZ	PAUSE COMMENTED OUT AND MSG WRITTEN TO OUTPUT FILE SO THE THING WILL RUN 11/11/01
	ENDIF
!WB	rnofir=interrill runoff rate, assumed equal to the effective runoff
!WB	rate per rill / (flow length*distance b/t rills).  This equals the
!WB	flowdepth at present time
!RZ	RuNOFf InterRill
!WB	******** sediment delivery ratio calculation *******
!WB	This information comes from table 8.4 and 8.5 by Foster, ASAE
!WB	monograph # 5.  The roughness factor range for the last two 
!WB	categories were changed to give a quantifiable category for 
!WB	a smooth surface (see table 8.4).  

 	DO IC=1,NPART
	IF (RANROU(JK).GE.150) THEN
!WB	rghfact(M)=0.3, read table 8.5 for this roughness factor
	IF (DIAMM(IC).LT.0.002) SEDDR(M,IC)=0.91
	IF (DIAMM(IC).GE.0.002.AND.DIAMM(IC).lt.0.050) SEDDR(M,IC)=0.79
	IF (DIAMM(IC).GE.0.050.AND.DIAMM(IC).lt.0.250) SEDDR(M,IC)=0.37
	IF (DIAMM(IC).GE.0.250.AND.DIAMM(IC).lt.1.000) SEDDR(M,IC)=0.00
	IF (DIAMM(IC).GE.1.000) SEDDR(M,IC)=0.00
	ENDIF
	IF (RANROU(JK).GE.100.AND.RANROU(JK).LT.150) THEN
!WB	rghfact(M)=0.5, read table 8.5 for this roughness factor
	IF (DIAMM(IC).LT.0.002) SEDDR(M,IC)=0.97
	IF (DIAMM(IC).GE.0.002.AND.DIAMM(IC).LT.0.050) SEDDR(M,IC)=0.93
	IF (DIAMM(IC).GE.0.050.AND.DIAMM(IC).LT.0.250) SEDDR(M,IC)=0.75
	IF (DIAMM(IC).GE.0.250.AND.DIAMM(IC).LT.1.000) SEDDR(M,IC)=0.00
	IF (DIAMM(IC).GE.1.000) SEDDR(M,IC)=0.00
	ENDIF
	IF (RANROU(JK).GE.70.AND.RANROU(JK).LT.100) THEN
!WB	rghfact(M)=0.65, read table 8.5 for this roughness factor
	IF (DIAMM(IC).LT.0.002) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.002.AND.DIAMM(IC).LT.0.050) SEDDR(M,IC)=0.99
	IF (DIAMM(IC).GE.0.050.AND.DIAMM(IC).LT.0.250) SEDDR(M,IC)=0.98
	IF (DIAMM(IC).GE.0.250.AND.DIAMM(IC).LT.1.000) SEDDR(M,IC)=0.07
	IF (DIAMM(IC).GE.1.000) SEDDR(M,IC)=0.17
	ENDIF
	IF (RANROU(JK).GE.50.AND.RANROU(JK).LT.70) THEN
!WB	rghfact(M)=0.75, read table 8.5 for this roughness factor
	IF (DIAMM(IC).LT.0.002) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.002.AND.DIAMM(IC).LT.0.050) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.050.AND.DIAMM(IC).LT.0.250) SEDDR(M,IC)=0.99
	IF (DIAMM(IC).GE.0.250.AND.DIAMM(IC).LT.1.000) SEDDR(M,IC)=0.32
	IF (DIAMM(IC).GE.1.000) SEDDR(M,IC)=0.46
	ENDIF
	IF (RANROU(JK).GE.20.AND.RANROU(JK).LT.50) THEN
!WB	rghfact(M)=0.85, read table 8.5 for this roughness factor
	IF (DIAMM(IC).LT.0.002) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.002.AND.DIAMM(IC).LT.0.050) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.050.AND.DIAMM(IC).LT.0.250) SEDDR(M,IC)=0.99
	IF (DIAMM(IC).GE.0.250.AND.DIAMM(IC).LT.1.000) SEDDR(M,IC)=0.58
	IF (DIAMM(IC).GE.1.000) SEDDR(M,IC)=0.69
	ENDIF
	IF (RANROU(JK).GE.5.AND.RANROU(JK).LT.20) THEN
!WB	rghfact(M)=0.92, read table 8.5 for this roughness factor
	IF (DIAMM(IC).LT.0.002) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.002.AND.DIAMM(IC).LT.0.050) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.050.AND.DIAMM(IC).LT.0.250) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.250.AND.DIAMM(IC).LT.1.000) SEDDR(M,IC)=0.78
	IF (DIAMM(IC).GE.1.000) SEDDR(M,IC)=0.84
	ENDIF
	IF (RANROU(JK).GE.0.AND.RANROU(JK).LT.5) THEN
!WB	rghfact(M)=1.00, read table 8.5 for this roughness factor
	IF (DIAMM(IC).LT.0.002) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.002.AND.DIAMM(IC).LT.0.050) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.050.AND.DIAMM(IC).LT.0.250) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.0.250.AND.DIAMM(IC).LT.1.000) SEDDR(M,IC)=1.00
	IF (DIAMM(IC).GE.1.000) SEDDR(M,IC)=1.00
	ENDIF
	END DO
 	DO 9500 IC=1,NPART
	DIINT(M,IC)=(KIADJ(M)*XR*RNOFIR*SEDDR(M,IC)/AREA)
!WB	DIINT=INTERRILL DETACHMENT, KIADJ=ADJUSTED INTERRILL ERODIBILITY,
!WB	XR=NET RAINFALL RATE CONVERTED TO M3/S,
!WB	RNOFIR=INTERRILL RUNOFF RATE,SEDDR=SED DELIVERY
!WB	RATIO, AREA=AREA OF CELL OR CHANNEL, USED TO ADJUST THE RAINFALL
!WB	RATE TO A UNIT AREA BASIS, AND THEN THE DETACHMENT IS MULTIPLIED
!WB	BY AREA BELOW.
	IF (DIINT(M,IC).GT.100) THEN
!WB	GENERAL ERROR CHECK
	WRITE (*,*) 'DIINT EXCEEDS 100'
	WRITE (2,*) 'DIINT EXCEEDS 100'
	PAUSE
	STOP
	ENDIF
	DIINT(M,IC)=DIINT(M,IC)*((DX*DX)-(NORILLS*RILLWID*DX))
!WB	THIS SAYS THAT THE INTERRILL CONTRIBUTION IN KG/S*M2 SHOULD BE
!WB	MULTIPLIED BY THE INTERRILL AREA, WHICH EQUALS THE CELL AREA
!WB	MINUS THE RILL AREA
 9500	END DO
	DO IC=1,NPART
      DETR(IC)=DIINT(M,IC)
!WB	rainfall detachment (kg/s) = 
      DETF(IC)=DACT(M,IC)
!WB	flow detachment (kg/s) = 
	IF (NOEROS(JK).EQ.1) THEN
!WB	THIS IS A FLAG THAT INDICATES A COVER CONDITION THAT DOES NOT INCUR
!WB	EROSION, SUCH AS A PARKING LOT OR POND
	DETR(IC)=0.
	DETF(IC)=0.
	ENDIF
	END DO

      GO TO 75

 9405 CONTINUE
  70  DO IC=1,NPART
	DETR(IC)=0.
!WB	reset rainfall detach to 0
      DETF(IC)=DACT(M,IC)

!WB	you are sent here to reset flow and rainfall detachment if the 
!WB	element is a channel cell
!WB	IF AN ELEMENT HAS A NOEROS FLAG, IT DOES NOT AFFECT EROSION IN A
!WB	CHANNEL CELL OF THAT ELEMENT.
	END DO

  75  CONTINUE
!WB	you skip the reset of the rainfall and flow detachments to 0 if
!WB	you are still doing calculations on overland flow cells
      DO IC=1,NPART
	DRFT(IC)=DETR(IC)+DETF(IC)
!WB	sum of rainfall & flow detach (kg/s)
	END DO
      X1=Q(M)/S(M)
!WB	X1 = flow / water storage on element
!WB	(it's a volumetric flow/volum storage)
      X2=1./(1.+X1)
!WB	X2 = 1 / (1+flow/storage)
!WB	this is also:  storage/(storage+flow)
      IF(NP.EQ.NWASH1.AND.NWASH.NE.0) GO TO 310
!WB	if np equals NWASH + 1 and # of washload particles doesn't equal 0
!WB	line 310 is the beginning of the washload particle calculations
      X3=X1*X2
!WB	X3 = (flow / storage) * (1 / (1+flow/storage))
!WB	this is also flow/(flow+storage
      X4=1./X1
!WB	X4 = storage / flow
      DO 80 IC=NWASH1,NPART
!WB	do from counter IC = # washload particles + 1 up to # of particles
	DS1(IC)=SI(M,IC)+F(KK,IC)*DETR(IC)
!WB	max rate of sed. inflow & erosion in element with only rainfall 
!WB	detach (kg/s) = sed. inflow + fraction of particles of type i in 
!WB	original soil * detach rate for rainfall
	DS2(IC)=DS1(IC)+F(KK,IC)*DETF(IC)
!WB	max rate of sed inflow & erosion in element with rainfall & 
!WB	flow detachment (kg/s) = above + fraction of particles of type i in 
!WB	original soil (soil type of current element, particle size class)
!WB	 * flow detachment (kg/s)
	S22(IC)=(SST(M,IC)+DS2(IC))*X2
!WB	S22 = (sum of initial values in sed. cont eqn (kg/s) + 
!WB	max rate sed inflow & erosion w/ rainfall & flow detach (kg/s)) * 
!WB	 (1/(1+(flow/storage)))
	SE1(IC)=(SST(M,IC)+DS1(IC))*X3
!WB	SE1 (rate of sed movement w/o flow detachment
!WB	 = (sum of initial values in sed cont eqn + 
!WB	max rate of sed. movement w/ rainfall detach) * X3
	SE2(IC)=S22(IC)*X1
!WB	SE2 (rate of sed movement w/ rainfall and flow detachment
!WB	 = sed cont eqn + erosion w/rainfall & flow detach * (1/1+
!WB	 (flow/storage)) * flow/storage
  80  CONTINUE
!WB	you are sent here after completing the last loop for the # of 
!WB	settleable size classes
C
C.........APPORTION ANY TRANSPORT EXCESS TO DEFICITS..........
C
      NPM=NPART-NWASH
!WB	NPM = # of particle size classes - # of washload size classes
!WB	this is equal to the # of settleable size classes
  90  I1=0
!WB	counter
!WB	you are sent here from later in the prog
      I2=0
!WB	counter
      I3=0
!WB	counter 
      SDEL=0.
!WB	sum of delta
      TFXCES=0.
!WB	trans cap excess

!WB********calculate transport capacity excess ******************
      DO 150 IC=NWASH1,NPART
!WB	do from nwashload part's + 1 to # particle size classes
	TFMSE2(IC)=TF(IC)-SE2(IC)
!WB	 = trans cap - sediment w/ rainfall and flow detach
	IF(TFMSE2(IC))130,140,110
!WB	if above var < = > 0, then go to 130, 140, 110, respectively
!WB	this says, is trans cap less than sediment erosion 
!WB	capacity with rainfall and flow detachment, or equal to or 
!WB	greater than
C
C............TRANSPORT > SE2........................
C
!WB	this says that the transport capacity exceeds the detachment
!WB	rate with rainfall and flow detachment
 110    I1=I1+1
!WB	count
	TFXCES=TFXCES+TFMSE2(IC)
!WB	trans cap excess = excess + (cap - no flow detachment)
!WB	this says that the excess is equal to the previous excess + the
!WB	definition of trans cap excess
	TF(IC)=SE2(IC)
!WB	trans cap = rate of sed movement w/ rainfall and flow detach	
!WB	set trans cap equal to the detachment rate if you have an excess
!WB	of t.c.
      GO TO 150
C
C............TRANSPORT < SE2........................
C
!WB	this says that if the transport capacity is less than the 
!WB	detachment rate 
 130    I3=I3+1
!WB	count
	SDEL=SDEL+DELTA(IC)
!WB	summ of delta = same + delta (= dimensionless crit shear)
 140    I2=I2+1
!WB	count.  You are sent here if the t.c. excess is equal to the 
!WB	detachment rate.
 150  CONTINUE
!WB	you are sent here to skip the I3 counter and the sum of delta
!WB	for the condition of t.c. < detachment rate (or equal to det.
!WB	rate), and the I2 counter
      IF(SDEL.LE.0.) GO TO 200
!WB	sum of delta less than or equal to 0.  You get here if t.c.
!WB	exceeds SE2 for all particle size classes, or if t.c. is 
!WB	equal to SE2 for all particle size classes
      IF(I1.EQ.NPM.OR.I2.EQ.NPM.OR.I3.EQ.NPM) GO TO 200
!WB	if the count equals the # of settleable particle size classes or
!WB	if count I2 or if count I3 equals the same, then go to 200
!WB	this says that if you have gone through the loop the same #
!WB	of times as the # of settleable particle size classes, then skip
!WB	the reapportionment of trans capacity
!WB********end of transport capacity excess loop/section********

!WB	***********reapportion the transport capacity************
!WB	I believe that this loop is done until T.C < SE2
      DO 160 IC=NWASH1,NPART
!WB	do from the counter that represents the # of particle size classes
!WB	that are settleable up to the # of particles
	IF(TFMSE2(IC).GE.0..OR.DELTA(IC).LE.0.) GO TO 160
!WB	if trans cap excess > 0 or delta (= excess tractive force) < 0
	TF(IC)=TF(IC)+TFXCES*DELTA(IC)/SDEL
!WB	trans cap = same + accum trans cap excess * delta / sum of deltas
	IF(I3.EQ.1) GO TO 170
!WB	if the I3 counter equals 1, which occurs when t.c. is lt se2, 
!WB	and there won't be sufficient energy for transport, and then
  160 CONTINUE
      GO TO 90
!WB	this sends you back to the top to redo the calculations on trans
!WB	capacity.  you are sent here if trans cap excess is greater than
!WB	or equal to 0 or if the excess tractive force = 0
  170 IF(TF(IC).GT.SE2(IC)) TF(IC)=SE2(IC)
!WB	if the trans cap > detach rate, then trans cap = 
!WB	detachment rate
!WB	you get here if the I3 counter is = 1, which means that t.c. < det
!WB	rate
C
C.........SOLVE CONTINUITY EQUATION FOR SEDIMENT TRANSPORT.....
C
 200  CONTINUE
!WB	you are sent here if any of the counters equals to the # of 
!WB	settleable particle classes
      DO 300 IC=NWASH1,NPART
!WB	do from # washload particles + 1 up to # particles size classes
!WB	I believe that the NWASH1 var is used to keep count of the same
!WB	thing as NPM
	IF(TF(IC).LT.SE1(IC)) GO TO 240
!WB	if trans cap < rainfall detach
	IF(TF(IC).LT.SE2(IC)) GO TO 220
!WB	if trans cap < max detach rate with rainfall & flow
!WB	so you jump over the next section if the trans cap is not equal
!WB	to maximum, and you're directed according to the amt of detachment
C
C..........MAXIMUM RAINFALL AND FLOW DETACHMENT...............
C...................NO DEPOSITION.............................
C
!WB	this is the section for t.c.>SE2 and so all detachment can be 
!WB	transported
	SST(M,IC)=DS2(IC)-SE2(IC)+S22(IC)
!WB	SST = (detachment rate w/rainfall & flow detach + sed inflow prev
!WB	time step) -
!WB	[(sed cont eqn prev time step +
!WB    detachment w/ rainfall & flow detach)*(1/1+
!WB	 (flow/storage)) * flow/storage] *
!WB	(flow/storage) + [sed cont eqn prev time step +
!WB    detachment w/ rainfall & flow detach)*(1/(1+(flow/storage)))]

C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=SE2(IC)
!WB	sediment movement from a cell is equal to max detach rate 
!WB	with rainfall & flow 
C *** NRZ END
	SEL(M)=SEL(M)-F(KK,IC)*DRFT(IC)
!WB	sed accum = sed accum (per storm) - fraction of particles in 
!WB	class i * sum of rainfall & detachment 

*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)=F(KK,IC)*DRFT(IC)
!WB	sednew = fraction of particles in class i * sum of rainfall & 
!WB	detach

	STNEW(IC)=S22(IC)/2.
!WB	new soil storage
!WB	this says that the new soil storage is equal to:
!WB	 [sed cont eqn + erosion w/rainfall & flow detach * (1/1+
!WB	 (flow/storage))] / 2
	GO TO 290
!WB	this sends you down to the section on washload particle calculation
!WB	and then out the bottom of this subroutine
C
C..........MAXIMUM RAINFALL, PARTIAL FLOW DETACHMENT..........
C.....................NO DEPOSITION...........................
C
!WB	This is the section for when t.c.<detach cap, but not < rain detach

  220 ZI2=TF(IC)*(1.+X4)-SST(M,IC)
!WB	 = trans cap * (1+storage/flow by volume) - sum of values 
!WB	in cont eqn
	SEL(M)=SEL(M)+SI(M,IC)-ZI2
!WB	 = sed accum + sed inflow - (rate of sed inflow + erosion at 
!WB	end of time increment)
	SST(M,IC)=ZI2+TF(IC)*(X4-1.)
!WB	 cont eqn = (sed inflow + erosion) + t.c.(storage/flow -1)
C *** NRZ 
C *** CHANNEL ADDITION
	SE(IC)=TF(IC)
!WB	rate of sed movement from element = t.c.
C *** NRZ END
 
*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)=ZI2-SI(M,IC)
!WB	this newly generated sediment is equal to the transport capacity
!WB	times a scaling factor according to the flow minus the values 
!WB	in the sed. cont eqn minus the value of sed inflow

	STNEW(IC)=TF(IC)*X4/2.
!WB	this appears to say that the new soil storage is equal to the
!WB	transport capacity times (storage / flow) / 2
	GO TO 290
!WB	this sends you down to the section on washload particle calculation
!WB	and then out the bottom of this subroutine
C
C..........DEPOSITION, NO FLOW DETACHMENT.....................
C
!WB	this is the section for when t.c.<SE1, and therefore there is
!WB	deposition
 240    RE=FV(IC)*AREA/Q(M)
!WB	partial removal eff. during dep = fall velocity * area / flow
!WB	this says that the partial removal variable is equal to the 
!WB	fall velocity of the particle size class * catchment AREA 
!WB	as a sum of element areas, ha / outflow from element i at start
!WB	of time increments (m3/s)
	IF(RE.GT.1.) RE=1.
!WB	if that removal efficiency is greater than 1 (more than 
!WB	everything deposits), then set it equal to total removal
	
      DP=RE*(SE1(IC)-TF(IC))
!WB	dep rate = remov eff (rainfall detachment - t.c.)
	DEPPREV(M)=DP
!WB	IF THERE IS DEPOSITION IN A CHANNEL CELL, THEN THIS VARIABLE IS
!WB	USED TO ADJUST THE ERODED DEPTH INCREMENT.  SEE DEPTHINC ABOVE
C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=SE1(IC)-DP
!WB	sed movement from cell = rainfall detachment - deposition rate
	ZI2=SE(IC)*(1.+X4)-SST(M,IC)
!WB	sed. inflow & erosion = sed. movement * (1+storage/flow) - cont eqn
	IF(ZI2.LT.0.) ZI2=0.
	SEL(M)=SEL(M)+SI(M,IC)-ZI2
!WB	sed accum = accum + sed inflow - inflow + erosion
	SST(M,IC)=ZI2+SE(IC)*(X4-1.)
!WB	cont eqn = sed. inflow & erosion + sed. movement * 
!WB	 (storage/flow - 1)

*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)=F(KK,IC)*DETR(IC)
!WB	 = fraction in size class * det. rate by rainfall
	STNEW(IC)=SE(IC)*X4/2.
!WB	new soil in storage = sed movement * (storage / 2*flow)
C *** NRZ END

C *** NRZ
C *** CHANNEL ADDITION
 290    IF(SE(IC).LT.0.) SE(IC)=0.
!WB	if sediment exiting less than 0, set it = 0
C *** NRZ END
	IF(SST(M,IC).LT.0.) SST(M,IC)=0.
!WB	if cont eqn < 0 , it = 0

 300  CONTINUE
      IF(NWASH.EQ.0) GO TO 410
!WB	 # of particles in washload equals 0
C
C....WASH LOAD CALCULATIONS..................................
C
  310 CONTINUE
      DO 400 IC=1,NWASH
	DS=SI(M,IC)+F(KK,IC)*DRFT(IC)
!WB	max rate of inflow & erosion in an element = sed. inflow + size 
!WB	fraction * (sum of flow & rainfall detach)

	S2=(SST(M,IC)+DS)*X2
!WB	 = (cont eqn + max inflow & erosion) * ( 1/(1+flow/storage))
C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=S2*X1
!WB	sed movement = S2 * flow / storage
	SST(M,IC)=DS-SE(IC)+S2
!WB	cont eqn = max inflow & erosion - sed leaving + S2
	IF(SST(M,IC).LT.0.)SST(M,IC)=0.
!WB	if cont eqn < 0, then set it = 0
	SEL(M)=SEL(M)-F(KK,IC)*(DETR(IC)+DETF(IC))
!WB	sed accum = sed accum - size fraction * (rainfall + flow detach) 
*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)=F(KK,IC)*DRFT(IC)
!WB	sednew = size fraction * total detach
	STNEW(IC)=S2/2.
!WB	STORAGE new = S2/2
	
  400 CONTINUE
  410 CONTINUE
 1000 FORMAT ('RILL WIDTH EXCEEDS RILL SPACING AT: ',/,
     1I4,' RILL WIDTH ',F5.3,' RILLSPACING ',F5.3
     2,/,'  PLEASE CHANGE THE RILL SPACING.')
 1002 FORMAT ('THE MANNINGS N FOR CHANNEL SOILS EXCEEDS'  
	1,/,' THE VALUE FOR SOIL + VEGETATION.  PLEASE CHANGE THIS.')
 1004 FORMAT ('FLOW-DEPTH CALCULATED MORE THAN 10,000 TIMES AND'
	1,/,' DOES NOT APPEAR TO CONVERGE.  PLEASE CONTACT ANSWERS'
	2,/,' ASSISTANCE FOR HELP.  THE ERROR OCCURRED AT:'
	3,/,' CELL #: ',I5,' QEFF =',F12.8,' RILLWID =',F6.3,' SL(M)=',
	4F5.3,/,' DWSOIL =',F5.3,' FLDEPOLD =',F6.3)
 1006 FORMAT ('THE FLOWDEPTH IS NEGATIVE.',' M =',I3,' FOFD =',F11.6
	1,/,' FPOFD =',F11.6,' FDPOFD =',F11.6,' FLOWDEP =',F11.6
     2,/,' FLOWDEPOLD =',F11.6,' RILLWID =',F11.6,'QEFF=',F11.6
     3,/,' SL =',F5.3,' DWSOIL =',F6.3,' DIFF = ',F11.6
	4,/,' IF YOU RECEIVE THIS MESSAGE, PLEASE CONTACT ANSWERS'
	5,/,' SUPPORT AND PROVIDE THE INFORMATION ON THIS SCREEN.')   
 1008	FORMAT ('AN ERROR HAS OCCURRED AND THE PROGRAM HAS STOPPED'
	1,/,' ACTUAL RILL DETACHMENT EXCEEDS CAPACITY'
	2,/,' ACTUAL DETACHMENT =',F11.7,' AT CELL: ',I3,' FOR PARTICLE'
	3,/,' CLASS :',I3,' WHILE CAPACITY EQUALS: ',F11.7)
	
	
	
      RETURN
      END

C NRZ 9/11/94
C MODIFIED CALL FOR MULTIPLE OUTLETS
      SUBROUTINE RELEM (IEL,ITEMP,N,ISR,ICR,NMAX,JMAX,NPAR,IELC,
     1ITEMPC,NPAR2)
C NRZ 9/11/94

      IMPLICIT DOUBLE PRECISION A-H,O-Z

C NRZ 9/5/94
C ADDED VARIABLES FOR CHANNEL NETWORKS
 
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)
      INTEGER CHNUM,CHOUT,CHNUMBER

C NRZ 9/5/94

C *** NRZ 3/26/95
C *** ADD COMMON BLOCK FOR IROT TO MAKE CHECKS

      COMMON /ROT/ IROT1,IROT(20,644)
      INTEGER IROT1,IROT

C *** NRZ 3/26/95

C
C ******  SUBROUTINE TO SET UP NEXT ROW OF WATERSHED ELEMENTAL DATA.
C **** INTO THE PROPER POSITION OF THE "3-ROW PER PASS" ARRAY.
C
      DIMENSION IEL(3,JMAX,NPAR2), ITEMP(NPAR2) !(3,300,20)
      DIMENSION IELC(3,JMAX,2), ITEMPC(2)
      CHARACTER*2 IELC, ITEMPC
C
C **** "RIPPLE" ROW 2 INTO ROW 1 AND ROW 3 INTO ROW 2, THEN ZERO
C **** THE THIRD ROW.
C
      DO 20 J=1,JMAX
      NZZ=NPAR-2
!WB	NPAR = 22
      DO 10 I=1,NZZ
      IEL(1,J,I)=IEL(2,J,I)
   10 IEL(2,J,I)=IEL(3,J,I)
   20 IEL(3,J,3)=0
      DO 25 J=1,JMAX
      DO 23 I=1,2
      IELC(1,J,I)=IELC(2,J,I)
   23 IELC(2,J,I)=IELC(3,J,I)
   25 CONTINUE
C
C **** SET UP POSSIBLE LAST ROW TEST FLAG.
C
      IEL(3,1,2)=JMAX
      IF (ITEMP(3).EQ.999) RETURN	
!WB	ITEMP(3) should equal 9, but is set equal to 999 near the
!WB	end of the data subroutine
C
C **** NOW TRANSFER CURRENT WATERSHED ELEMENTAL DATA INTO THE THIRD
C **** ROW OF THE "3-ROW PER PASS" ARRAY.
C
C ****** IEL(I,J,3) CONTAINS THE POSITION NUMBER FOR THAT ELEMENT IN
C ****** THE SINGLE DIMENSION ARRAYS USED FOR SIMULATION ANALYSIS.
C ****** IEL(I,1,2) CONTAINS THE COLUMN NUMBER OF THE LAST WATERSHED
C ****** ELEMENT IN THE ROW.
C
   30 J=ITEMP(2)
C NRZ 9/5/94
C MODIFY COMPUTATION OF K TO ACCOUNT FOR 5-DIGIT ITEMP(6)

C     K=MOD(ITEMP(6),100)
      K=MOD(MOD(MOD(ITEMP(6),1000000),10000),100)
!WB	K = SOIL TYPE OF OVERLAND FLOW CELL

C NRZ 9/5/94

      IF (K.LE.0.OR.K.GT.ISR) GO TO 80
C RWC  3/2/95
C THE LAST VARIABLE IN THE STATEMENT WAS CHANGED FROM THE TOTAL NUMBER OF CROPS
C IN THE SIMULATION (ICR) TO THE TOTAL NUMBER OF ROTATIONS (IROT1) DUE TO 
C *** NRZ 3/26/95
C *** THE FACT THAT ITEMP(7) IS NOW EQUAL TO ROTATION # - NOT CROP NUMBER
C  
C      IF (ITEMP(7).LE.0.OR.ITEMP(7).GT.ICR) GO TO 90
      IF (ITEMP(7).LE.0.OR.ITEMP(7).GT.IROT1) GO TO 90

C *** ALSO MAKE ORIGINAL INTENDED CHECK FOR UNDEFINED CROP NUMBER

      DO 35 NRZ=2,40,2
        IF (IROT(ITEMP(7),NRZ).GT.ICR) THEN
          ICRERR=IROT(ITEMP(7),NRZ)
          GOTO 91
        ENDIF
   35 CONTINUE

C *** NRZ 3/26/95

      IF (J.GT.JMAX) GO TO 50
C
C **** TRANSFER PARAMETER DATA FROM A SINGLE ELEMENT.
C
      NZZ=NPAR-2
      DO 40 I=1,NZZ
   40 IEL(3,J,I)=ITEMP(I)
      DO 45 I=1,2
   45 IELC(3,J,I)=ITEMPC(I)
C
C **** REMEMBER AS POSSIBLE LAST ELEMENT IN CURRENT ROW.
C
      IEL(3,1,2)=J
C
C **** REMEMBER ROW NUMBER OF THIS ELEMENT.
C
      IC=ITEMP(1)
C
C **** SAVE ELEMENT'S SEQUENCE NUMBER.
C
      N=N+1
      IF (N.GT.NMAX) GO TO 60
      IEL(3,J,3)=N

C **** NRZ 9/11/94
C **** CHECK FOR ANY POSSIBLE OUTLET CELLS AND ASSIGN OUTLET NUMBER
      DO 47 NCH=1,NCHAN
	IF (ITEMP(1).EQ.NIOUT(NCH).AND.J.EQ.NJOUT(NCH)) MOUT(NCH)=N
   47 CONTINUE
C **** NRZ 9/11/94

	IF (ITEMP(3).NE.0) RETURN
C
C **** NOW READ PARAMETERS FOR NEXT ELEMENT.
C
      READ (1,100) (ITEMP(K),K=1,7),(ITEMPC(L),L=1,2),(ITEMP(K),K=8,16)
      READ(1,101) (ITEMP(K),K=17,24)

      IF (ITEMP(1).LT.IC.OR.ITEMP(1).GT.IC+1.OR.(ITEMP(2).LE.J.AND.ITEMP
     1(1).EQ.IC)) GO TO 70
      IF (ITEMP(1).EQ.IC) GO TO 30
!RZ	go through the subroutine again if the next element is part of the same row;
!RZ	otherwise (i.e., next element starts a new row), return to main program.
      RETURN
   50 WRITE (2,110) ITEMP(1),J
      STOP
C
C **** ERROR MESSAGES.
C
   60 WRITE (2,120) ITEMP(1),J
      STOP
   70 WRITE (2,130) ITEMP(1),ITEMP(2)
      STOP
   80 WRITE (2,140) K,ITEMP(1),J
      STOP
   90 WRITE (2,150) ITEMP(7),ITEMP(1),J
      WRITE (2,*) 'IROT1 = ',IROT1
      STOP

C *** NRZ 3/26/95
C *** ADDED MESSAGE FOR UNDEFINED CROP NUMBER

   91 WRITE (2,151) ICRERR,ITEMP(1),J
      STOP

     
C
C NRZ 9/5/94
C CHANGED FORMAT STATEMENT TO INCLUDE AN EXTRA 2 DIGITS FOR THE CHANNEL
C NETWORK NUMBER

C 100 FORMAT (2I3,I2,I3,3I4,3X,A2,1X,A2,2X,I4,I3,2I4,I6,I2,I5,I5,I5)
  100 FORMAT (2I3,I2,I3,I4,1X,I7,I4,3X,A2,1X,A2,2X,I4,I3,2I4,I6,I2,I5,I5
     &,I5)

C NRZ 9/5/94
C
  101 FORMAT(3I5,I6,1X,2(I1,1X),I5,1X,I1)
  110 FORMAT (23H COLUMN NO. FOR ELEMENT,I4,1H,,I4,24H EXCEEDS IEL() DIM
     1ENSION)
  120 FORMAT (' NO. OF ELEMENTS EXCEEDS DIMENSION AT ELEMENT',I4,1H,,I4
     1)
  130 FORMAT (' ELEMENT DATA OUT OF SEQUENCE AT ELEMENT',I4,1H,,I4)
  140 FORMAT (1X,'SOIL TYPE',I4,22H SPECIFIED FOR ELEMENT,I4,1H,,I4,
     114HIS NOT DEFINED)

C *** NRZ 3/26/95
C *** CHANGED ERROR STATEMENT TO REFLECT CROP #/ROTATION # CHANGE
C  150 FORMAT (1X,9HCROP TYPE,I4,22H SPECIFIED FOR ELEMENT,I4,1H,,I4,15H
C     1IS NOT DEFINED)
  150 FORMAT (1X,9HROTATION ,I4,22H SPECIFIED FOR ELEMENT,I4,1H,,I4,
     114HIS NOT DEFINED)

C *** AND ADDED STATEMENT FOR UNDEFINED CROP AGAIN
  151 FORMAT (1X,'CROP TYPE',I4,22H SPECIFIED FOR ELEMENT,I4,1H,,I4,
     &14HIS NOT DEFINED)
C *** 3/26/95


C
 
      END
* SUBROUTINE TO DETERMINE SEDIMENT BOUND PHOSPHORUS
 
      SUBROUTINE PBOUND(NPART,M)
*
      IMPLICIT DOUBLE PRECISION A-H,O-Z
* THIS SUBROUTINE DETERMINE SEDIMENT BOUND PHOSPHORUS USING
* A CONSERVATION OF MASS APPROACH
 
C *** NRZ 9/15/94
C *** CHANGE VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN
 
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)

      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
C *** NRZ 9/15/94

C **** ADDED VARIABLES FOR CHANNEL NETWORKS
 
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)
      INTEGER CHNUM,CHOUT,CHNUMBER

C **** NRZ 9/14/94

 
* OUTFLOW LARGER THAN ZERO, THERE IS POTENTIAL FOR SEDIMENT
* DETACHMENT
 
      IF (Q(M).LE.0.) GOTO 30
* DETERMINING THE NEWLY GENERATED SEDIMENT BOUND PHOSPHORUS
 
      X1=Q(M)/S(M)
 
      DO 10 IC=1,NPART
*      IF (SI(M,IC).LE.0..AND.STOLD(M,IC)
*     & .LE.0..AND.SEDNEW(M,IC).LE.0.) THEN
*         P2(IC)=0.
*         GOTO 10
*      ENDIF
       IF (SI(M,IC).EQ.0.) PI(M,IC)=0.
 
      PCELL(M,IC)=P0(M,IC)*SEDNEW(M,IC)
      P2(IC)=(PPT(M,IC)+PI(M,IC)+PCELL(M,IC))/
     & (X1+1.)
C *** NRZ 11/21/94
C *** CHANNEL CORRECTION
      PE(IC)=P2(IC)*X1
C *** NRZ END
*      PSEL(M)=PSEL(M)-PCELL(M,IC)+P2(IC)
      PPT(M,IC)=PI(M,IC)+PCELL(M,IC)-P2(IC)*X1
     & +P2(IC)
       PSEL(M)=SEDNEW(M,IC)+PSEL(M)
 10   CONTINUE
      GO TO 40
 
* NO OUTFLOW
 
30     DO 20 IC=1,NPART
*        IF(SI(M,IC).LE.0..AND.STOLD(M,IC).LE.0.) THEN
*           P2(IC)=0.
*           GOTO 20
*         ENDIF
 
       IF (SI(M,IC).EQ.0.) PI(M,IC)=0.
 
       P2(IC)=(PPT(M,IC)+PI(M,IC))/2.
C *** NRZ 11/21/94
C *** CHANNEL CORRECTION
      PE(IC)=0.0
C *** NRZ END
*       PSEL(M)=PSEL(M)+P2(IC)
       PPT(M,IC)=PI(M,IC)
 20   CONTINUE
      GOTO 40
 
 
40    CONTINUE
      DO 50 IC=1,NPART
      PI(M,IC)=0.
 50   CONTINUE
      RETURN
      END
 
 
*     THIS SUBROUTINE IS USED TO DETERMINE SOLUBLE PHOSPHORUS
 
      SUBROUTINE SOLUBP(DX2,KK,M,I,K,DT,T12,L,T11,SSTOR,FIL,SE,N
     & ,CUMIN1,CU,NPART)
 
*     THIS SUBROUTINE USES SIMPLE AVERAGES
 
      IMPLICIT DOUBLE PRECISION A-H,O-Z
 
*      DOUBLE PRECISION R(8,20)

C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN
 
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)

C
C **** MAXIMUM NUMBER OF SOIL TYPES IS 30.
C
      COMMON /CSOIL/ A(30),FC(30),GWC(30)
      COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     & ,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &  CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &  THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &  CRC(30),KE(30,30),ZC(30),BD(30)
      DOUBLE PRECISION KS,LF,KE
 
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
 
      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
      COMMON /SOLUB/ SP2(35000),PEXT(35000),PK(30)
     & ,RBETA(30),SPI(35050),CGEN1(35000)
     & ,T13(35000),SPSP(35000)

C *** NRZ 9/15/94
 
      COMMON /TRAP/PMINP(35000),SOILP(35000),MINP(35000),PLAB(35000),
     &  UPPHOS(35000),TDMP2(35000),SORGP(35000),PSOL(35000),
     &  EDILAB(35000)
 
      COMMON /PARTITION/PKDA(30),PKDP(30),PSP(30)
 
      COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &  NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
      DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL
      DOUBLE PRECISION MINP
 
	IF (S(M).EQ.0) THEN
!WB	THIS IF THEN STATEMENT ADDED TO PREVENT A FLOAT INVALID OPERATION
!WB	DURING GOODWIN CREEK SIMULATION	
	X11=0.
	X21=0.
	ELSE
      X11=(Q(M)+FIL)/S(M)
      X21=Q(M)/S(M)
	ENDIF

      IF(M.GT.N) GOTO 5
 
      X12=(Q(M)+FIL+S(M))/((VOLSZ1(M)+(10-VOLSZ1(M))*2.6*PKDP(KK))
     & *CU*3600/DT)
 
      X1=(Q(M)+FIL)/(S(M)+VOLSZ1(M)*CU*3600/DT)
      X2=Q(M)/(S(M)+VOLSZ1(M)*CU*3600/DT)
      X3=(Q(M)+FIL)/((10-VOLSZ1(M))*2.6*CU*3600/DT)
 
      SSTOR1=S(M)
      IF(SSTOR1.LT.0) SSTOR1=0.
 
      IF((Q(M).EQ.0.0).AND.(FIL.EQ.0.0)
     & .AND.(SSTOR1.EQ.0.0)) GOTO 20
 
*EDINH4(M) REPRESENT THE CONCENTRATION OF DISSOLVED
*AMMONIUM IN EDI
 
 
 
 5    IF (M.GT.N) THEN
	 SP=(SPI(M)+SPSP(M))/(X11+1)
	 SP2(M)=SP*X21
	 SPSP(M)=SPI(M)+SP*(1-X11)
	 IF(SPSP(M).LE.0.) SPSP(M)=0.
	 GOTO 20
      ENDIF
 
       IF((Q(M).EQ.0).AND.(FIL.EQ.0).OR.(CUMIN1.EQ.0.)) THEN
       SP=(SPSP(M)+SPI(M))/2.
       SP2(M)=0.0
       SPSP(M)=SPI(M)
       GOTO 20
       ENDIF
 
 
      EXTFAC=DEXP(-X12)*(0.1/(1+0.1*PKDP(KK)))
 
       DO 10 IC=1,NPART
       OUPO4=OUPO4+PCELL(M,IC)*DT
  10   CONTINUE
 
      SP=(SPI(M)+SPSP(M)+EDILAB(M)*EXTFAC*X3/DT)/(1.+X1)
	IF(SP.LT.EXP(-50.)) THEN
       SP2(M)=0.
       GOTO 20
      ENDIF
      SP2(M)=SP*X2
      SPSP(M)=SPI(M)+EDILAB(M)*EXTFAC*X3/DT+SP*(1.-X1)
	 IF(SPSP(M).LE.0.) SPSP(M)=0.
      IF (PSOL(M).LT.0.) PSOL(M)=0.
      EDILAB(M)=EDILAB(M)*(1-EXTFAC*X3-OUPO4)
	GOTO 20
 
 
 
 20   CONTINUE
      PO4SEL(M)=PO4SEL(M)+SP2(M)
      SPI(M)=0.0
      OUPO4=0.
      RETURN
      END
 
 
* SUBROUTINE TO DETERMINE SEDIMENT BOUND AMMONIUM
 
      SUBROUTINE AMMON(NPART,M)
*
      IMPLICIT DOUBLE PRECISION A-H,O-Z
* THIS SUBROUTINE DETERMINE SEDIMENT BOUND NITROGEN USING
* A CONSERVATION OF MASS APPROACH
 
C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN
 
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)

      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)
 
      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
C *** NRZ 9/15/94

C **** ADDED VARIABLES FOR CHANNEL NETWORKS
 
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)
      INTEGER CHNUM,CHOUT,CHNUMBER

C **** NRZ 9/14/94

 
      COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &  NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL

	LOGICAL ARESULT
      
 
 
* OUTFLOW LARGER THAN ZERO, THERE IS POTENTIAL FOR SEDIMENT
* DETACHMENT
 
      IF (Q(M).LE.0.) GOTO 30
* DETERMINING THE NEWLY GENERATED SEDIMENT BOUND PHOSPHORUS
!RZ	umm... you mean ammonia?  This is copied from the sediment bound
!RZ	phosphorus section of the code.
 
      X1=Q(M)/S(M)
 
      DO 10 IC=1,NPART
 
      IF (SI(M,IC).EQ.0.) ANI(M,IC)=0.
 
      ANCELL(M,IC)=AN0(M,IC)*SEDNEW(M,IC)
      AN2(IC)=(ANPT(M,IC)+ANI(M,IC)+ANCELL(M,IC))/
     & (X1+1.)
C *** NRZ
C *** CHANNEL CORRECTION
      ANE(IC)=AN2(IC)*X1
C *** NRZ END
      ANSEL(M)=ANSEL(M)-ANCELL(M,IC)+AN2(IC)
      ANPT(M,IC)=ANI(M,IC)+ANCELL(M,IC)-AN2(IC)*X1
     & +AN2(IC)
 
 10   CONTINUE
      GO TO 40
 
* NO OUTFLOW
 
30     DO 20 IC=1,NPART
 
       IF (SI(M,IC).EQ.0.) ANI(M,IC)=0.
 
       AN2(IC)=(ANPT(M,IC)+ANI(M,IC))/2.
C *** NRZ
C *** CHANNEL CORRECTION
       ANE(IC)=0.0
C *** NRZ END
       ANSEL(M)=ANSEL(M)+AN2(IC)
       ANPT(M,IC)=ANI(M,IC)
 20   CONTINUE
      GOTO 40
 
 
40    CONTINUE
      DO 50 IC=1,NPART
      ANI(M,IC)=0.
C *** NRZ
C *** CHANNEL ADDITION
      NHSSEL(M)=NHSSEL(M)+ANE(IC)
C *** NRZ END
 50   CONTINUE
	
      RETURN
      END
 
 
* SUBROUTINE TO DETERMINE SEDIMENT BOUND ORGANIC NITROGEN (AZOTE)
 
      SUBROUTINE ORGN(NPART,M)
*
      IMPLICIT DOUBLE PRECISION A-H,O-Z
 
* THIS SUBROUTINE DETERMINE SEDIMENT BOUND ORGANIC N USING
* A CONSERVATION OF MASS APPROACH

C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN 
 
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
 
      COMMON/NITRO2/ O0SOIL(35000),ONPT(35000,8),ONI(35050,8),
     & ONSEL(35000),ON2(8),ONCELL(35000,8),ONE(8),ON0(35000,8)
 
      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
C *** NRZ 9/15/94

C **** ADDED VARIABLES FOR CHANNEL NETWORKS
 
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)
      INTEGER CHNUM,CHOUT,CHNUMBER

C **** NRZ 9/14/94


      COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &  NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL
 
 
* OUTFLOW LARGER THAN ZERO, THERE IS POTENTIAL FOR SEDIMENT
* DETACHMENT
 
      IF (Q(M).LE.0.) GOTO 30
* DETERMINING THE NEWLY GENERATED SEDIMENT BOUND PHOSPHORUS
 
      X1=Q(M)/S(M)
 
      DO 10 IC=1,NPART
 
      IF (SI(M,IC).EQ.0.) ONI(M,IC)=0.
 
      ONCELL(M,IC)=ON0(M,IC)*SEDNEW(M,IC)
      ON2(IC)=(ONPT(M,IC)+ONI(M,IC)+ONCELL(M,IC))/
     & (X1+1.)
C *** NRZ
C *** CHANNEL CORRECTION
      ONE(IC)=ON2(IC)*X1
C *** NRZ END
      ONSEL(M)=ONSEL(M)-ONCELL(M,IC)+ON2(IC)
      ONPT(M,IC)=ONI(M,IC)+ONCELL(M,IC)-ON2(IC)*X1
     & +ON2(IC)
 
 10   CONTINUE
      GO TO 40
 
* NO OUTFLOW
 
30     DO 20 IC=1,NPART
 
       IF (SI(M,IC).EQ.0.) ONI(M,IC)=0.
 
       ON2(IC)=(ONPT(M,IC)+ONI(M,IC))/2.
C *** NRZ
C *** CHANNEL CORRECTION
      ONE(IC)=0.0
C *** NRZ END
       ONSEL(M)=ONSEL(M)+ON2(IC)
       ONPT(M,IC)=ONI(M,IC)
 20   CONTINUE
      GOTO 40
 
 
40    CONTINUE
      DO 50 IC=1,NPART
      ONI(M,IC)=0.
C *** NRZ
C *** CHANNEL CORRECTION
      TKNSEL(M)=TKNSEL(M)+ONE(IC)
C *** NRZ END
 50   CONTINUE
      RETURN
      END
 
 
 
      SUBROUTINE WATNH(SSTOR,FIL,M,DT,N,CUMIN1,CU,KK,NPART)
 
 
      IMPLICIT DOUBLE PRECISION A-H,O-Z
 
 
* THIS SUBROUTINE DETERMINES DISSOLVED AMMONIUM CONCENTRATION
* IT USES AN EXTRACTION FACTOR
* DEVELOPPED BY KNISEL (1980, SEE CREAMS MANUAL).
 
C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN

      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)
 
      COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)
 
C *** NRZ 9/15/94
 
      COMMON /PARTITION/PKDA(30),PKDP(30),PSP(30)
 
C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN

      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)

C *** NRZ 9/15/94
 
      COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &  NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL


 
       RBETA=0.598*DEXP(-0.179*PKDA(KK))
 
	IF (S(M).EQ.0) THEN
!WB	THIS SECTION ADDED TO PREVENT A FLOAT INVALID OPERATION WHEN
!WB	0 DIVIDES BY 0	
	X11=0.
	X21=0.
	ELSE
      X11=(Q(M)+FIL)/S(M)
      X21=Q(M)/S(M)
	ENDIF
	 
       IF((Q(M).EQ.0.).AND.(FIL.EQ.0.).OR.(CUMIN1.EQ.0.)) THEN
       SPNH4=(STONH4(M)+AINH4(M))/2.
       OUTNH4(M)=0.0
       STONH4(M)=AINH4(M)
       GOTO 20
       ENDIF
 
      IF(M.GT.N) GOTO 5
 
      IF((Q(M).EQ.0.0).AND.(FIL.EQ.0.0)
     & .AND.(SSTOR1.EQ.0.0)) GOTO 20
 
      X12=(Q(M)+FIL+S(M))/((VOLSZ1(M)+(10-VOLSZ1(M))*2.6*PKDA(KK))
     & *CU*3600/DT)
      X1=(Q(M)+FIL)/(S(M)+VOLSZ1(M)*CU*3600/DT)
      X2=Q(M)/(S(M)+VOLSZ1(M)*CU*3600/DT)
      X3=(Q(M)+FIL)/((10-VOLSZ1(M))*2.6*CU*3600/DT)
 
      SSTOR1=S(M)
      IF(SSTOR1.LT.0) SSTOR1=0.
 
 
 
*EDINH4(M) REPRESENT THE CONCENTRATION OF DISSOLVED
*AMMONIUM IN EDI
 
 
 
 
 5    IF (M.GT.N) THEN
	 SPNH4=(AINH4(M)+STONH4(M))/(X11+1)
	 OUTNH4(M)=SPNH4*X21
	 STONH4(M)=AINH4(M)+SPNH4*(1-X11)
	 IF(STONH4(M).LE.0.) STONH4(M)=0.
	 IF(OUTNH4(M).LE.0.) OUTNH4(M)=0.
	 GOTO 20
      ENDIF
 
 
 
       EXTFAC=DEXP(-X12)*RBETA/(1+RBETA*PKDA(KK))
       DO 10 IC=1,NPART
       OUNH4=OUNH4+ANCELL(M,IC)*DT
  10   CONTINUE
 
      SPNH4=(STONH4(M)+AINH4(M)+EDINH4(M)*EXTFAC*X3/DT)/(1.+X1)
      IF(SPNH4.LT.EXP(-50.)) THEN
	OUTNH4(M)=0.
	GOTO 20
      ENDIF
      OUTNH4(M)=SPNH4*X2
      STONH4(M)=AINH4(M)+EDINH4(M)*EXTFAC*X3/DT+SPNH4*(1.-X1)
	 IF(STONH4(M).LE.0.) STONH4(M)=0.
      IF (SZNH4(M).LT.0.) SZNH4(M)=0.
      EDINH4(M)=EDINH4(M)*(1-EXTFAC*X3-OUNH4)
      IF (EDINH4(M).LT.0.) EDINH4(M)=0.
      GOTO 20
 
 20   CONTINUE
 
      NHWSEL(M)=NHWSEL(M)+OUTNH4(M)
      OUNH4=0
      AINH4(M)=0.0
      RETURN
      END
 
      SUBROUTINE NO3Z(SSTOR,FIL,M,DT,N,CUMIN1,CU)
 
 
      IMPLICIT DOUBLE PRECISION A-H,O-Z
 
 
* THIS SUBROUTINE DETERMINES NITRATE CONCENTRATION
* IT USES AN EXTRACTION FACTOR
* DEVELOPPED BY KNISEL (1980, SEE CREAMS MANUAL).
 
C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN

      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)
 
      COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)
 
C *** NRZ 9/15/94
 
      COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &  NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL

	COMMON FLAG

 	IF (S(M).EQ.0) THEN
!WB	THIS SECTION ADDED TO PREVENT A FLOAT INVALID OPERATION WHEN
!WB	0 DIVIDES BY 0	
	X11=0.
	X21=0.
	ELSE
      X11=(Q(M)+FIL)/S(M)
      X21=Q(M)/S(M)
	ENDIF
 
      IF(M.GT.N) GOTO 5
 
      IF((SSTOR1.LT.0).OR.(S(M).LT.0.)) THEN
!RZ	ADDED 11/9/01 DUE TO OVERFLOW ERRORS WHEN S(M) GETS TOO NEGATIVE
      SSTOR1=0.
      OUTNO3(M)=0.
      STONO3(M)=AINO3(M)
      GOTO 20
      ENDIF
 
 
      IF((Q(M).EQ.0.0).AND.(FIL.EQ.0.0)
     & .AND.(SSTOR1.EQ.0.0)) GOTO 20
 
       IF((Q(M).EQ.0).AND.(FIL.EQ.0).OR.(CUMIN1.EQ.0.)) THEN
       SPNO3=(STONO3(M)+AINO3(M))/2.
       OUTNO3(M)=0.0
       STONO3(M)=AINO3(M)
       GOTO 20
       ENDIF
 
      X1=(Q(M)+FIL)/(S(M)+VOLSZ1(M)*CU*3600/DT)
      X2=Q(M)/(S(M)+VOLSZ1(M)*CU*3600/DT)
      X12=(Q(M)+FIL+S(M))/(VOLSZ1(M)*CU*3600/DT)
      SSTOR1=S(M)
	IF (SSTOR1.LT.0.) SSTOR1=0.
      X3=(Q(M)+FIL)/((10-VOLSZ1(M))*2.6*CU*3600/DT)
 
 
 
 
 
 
 5    IF (M.GT.N) THEN
	 SPNO3=(AINO3(M)+STONO3(M))/(X11+1)
	 OUTNO3(M)=SPNO3*X21
	 STONO3(M)=AINO3(M)+SPNO3*(1-X11)
	 IF(STONO3(M).LE.0.) STONO3(M)=0.
	 IF(OUTNO3(M).LE.0.) OUTNO3(M)=0.
	 GOTO 20
      ENDIF
 
      EXTFAC=DEXP(-X12)*0.5
      SPNO3=(STONO3(M)+AINO3(M)+EDINO3(M)*X3*EXTFAC/DT)/(1.+X1)
      IF(SPNO3.LT.EXP(-50.)) THEN
       OUTNO3(M)=0.
       GOTO 20
      ENDIF
      OUTNO3(M)=SPNO3*X2
      STONO3(M)=AINO3(M)+EDINO3(M)*EXTFAC*X3/DT+SPNO3*(1.-X1)
	 IF(STONO3(M).LE.0.) STONO3(M)=0.
      EDINO3(M)=EDINO3(M)*(1-EXTFAC*X3)
      IF(EDINO3(M).LT.0.)EDINO3(M)=0.
      GOTO 20
 
  20  CONTINUE
	IF(OUTNO3(M).GT.0.0001) THEN
	CONTINUE
	END IF
      NO3SEL(M)=NO3SEL(M)+OUTNO3(M)
      AINO3(M)=0.0
      RETURN
      END
 
       SUBROUTINE ETP11(TEMPC,RADI,ETPMM) !ADD URBETPMM
      IMPLICIT DOUBLE PRECISION A-H,O-Z
      INTEGER TEMPC,RADI
      DATA ALBED,GAM /0.23,0.68/

       TEMPK = TEMPC + 273
       TEMPR = 5304./TEMPK
 
* COMPUTING THE POTENTIAL ET ACCORDING TO RITCHIE'S EQUATION
 
       DELTA = (TEMPR/TEMPK)*DEXP(21.25-TEMPR)
!rz	faycal's dissertation says this is supposed to be 21.55 not 21.25 - someone's in error here

       ETPM = 0.00128*(RADI*(1-ALBED)/58.3)*(DELTA/(DELTA+GAM))
       ETPMM = ETPM*1000.
 
      RETURN
      END
 
      SUBROUTINE EVAPO(LAI1,S1EP,ESU,TTIME,S2EP,ETPMM,TETP,PEP,ES
     & ,CUMINF)
      IMPLICIT DOUBLE PRECISION A-H, O-Z
 
* COMPUTING SOIL EVAPORATION IN TWO STAGES
* FIRST STAGE ONLY ENERGY IS LIMITING, AND SOIL EVAPORATION
* IS EQUAL TO POTENTIAL SOIL EVAPORATION
*
*  POTENTIAL SOIL EVAPORATION
      DOUBLE PRECISION LAI1
      PSEP = ETPMM * DEXP(-0.4*LAI1)
 
* IF CUMULATIVE SOIL EVAPORATION IS LESS THAN UPPER LIMIT OF
* STAGE 1 (ESU), SOIL EP = POTENTIAL SOIL EP, ELSE STAGE 2 SOIL EP
* STARTS.  DAY2 REPRESENTS THE NUMBER OF DAY SINCE STAGE 2 STARTED
 
 
      IF (S1EP.LT.ESU) THEN
	S1EP=DMAX1(0.0D0,S1EP-CUMINF)
	S1EP=S1EP+PSEP
 
	IF(S1EP.GT.ESU) THEN
	  ES=PSEP-0.4*(S1EP-ESU)
	  S2EP=0.6*(S1EP-ESU)
	  TTIME=(S2EP/3.5)**2.
	  GOTO 10
	ELSE
	  ES=PSEP
	  GOTO 10
	ENDIF
 
      ELSE
 
       SB=CUMINF-S2EP
	IF (SB.LT.0.) THEN
	 TTIME=TTIME+1.
	 ES=3.5*DSQRT(TTIME)-S2EP
 
	 IF (CUMINF.GT.0.) THEN
	  ESX=0.8*CUMINF
	   IF(ESX.LE.ES) ESX=CUMINF+ES
	   IF(ESX.GT.PSEP) ESX=PSEP
	  ES=ESX
	 ELSEIF (ES.GT.PSEP) THEN
	  ES=PSEP
	 ENDIF
 
	 S2EP=S2EP+ES-CUMINF
	 TTIME=(S2EP/3.5)**2.
 
       ELSE
*        CUMINF=SB
	S1EP=ESU-SB
	TTIME=0.0
	S1EP=DMAX1(S1EP,0.0D0)
 
       S1EP=S1EP+PSEP
 
	IF(S1EP.GT.ESU) THEN
	  ES=PSEP-0.4*(S1EP-ESU)
	  S2EP=0.6*(S1EP-ESU)
	  TTIME=(S2EP/3.5)**2.
	ELSE
	  ES=PSEP
	ENDIF
       ENDIF
      ENDIF
 
 10   ES=DMAX1(ES,0.0D0)
* COMPUTING PLANT TRANSPIRATION
 
      IF (LAI1.LT.3.) THEN
	PEP = ETPMM*LAI1/3.
      ELSE
	PEP = ETPMM
      ENDIF
 
      TETP=ES+PEP
      IF(ETPMM.LT.TETP) THEN
       TETP=ETPMM
       ES=TETP-PEP
      ENDIF
 
      RETURN
      END
 
	SUBROUTINE PERCO(KS,FCVOL,CU,PERCOL,FCAP1,XMOI2
     &  ,TMAX,RAITES,AZRAT,J11)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
      DOUBLE PRECISION KS,TMAX,TDAY,FCVOL
      INTEGER RAITES
	COMMON /MOISTURE/ XMOI(35000)
 
	RKFC=KS*AZRAT*XMOI2**(-2.655/DLOG10(FCAP1))
	XMOI1=XMOI(J11)-FCVOL
	TI=XMOI1/RKFC
*        computing drainage for 24 hour
	TDAY=24.
	IF(RAITES.EQ.1) TDAY=DMAX1(0.0D0,TDAY-TMAX/60.)
	ZFAY=TDAY/TI
	IF(ZFAY.GT.75.) ZFAY=75.
	PERCOL=XMOI1*(1.-DEXP(-ZFAY))
 
	RETURN
	END
 
 
      SUBROUTINE RAINFA(NRG,FILTS,PP,N,CU1,CU2,CU,DT,TMIN,TMAX
     1 ,KPR,NDT,ISTRUC,NMAX,ICR,NN,NCHAN,YERBEG,LDAY,DX,SOIVOL)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
 
      COMMON /CSOIL/ A(30),FC(30),GWC(30)
      
	COMMON /CRGAGE/ RC(40,200),TC(40,200),R(40,21),FRA(40),JTR(40),
	1RATE(40),SR(40),NF(40),RATE2(40)

C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN

      COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      
C *** NRZ 9/15/94

      COMMON /CROUGH/ ROUGH(20),HU(20),DIR(21),PIT(40,20),PER(20)
      COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
      COMMON /CUMIN/ CUMIN1(35000),rbit0(35000),testi(35000),
     & timpon(35000),tpon(35000)
C
C **** MAXIMUM NUMBER OF SOIL TYPES IS 30.
C
      COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     & ,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &  CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &  THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &  CRC(30),KE(30,30),ZC(30),BD(30)
      DOUBLE PRECISION LF

      
      DIMENSION IRR(40), IG(40), PP(14)
      DIMENSION FILTS(35000), CWID(35000),CWIDTMP(35000)
      COMMON / CROPAD/  DIRM2(20)
      COMMON /ZSEDI/ NPART,NWASH,NWASH1
      COMMON /ASMF/ ASMBF(30) ,FCAP1(30),TP1(30),RESWAT(30),DF1(30)
      COMMON /ASMP/ASMPER(35000)
      CHARACTER*2 IG
      CHARACTER*4 PP
      CHARACTER JBEG
      INTEGER SUR,SOIL,RANE
      DOUBLE PRECISION KS,KE

C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN
 
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
 
      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)
 
 
      COMMON/NITRO2/ O0SOIL(35000),ONPT(35000,8),ONI(35050,8),
     & ONSEL(35000),ON2(8),ONCELL(35000,8),ONE(8),ON0(35000,8)
 
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)
 
      COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)
 
      COMMON /SOLUB/ SP2(35000),PEXT(35000),PK(30)
     & ,RBETA(30),SPI(35050),CGEN1(35000)
     & ,T13(35000),SPSP(35000)
 
C *** NRZ 9/15/94
 
      COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &  NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL

	INTEGER YERBEG
	DIMENSION SOIVOL(30)

	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB

!WB	THIS IS READ IN THE MAIN ROUTINE.
!WB      READ(8,5560) TEMPC,SOITEM,RADI,RAITES
!WB	  TEMPC = air temp, SOITEM = soil temp, RADI = daily radiation,
!WB		 RAITES = raintest flag 
 
C
C **** INPUT SEPARATE RAINFALL HYETOGRAPHS FOR EACH RAINGAGE.
C
      TMAX=0.
!WB	MAX TIME VALUE GIVEN IN ANY HYETOGRAPH
      TMIN=1.E+10
!WB	MIN TIME VALUE GIVEN IN ANY HYETOGRAPH
      DTMIN=900.
!WB	Minimum time increment in any hyetograph
      TINT=DTMIN
!WB	Time interval in hyetograph
      DO 20 I=1,NRG
!WB	DO FROM 1 TO # OF RAIN GAGES
      FRA(I)=0.
!WB	Fraction of catchment area covered by rain gauge i
      READ (8,830) IG(I)
830   FORMAT (16X,A2)
!WB	Alphanumeric number for rain gauge
      K=2
      KM1=1
   10 READ (8,740) JBEG,TC(I,K),RC(I,K)
!WB	READ JBEG?,TC=Time of jth histogram period for rain gauge i,
!WB	Rainfall intensity for gauge i, histogram period j (m3/s)
!RZ	JBEG is just a flag to show whether this line is the last line
!RZ	input for this particular storm.
      IF (K.GT.2) TINT=TC(I,K)-TC(I,KM1)
!WB	IF K.GT.2, THEN TINT=CURRENT TIME-TIME BEFORE THIS
      IF (TINT.LT.DTMIN) DTMIN=TINT
!WB	IF THE TIME INTERVAL LT THE MIN INTERVAL, SET THEM EQUAL
      K=K+1
!WB	INCREASE K BY 1
      KM1=K-1
!WB	INCREASE KM1 COUNTER TO BE ONE LESS THAN K
      IF (JBEG.EQ.' '.OR.JBEG.EQ.'0') GO TO 10
!WB	IF THE JBEG FLAG IS BLANK OR 0, READ THE NEXT RAINFALL LINE
      IF (JBEG.NE.'1') GO TO 570
!WB	IF THE JBEG FLAG IS ANYTHING OTHER THAN 1, GO TO 570 AND WRITE
!WB	THE RAINGAGE & J, WHICH DOESN'T APPEAR TO BE DEFINED HERE, BUT IS
!WB	SUPPOSED TO BE THE LINE #
      IF (K.GT.200) GO TO 540
!WB	IF THE COUNTER IS GREATER THAN 200, THEN WRITE 'RAINFALL DATA 
!WB	EXCEEDS DIMENSION' AND STOP THE PROGRAM.
      IF (TC(I,2).LT.TMIN) TMIN=TC(I,2)
!WB	Time FOR rain gauge i,HISTOGRAM PERIOD 2 IS LT TMIN, SET TMIN
!WB	EQUAL TO THIS VALUE.
      IF (TC(I,KM1).GT.TMAX) TMAX=TC(I,KM1)
!WB	IF THE TIME FOR RAINGAGE I, HISTOGRAM PERIOD K-1, IS GT TMAX, THEN
!WB	SET TMAX EQUAL TO THIS VALUE.
   20 IRR(I)=K
!WB	LAST LINE IN THIS LOOP, Number of rainfall intensity readings for 
!WB	rain gauge i IS EQUAL TO K.

C
C **** INSERT SAME START AND FINISH TIME FOR EACH RAINGAGE RECORD.
C
      DO 30 I=1,NRG
      K=IRR(I)
!WB	RECALL THE # OF RAINFALL INTENSITY READINGS (BREAKPOINT INTERVALS)
!WB	FOR RAIN GAGE I
      KM1=K-1
!WB	SET KM1=K-1
      TC(I,1)=TMIN
!WB	THE TIME INTERVAL FOR GAGE I, HISTOGRAM PERIOD 1=TMIN
      RC(I,1)=0.
!WB	THE RAINFALL INTENSITY FOR GAGE I, HISTOGRAM PERIOD 1 =0
      IF (TC(I,KM1).EQ.TMAX) IRR(I)=IRR(I)-1
!WB	IF THE TIME INTERVAL FOR GAGE I, HISTOGRAM PERIOD (K-1) EQUALS
!WB	TMAX, THE # OF INTERVALS FOR GAGE I = SAME - 1
      TC(I,K)=TMAX
!WB	TIME INTERVAL FOR GAGE I, HISTOGRAM PERIOD K = MAX TIME INTERVAL
   30 RC(I,K)=0.
!WB	RAINFALL INTENSITY FOR GAGE I, HISTOGRAM PERIOD K = 0 

      IT=7
!WB	THIS IS A FLAG USED TO MANIPULATE AROUND THE PP ARRAY?
      DO 40 I=1,NRG
!WB	DO FROM 1 TO # OF RAIN GAGES
      L=IRR(I)
!WB	RECALL THE # OF HISTOGRAM INTERVALS FOR GAGE I
   40 CONTINUE
***    WRITE (2,670) IG(I),PP(IT+1),PP(IT+2),(TC(I,K),RC(I,K),K=2,L)
C **** RENUMBER RAINGAGES TO 1,2,..,NRG IN ORDER OF HYETOGRAPH INPUTS.
C
   50 IF (DT.GT.DTMIN*60.) WRITE (2,880)
!WB	WRITE 'ANALYSIS IS NOT CORRECT IF RAINFALL INTENSITY INTERVALS
!WB	ARE LESS THAN DT' 
      KPR=(TMAX-TMIN)/DT/DBLE(NDT)*60.+1.
!WB	Number of time increment routings between print lines =
!WB	(MAX TIME - MIN TIME) / (DT = Simulation time increment in (s)) / 
!WB	# OF LINES OF HYDROGRAPH PRINT * 60 + 1
      N2=NN-1
  430 DO 440 I=1,N2
!WB	DO FROM 1 TO # OF O.F. CELLS + CHANNEL CELLS
      S(I)=0.
!WB	Storage at start of time increment for element i (m3/s)
  440 FLINS(I)=0.
!WB	Storage, inflow and outflow for element i at start of time
!WB	increment (m3/s), 
      X=N
      Y=1./X
      DO 460 I=1,N
!WB	DO FROM 1 TO # OF O.F. ELEMENTS
      K=2
      IS=SOIL(I)/256
!WB	SOIL TYPE FOR ELEMENT I
      IC=MOD(SUR(I),256)
!WB	CROP COVERAGE FOR THIS CELL =cover type
      J=MOD(RANE(I),256)
!WB	RAIN GAGE # FOR THIS CELL
      IF (TC(J,2).LT.(TMIN+1.1)) K=3
!WB	IF THE TIME INTERVAL FOR RAIN GAGE J FOR THIS CELL, HISTOGRAM
!WB	PERIOD 2 IS LESS THAN MIN TIME FOR ANY HYETOGRAPH + 1.1, THEN K=3
      FRA(J)=FRA(J)+Y
!WB	FRACTION OF WATERSHED IN GAGE J = SAME + INVERSE OF # OF O.F. CELLS
      SUPP=RC(J,K)*(1.-PER(IC))*CU
!WB	Available supply for infiltration during time increment = RAINFALL
!WB	INTENSITY, GAGE J, PERIOD K * (1-Fraction of element area covered 
!WB	by foliage for surface type i FOR THIS CROP) * CONVERT MM/H TO M3/S

!RZ	URBAN::If the cell is urban, then skip over the function filt call 
!RZ	(as function filt is just potential infiltration, which would be zero 
!RZ	in the case of an urban cell). 
	IF (URB(I).EQ.1) THEN
	X=0.
	FILTS(I)=X
	GO TO 460
	END IF

      X=FILT(PIV(I),FCAP1(IS),GWC(IS),DR(I),S(I),SUPP,CU2,ROUGH
     1(IC),HU(IC),NEXP,ASMPER(I),KE(IS,IC),PSIF(IS),PHIC(IS),T,CU,LF(IS)
     2,KS(IS),IC,is,I,CUMIN1(I),rbit0(i),testi(i),timpon(i),tpon(i),
     3 FILTS(I),DT,CU1,TP1(IS),A(IS))
!WB	FILT = A FUNCTION IN SUBROUTINE DRAIN      
	FILTS(I)=X
!WB	INFIL CAP FOR ELEMENT I (M3*S-1) = FUNCTION FILTS
      IF (X.GT.SUPP) X=SUPP
!WB	IF INFIL CAP GT. SUPPLY, THEN INFIL CAP = SUPPLY
  460 FLINS(I)=SUPP-X
!WB	Storage, inflow and outflow for element i at start of time
!WB   increment (m3/s) = SUPPLY - INFIL CAP.
!RZ	Say WHAT?  this is confusing throughout the code.  It seems to me that
!RZ	FLINS is just the amount of water left over after infiltration has occurred
!RZ	This water is available for runoff or storage.
C
C **** CONVERT SURFACE VALUES.
C
      DO 480 I=1,ICR
!WB	DO FROM 1 TO # OF CROPS IN ROTATION
      DIRM2(I)=0.10*HU(I)
!WB	DIRM2 FOR CROP I = 0.10 * MAX HEIGHT DIFFERENTIAL ON SOIL SURFACE
      DO 470 J=1,NRG
!WB	DO FROM 1 TO # OF RAIN GAGES
      PIT(J,I)=PIT(1,I)*CU1/DT
!WB	Interception storage for cover for surface type i (mm) FOR GAGE J,
!WB	CROP # I = SAME FOR GAGE 1, CROP # I * (MM TO M3) / SIM TIME INCR
  470	CONTINUE
      ADIR=HU(I)*ROUGH(I)*(DIRM2(I)/HU(I))**(1./ROUGH(I))
!WB	ADIR=MAX HGT DIFF * SURF. DEPTH-STORAGE PARAM * ((0.10*HU)/HU)
!WB	^(1/SURF. DEPTH-STORAGE PARAM)
  480 DIR(I)=ADIR*2.*CU1/DT
!WB	Retention depth for cropping practice i (m3/s) = ADIR * 2 * MM TO 
!WB	M3 / SIM TIME INCREMENT
!RZ	SSTOR and DIR() are in units of 2*storage/DT for some strange reason,
!RZ	according to early ANSWERS documentation.  Therefore ADIR is the actual storage
!RZ	depth on the element.
C
C **** SET CHANNEL RETENTION TO ZERO.
C
      DIR(21)=0.

C *** NRZ 9/22/94
C *** CHANGE BOUNDS TO INCLUDE EXTRA CHANNEL OUTLETS
      J=NMAX+ISTRUC+1+NCHAN
C *** NRZ 9/22/94
!WB	THE NEXT 3 SECTIONS RESET VARS TO 0.
      DO 500 I=1,J
      IF (I.GT.NMAX) GO TO 490
      Q(I)=0.
      SS(I)=0.
      SEL(I)=0.
      NO3SEL(I)=0.
      NHWSEL(I)=0.
      NHSSEL(I)=0.
      TKNSEL(I)=0.
      PO4SEL(I)=0.
      PSEL(I)=0.

C **** NRZ 9/23/94
C **** CORRECTION
C **** MOVE LINE INDICATOR 484 TO INCLUDE PPT, ANPT, AND ONPT

      DO 484 IZ=1,NPART
      SST(I,IZ)=0.
      PPT(I,IZ)=0.
      ANPT(I,IZ)=0.
  484 ONPT(I,IZ)=0.

C **** NRZ 9/23/94

      DIN(I)=0.
  490 QI(I)=0.
      AINO3(I)=0.
      AINH4(I)=0.
      SPI(I)=0.
      DO 494 IZ=1,NPART
      SI(I,IZ)=0.
      PI(I,IZ)=0.
      ANI(I,IZ)=0.
  494 ONI(I,IZ)=0.

	IF(I.LE.N) CALL ATMDEPOSIT(YERBEG,LDAY,I,DX,SOIVOL,DT)

  500 CONTINUE
      RETURN
 
 
  540 WRITE (2,850)
      STOP
  570 WRITE (2,900) NRG,J
      STOP
C
C **** FORMATS.
C
  600 FORMAT (1X,'RAIN DATA MISSING FOR GAGE ',A2,12H, AT ELEMENT,I4,1H
     1,,I4,7H: GAGE ,A2,' DATA USED')
  670 FORMAT (/5X,12HGAGE NUMBER ,A2/5X,11HTIME - MIN.,7X,15HRAINFALL RA
     1TE -,2A4/(F14.1,F24.2))
  730 FORMAT (1X,2A4,2PF6.1,F7.0,0PF6.3,F6.2)
!TMN  (4/25/00) 
!TMN  740 FORMAT (A1,F8.0,F10.2)
!TMN  CHANGED TO ACCOMODATE TWO DECIMALS ON THE INTENSITY (ALSO
!TMN  CHANGED IN THE BREAKPOINT DATA AND TO MATCH THE FORMATTING 
!TMN  OF THE BREAKPOINT DATA SO TAMIE CAN SLEEP AT NIGHT!!!
  740 FORMAT (A1,F8.0,1X,F9.2)
  850 FORMAT (' RAINFALL DATA EXCEEDS DIMENSION')
  880 FORMAT (' ANALYSIS IS NOT ACCURATE IF RAINFALL INTENSITY',28H INT
     1ERVALS ARE LESS THAN DT.)
  900 FORMAT (1X,'HYETOGRAPH DATA MISSING OR INCORRECT',24H FIRST COLU
     1MN NOT 0 OR 1/I4,40H GAGES REQUESTED. BAD LINE BEGINS WITH: ,A2)
 
      END
 
      SUBROUTINE NITRAN(ES,FCVOL,SOIVOL,PEP,WP,N,TEMPC,ICR,
     &  RATEMX,CU1,SOITEM,RNUTNI,RNUTAM,RNUTP,DF1,TP1)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
 
*THIS SUBROUTINE INCLUDES NITROGEN TRANSFORMATION
* COMPUTING SOIL WATER COEFFICIENTS (SW)
* CALLING WP WILTING POINT WHICH MUST BE INPUT
 
      COMMON /TRANSF/POTMIN(35000),SOILN(35000),XMIN(35000),AMON(35000)
     & ,NIT(35000),DNI(35000),UPNH4(35000),UPNO3(35000),TDMN2(35000)
     & ,ROTR(35000),RFON(35000)
      DOUBLE PRECISION NIT,XMIN
 
      COMMON /TRAP/PMINP(35000),SOILP(35000),MINP(35000),PLAB(35000),
     &  UPPHOS(35000),TDMP2(35000),SORGP(35000),PSOL(35000),
     &  EDILAB(35000)
      DOUBLE PRECISION MINP

C *** NRZ 9/15/94
C *** DIMENSION VARIABLES TO REFLECT NMAX+ISTRUC+1+NCHAN

      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
   
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)
 
      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)
 
      COMMON/NITRO2/ O0SOIL(35000),ONPT(35000,8),ONI(35050,8),
     & ONSEL(35000),ON2(8),ONCELL(35000,8),ONE(8),ON0(35000,8)
 
      COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)
 
C *** NRZ 9/15/94

      COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
C
C **** MAXIMUM NUMBER OF SOIL TYPES IS 30.
C
      COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     & ,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &  CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &  THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &  CRC(30),KE(30,30),ZC(30),BD(30)
      DOUBLE PRECISION KS,LF,KE

         COMMON /ETPES/LAI(20,11),ESU(30),LAI1(20),POTLAI(20)
     &,SUMLAI(20)
	COMMON /EDX/ EDX(30)
      DOUBLE PRECISION LAI,LAI1
!	DOUBLE PRECISION LNO3ANNUAL
 
      COMMON /PARTITION/PKDA(30),PKDP(30),PSP(30)
 
      COMMON /PLANTN/DATPLA(20),DATHAR(20),CP1(20),CP2(20),DMY(20)
     &  ,YP(20),ROTMAX(20),ROTDAY(20),RLAIMX(20)
     &  ,RES(20),RES20(20),RES90(20)
      INTEGER DATPLA,DATHAR,TEMPC,SOITEM,ROTMAX,ROTDAY
 
      DIMENSION FCVOL(30),SOIVOL(30),TP1(30),
     &PEP(35000),WP(30),ES(35000),RATEMX(30),DF1(30)
c     fert array changed to 99: oct-97 JLCollado
      DIMENSION RNUTNI(99),RNUTAM(99),RNUTP(99),ILAI(20)
      DIMENSION RNUTZ(20),ICOUN1(20)
      INTEGER SUR,SOIL,RANE
 
** NRZ (10/12/94)
** ADD COMMON BLOCKS FOR NITRIFICATION CORRECTION

      COMMON /ROT/ IROT1,IROT(20,644)
      INTEGER IROT1,IROT
      COMMON /YEAR/ LDYEAR

	COMMON /MOISTURE/ XMOI(35000)
		
	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB

** NRZ (10/12/94)
 
*NOTE CU1=DX2/1000 CU1/10 WOULD CONVERTG KG TO KG/HA
      CONFAY=CU1/10.
      DX2=CU1*1000.
*COMPUTE TEMPERATURE COEFFICIENT
      IF(SOITEM.LE.0.) THEN
	TEMPFA=0.
      ELSE
       TEMPFA=(DBLE(SOITEM)/(DBLE(SOITEM)+
     &        DEXP(9.93-0.312*DBLE(SOITEM))))
      ENDIF
 
*     IF(SOITEM.LT.0.) THEN
*      TEMPFN=0.
*     ELSEIF (SOITEM.LT.10.) THEN
*      TEMPFN=0.496*DBLE(SOITEM)
*     ELSE
*      TEMPFN=DEXP(22.64-5956.4/DBLE(SOITEM+273))
*     ENDIF
 
      DO 9 I=1,ICR
       ILAI(I)=0
  9   CONTINUE
 
      DO 11 I=1,N
      MIC=MOD(SUR(I),256)
      ILAI(MIC)=1
 11   CONTINUE
 
      DO 20 I=1,ICR
!RZ	URBAN::: NO LAI FOR URBAN SOILS
	IF(URBSOIL(I).EQ.1) GO TO 20
       SUMLAI(I)=SUMLAI(I)+LAI1(I)*ILAI(I)
 20   CONTINUE
 
*ASSUME THAT NITRIFCATION OF AMMONIUM FERTILIZER TAKES 20 DAYS
 
      DO 2222 I=1,ICR
      IF(RNUTAM(I).GT.0) THEN
	RNUTZ(I)=RNUTAM(I)*0.8/20.
!RZ	RNUTAM=NUTrient AMmonia application
	ICOUN1(I)=20
      ENDIF

** NRZ (10/12/94)
** CORRECTION - MODIFY RNUTZ CALCULATION TO ACCOUNT FOR FERTILIZER
** APPLICATIONS < 20 DAYS BEFORE A ROTATION OCCURS.  ICOUN1(I+1)
** AND RNUTZ(I+1) TRANSFER NITRIFYING NH4 TO NEXT CROP IN ROTATION 
 
      IF(ICOUN1(I).GT.0) THEN
        ICOUN1(I)=ICOUN1(I)-1
        DO 2221 K=1,20
          IF (LDYEAR.EQ.IROT(K,2*I+1)) THEN
            ICOUN1(I+1)=ICOUN1(I)+1
            RNUTZ(I+1)=RNUTZ(I)
          ENDIF
 2221   CONTINUE
      ELSE
        RNUTZ(I)=0.
      ENDIF 
 2222 CONTINUE
 
*COMPUTE TRANSFORMATION
*CMN=MINERALIZATION CONSTANT=0.000KG/HA/D,POTMIN IS IN KG/HA
      CMN=0.0003
*BKN IS A RATE CONSTANT =0.0003KG/HA/DAY
      BKN=0.00001
      DO 1000 I=1,N
 
      MIC=MOD(SUR(I),256)
      MIS=SOIL(I)/256

!RZ	URBAN:::no moisture information for urban soils, so skip; also assuming
!RZ	that nutrients do not reside on the soil for long enough to convert forms.
	IF(URB(I).EQ.1) GO TO 1000
	IF(XMOI(I).LT.WP(MIS)) THEN
	xmoi(I)=wp(MIS)
	ENDIF
!WB	if soil moisture is less than wilting point 	
!WB	THIS LINE ADDED TO ALL CALL STATEMENTS DUE TO FLOAT OVERFLOWS AND
!WB	DOMAIN ERRORS ASSOCIATED WITH XMOI DROPPING BELOW WP 1/19/99	


      IF(XMOI(I).GT.FCVOL(MIS)) THEN
	SWFA=0.
      ELSE
       SWFA=(XMOI(I)-WP(MIS))/(FCVOL(MIS)-WP(MIS))
      ENDIF
 
      IF(XMOI(I).LT.WP(MIS)) THEN
       SWFN=0.
      ELSEIF(XMOI(I).LT.FCVOL(MIS)) THEN
       SWFN=(XMOI(I)-WP(MIS))/(FCVOL(MIS)-WP(MIS))
      ELSEIF(XMOI(I).LT.TP1(MIS)/CU1) THEN
       SWFN=1.-(XMOI(I)-FCVOL(MIS))/(TP1(MIS)/CU1-FCVOL(MIS))
      ELSE
       SWFN=0.
      ENDIF
 
      AMON(I)=AMON(I)+EDINH4(I)
      SZNO3(I)=SZNO3(I)+EDINO3(I)
*ADD NUTRIENTS IF PRESENT
      AMON(I)=AMON(I)+RNUTAM(MIC)
      SZNO3(I)=SZNO3(I)+RNUTNI(MIC)
      PLAB(I)=PLAB(I)+RNUTP(MIC)
 
      CP11=5.0
*COMPUTE RESIDUE MINERALIZATION
 
*COMPUTE RESIDUE MINERALIZATION
      IF(RES(MIC).GT.0.) THEN
      RFON(I)=RFON(I)+RES(MIC)
      ENDIF
 
 
	POTMIN(I)=POTMIN(I)+RES(MIC)
	SORGP(I)=SORGP(I)+RES(MIC)/CP11
 
 
  21   CONTINUE
*COMPUTE  FLOW BETWEEN ACTIVE AND STABLE POOL
      RTN=POTMIN(I)/(POTMIN(I)+SOILN(I))
      POTSO=BKN*(POTMIN(I)*RTN-SOILN(I))
       IF(POTSO.GT.POTMIN(I)) POTSO=POTMIN(I)
       IF(-POTSO.GT.SOILN(I)) POTSO=-SOILN(I)
       POTMIN(I)=POTMIN(I)-POTSO
       SOILN(I)=SOILN(I)+POTSO
*AMMONIFICATION
 
       IF(POTMIN(I).LT.(0.01*CONFAY))  THEN
	SOILN(I)=SOILN(I)+POTMIN(I)
	POTMIN(I)=0.0
	XMIN(I)=0.0
       ELSE
 
	XMIN(I)=CMN*POTMIN(I)*(SWFA*TEMPFA)**0.5
       ENDIF
       IF(XMIN(I).GT.POTMIN(I)) XMIN(I)=POTMIN(I)
       POTMIN(I)=POTMIN(I)-XMIN(I)
       AMON(I)=XMIN(I)+AMON(I)
 
*NITRIFICATION
 
       IF(AMON(I).LT.(0.01*CONFAY)) THEN
	IF(AMON(I).GT.0.) SZNO3(I)=SZNO3(I)+AMON(I)
	AMON(I)=0.
	NIT(I)=0.
       ELSE
 
	IF(RNUTZ(MIC).GT.0) THEN
	 NIT(I)=RNUTZ(MIC)
	ELSE
	 NIT(I)=0.1*SOIVOL(MIS)/1000000.
 
*        NIT(I)=0.1*TEMPFA*SWFN*SOIVOL(MIS)/1000000.
	ENDIF
*THE MAX RATEMX IS 100MG/KG SOIL/WEEK
	IF(NIT(I).GT.RATEMX(MIS)) NIT(I)=RATEMX(MIS)
 
	IF(NIT(I).GT.AMON(I)) THEN
	 NIT(I)=AMON(I)
	ENDIF
	AMON(I)=AMON(I)-NIT(I)
 
	IF(AMON(I).LT.(0.01*CONFAY)) THEN
	 IF(AMON(I).GT.0.) SZNO3(I)=SZNO3(I)+AMON(I)
	 AMON(I)=0.
	ENDIF
       ENDIF
 
       SZNO3(I)=SZNO3(I)+NIT(I)
 
* compute denitrification in case moisture content is higher
* than field capacity
      RFCV=FCVOL(MIS)+0.10*(TP1(MIS)/CU1-FCVOL(MIS))
 
      IF((XMOI(I)+PEP(I)+ES(I)).GT.RFCV) THEN
       SC=18.*POTMIN(I)/(SOIVOL(MIS)/1000.)
*DAILY DECAY RATE
       DK=24.*(0.0022*SC+0.0042)
       TFDN=DBLE(SOITEM)/(DBLE(SOITEM)+DEXP(9.93-0.321*DBLE(SOITEM)))
      SWFDN=((XMOI(I)+PEP(I)+ES(I))-RFCV)/(TP1(MIS)/CU1-RFCV)
*DENITTRFICATION
       DNI(I)=SZNO3(I)*(1-DEXP(-DK*TFDN*SWFDN))
       IF(DNI(I).LT.0.) DNI(I)=0.
       IF(SZNO3(I).LT.DNI(I)) THEN
	DNI(I)=SZNO3(I)
	SZNO3(I)=0.0
       ELSE
	SZNO3(I)=SZNO3(I)-DNI(I)
       ENDIF
      ELSE
       DNI(I)=0.
      ENDIF
*DISTRIBUTE AMMONIUM BETWEEN ADSORBED AND DISSOLVED AMMONIUM
*THE EQUILIBRIUM CONSTANT IS BASED ON CLAY CONTENT ECNH4
* ALL COMPUTATION ARE BASED ON MASSES NOT ON CONCENTRATION
      WATVOL=XMOI(I)*CU1*1000.
!RZ	1000 is conversion - density of water is 1000kg/m³, so this converts
!RZ	xmoi*cu1 in m³ to watvol in kg.
      WATVO1=FCVOL(MIS)*CU1*1000.
      SZNH4(I)=AMON(I)/(1+PKDA(MIS)*SOIVOL(MIS)/WATVOL)
      A0SOIL(I)=AMON(I)-SZNH4(I)
*COMPUTING PLANT UPTAKE
*COMPUTE INTO SUBROUTINE DATA SUMALI AND POTLAI
      PGRT=SUMLAI(MIC)/POTLAI(MIC)
*CONCENTRATION OF PLANT N IS IN PERCENT
      IF(SUMLAI(MIC).EQ.0.) THEN
       CN=0.
       CP=0.
       GOTO 22
      ENDIF
      CN=CP1(MIC)*PGRT**CP2(MIC)
      CP=CN/CP11
*COMPUTING THE DRY MATTER CONTENT
 22   DM=PGRT*YP(MIC)*DMY(MIC)
 
      TDMN1=0.01*CN*DM
      TDMN=TDMN1-TDMN2(I)
      TDMP1=0.01*CP*DM
      TDMP=TDMP1-TDMP2(I)
 
      IF (TDMN.LT.0.) TDMN=0.
      IF (TDMP.LT.0.) TDMP=0.
 
       TDMN2(I)=TDMN1
       TDMP2(I)=TDMP1
 
       UPNH4(I)=PEP(I)*CU1*1000.*SZNH4(I)/WATVOL
       UPNO3(I)=PEP(I)*CU1*1000.*SZNO3(I)/WATVOL
 
       TUPTN=UPNH4(I)+UPNO3(I)
       IF(TUPTN.GT.0.) THEN
	 DEMFAC=TDMN*CONFAY*ROTR(I)/TUPTN
	 UPNH4(I)=UPNH4(I)*DEMFAC
 
	  IF(UPNH4(I).GT.SZNH4(I)) THEN
	    UPNH4(I)=SZNH4(I)
	    SZNH4(I)=0.
	    AMON(I)=AMON(I)-UPNH4(I)
	  ELSE
	   AMON(I)=AMON(I)-UPNH4(I)
	   SZNH4(I)=SZNH4(I)-UPNH4(I)
	  ENDIF
 
	 UPNO3(I)=UPNO3(I)*DEMFAC
 
	  IF(UPNO3(I).GT.SZNO3(I)) THEN
	    UPNO3(I)=SZNO3(I)
	    SZNO3(I)=0.
	  ELSE
	   SZNO3(I)=SZNO3(I)-UPNO3(I)
	  ENDIF
 
	ENDIF
 
*COMPUTE THE AMOUNT OF NITRATE LOST THROUGH LEACHING
* THE ACTUAL CONCENTRATION OF NITRATE THUS THE FRACTION OF NITRATE
*LOST THROUGH LEACHING IS ASSUMING COMPLETE MIXING
	CNO3(I)=SZNO3(I)*CNH4(I)
	CLENO3(I)=CLENO3(I)+CNO3(I)

!TMN  ADDED TO SUM THE TOTAL NITROGEN THAT IS LEACHED ANNUALLY
!	LNO3ANNUAL=LNO3ANNUAL+CLENO3(I)

	SZNO3(I)=SZNO3(I)*(1.-CNH4(I))
*HERE SEDIMENT BOUND NITROGEN IS EXPRESSED IN KG P/KG SOIL
	 A0SOIL(I)=5.0*A0SOIL(I)/SOIVOL(MIS)
 
	 EDINO3(I)=SZNO3(I)*(VOLSZ(I)/PHI(MIS))*BD(MIS)*1000.
     &             /SOIVOL(MIS)
	 SZNO3(I)=SZNO3(I)-EDINO3(I)
	 SZNH4(I)=AMON(I)/(1.+PKDA(MIS)*SOIVOL(MIS)/WATVOL)
 
	 RBETA=0.598*DEXP(-0.179*PKDA(MIS))
 
	 EDINH4(I)=AMON(I)*(VOLSZ(I)/PHI(MIS))*BD(MIS)*1000.
     &             /SOIVOL(MIS)
	 AMON(I)=AMON(I)-EDINH4(I)
 
	 O0SOIL(I)=5.0*(AMON(I)+POTMIN(I)+SOILN(I))/SOIVOL(MIS)
 
	 PLAB(I)=PLAB(I)+EDILAB(I)
*PHOSPHORUS TRANSFORMATION
 
       IF(SORGP(I).LE.0.01) THEN
	PLAB(I)=PLAB(I)+SORGP(I)
	MINP(I)=0.
	SORGP(I)=0.
       ELSE
	MINP(I)=CMN*RTN*SORGP(I)*(SWFA*TEMPFA)**0.5
	IF(MINP(I).GT.SORGP(I)) MINP(I)=SORGP(I)
	SORGP(I)=SORGP(I)-MINP(I)
	PLAB(I)=PLAB(I)+MINP(I)
       ENDIF
 
       PTRANS=0.1*SWFA*DEXP(DBLE(0.115*SOITEM-2.88))*
     & (PLAB(I)-PMINP(I)*(PSP(MIS)/(1-PSP(MIS))))
       IF(PTRANS.GT.PLAB(I)) PTRANS=PLAB(I)
       PLAB(I)=PLAB(I)-PTRANS
       IF(PLAB(I).LE.0) PLAB(I)=0.
       IF(PMINP(I).LE.0.) PMINP(I)=0.
       PMINP(I)=PMINP(I)+PTRANS
*COMPUTING THE TRANSFER BETWEEN STABLE AND ACTIVE P POOLS
       TRANP=DEXP(-1.77*PSP(MIS)-7.05)
     &       *(4.*PMINP(I)-SOILP(I))
       IF(TRANP.GT.0.) THEN
	IF(TRANP.GT.PMINP(I)) TRANP=PMINP(I)
       ELSE
	IF(-TRANP.GT.SOILP(I)) TRANP=-SOILP(I)
       ENDIF
 
       SOILP(I)=SOILP(I)+TRANP
       PMINP(I)=PMINP(I)-TRANP
 
 
 
*DISTRIBUTE PLAB BETWEEN SEDIMENT BOUND AND DISSOLVED PHASE
      PSOL(I)=PLAB(I)/(1+PKDP(MIS)*SOIVOL(MIS)/WATVOL)
      P0SOIL(I)=PLAB(I)-PSOL(I)
 
      UPPHOS(I)=PEP(I)*CU1*1000.*PSOL(I)/WATVOL
 
	IF(UPPHOS(I).GT.0.) THEN
	 DEMFAC=TDMP*CONFAY*ROTR(I)/UPPHOS(I)
	 UPPHOS(I)=UPPHOS(I)*DEMFAC
 
	  IF(UPPHOS(I).GT.PSOL(I)) THEN
	    UPPHOS(I)=PSOL(I)
	    PSOL(I)=0.
	    PLAB(I)=PLAB(I)-UPPHOS(I)
	  ELSE
	   PLAB(I)=PLAB(I)-UPPHOS(I)
	   PSOL(I)=PSOL(I)-UPPHOS(I)
	  ENDIF
	ENDIF
 
	 PLAB(I)=PSOL(I)+P0SOIL(I)
	 PSOL(I)=PLAB(I)/(1.+PKDP(MIS)*SOIVOL(MIS)/WATVOL)
	 P0SOIL(I)=PLAB(I)-PSOL(I)
 
      EDILAB(I)=PLAB(I)*(VOLSZ(I)/PHI(MIS))*BD(MIS)*1000.
     &             /SOIVOL(MIS)
	 P0SOIL(I)=5.*P0SOIL(I)/SOIVOL(MIS)
	 PLAB(I)=PLAB(I)-EDILAB(I)
 
       CNO3(I)=0.
 1000  CONTINUE
 
       DO 1010 I=1,ICR
	 RES(I)=0
 1010  CONTINUE
 
2000   FORMAT( 7(1X,F10.4))
       END

C **** NRZ 10/11/94
C **** THE FOLLOWING SUBROUTINES AND FUNCTIONS WERE ADDED TO SIMULATE
C **** IMPOUNDMENTS FOR EACH CHANNEL

      SUBROUTINE IMPOND(IDATE,RAITES,N,DIAM,SPEC,VOLUME,MASSIN,EVAP,
     &                  MLOST,MASTOT,DVOLO,NCH)

      COMMON /IMPDIM/ BASE,WIDTH,SLOPE,ORIF,CI,FI,MAXHGT,NIMP
      DOUBLE PRECISION BASE(10),WIDTH(10),SLOPE(10),ORIF(10),CI(10),
     &FI(10),MAXHGT(10)

      DOUBLE PRECISION  DIAM(N),SPEC(N),MASSIN(10,N),
     $EVAP, MLOST(10,N), MASTOT(10,N),VEL(10), MASREM(10,10),H(10,10),
     $RHO(10,10), MAXVOL(10),INFIL(10),DEPAVG(10),LOST(10),NDEPTH(10),
     $HAVG(10),STORAG(10),DELTIM, MASS(10,10),VOLUME(10),DVOLO(10),
     $DEPTH(10),RATE(10),HEAD(10),VOLOUT(10),XROOT,VOL  
      INTEGER I,RAITES
 
C *** DELTIM MUST EVENLY DIVIDE 86400 - THE NUMBER OF SECONDS IN A DAY -
C ***  IF A NEW TIME STEP IS SELECTED.  THE STEP MUST BE IN SECONDS!
 
      DELTIM = 900.0

C *** ESTABLISHES INITIAL CONDITIONS AT SIMULATION START ***
C ***
C *** MAKE SURE SEDIMENT AND RUNOFF ENTERING ARE ZERO ON DAYS WITH NO
C *** RAINFALL EVENT

      IF (RAITES.EQ.0) THEN
        DO 5 I=1,N
          MASSIN(NCH,I)=0.0
 5      CONTINUE 
      VOLUME(NCH)=0.0
      LOST(NCH)=0.0
      ENDIF
C *** SET SEDIMENT OUTFLOW TO ZERO
      DO 10 I=1,N
        MLOST(NCH,I) = 0.0
        MASTOT(NCH,I) = 0.0
10    CONTINUE
      IF (IDATE.NE.1) GOTO 15
       CALL SETTLE(DIAM, SPEC, VEL, N)
       MAXVOL(NCH) = VOL(MAXHGT(NCH), BASE(NCH), WIDTH(NCH),
     &               SLOPE(NCH))
       DO 55 I = 1, N
        MASREM(NCH,I) = 0.0
        MASTOT(NCH,I) = 0.0
55      H(NCH,I) = 0.0
       STORAG(NCH) = 0.0
 
C *** ESTABLISHES CONDITIONS AT START OF EACH SIMULATED DAY ***
15    IF (VOLUME(NCH) .LE. 0.01) GOTO 29
      STORAG(NCH) = STORAG(NCH) + VOLUME(NCH)
      IF (STORAG(NCH) .GT. MAXVOL(NCH)) THEN
       LOST(NCH) = STORAG(NCH) - MAXVOL(NCH)
       STORAG(NCH) = MAXVOL(NCH) - 0.1
        DO 44 I = 1, N
        MLOST(NCH,I) = (LOST(NCH)/VOLUME(NCH))*MASSIN(NCH,I)
44      MASS(NCH,I) = MASSIN(NCH,I) - MLOST(NCH,I)
      ELSE
        DO 45 I=1,N
45      MASS(NCH,I) = MASSIN(NCH,I)
      ENDIF
      DEPTH(NCH) = XROOT(STORAG(NCH),BASE(NCH),WIDTH(NCH),SLOPE(NCH),
     &             MAXHGT(NCH))
C      WRITE(*,*) DEPTH(NCH)
C *** ESTABLISHES PARTICLE CLASS DENSITY ***
      DO 7 I = 1, N
       RHO(NCH,I) = (MASREM(NCH,I) + MASS(NCH,I))/STORAG(NCH)
       H(NCH,I) = DEPTH(NCH)
7     CONTINUE
 
C *** SIMULATES IMPOUNDMENT PERFORMANCE GIVEN DAILY INPUTS ***
 
29    DO 77 I = 1, 86400/DELTIM
C *** ESTABLISHES DEPTH OF WATER IN IMPOUNDMENT ***
 
      HEAD(NCH) = DEPTH(NCH) - ORIF(NCH)
      
      IF (DEPTH(NCH) .GT. ORIF(NCH)) THEN
!WB   THIS LINE ADDED BY SEAN AND WES BUT NOT IN USLE MODEL
	RATE(NCH) = CI(NCH)*HEAD(NCH)**FI(NCH)/3600
      VOLOUT(NCH) = RATE(NCH)*DELTIM
	ENDIF
      IF (DEPTH(NCH) .LE. ORIF(NCH)) VOLOUT(NCH) = 0.0
      STORAG(NCH) = STORAG(NCH) - VOLOUT(NCH)

      IF (STORAG(NCH) .LE. 0.0) GOTO 99
      NDEPTH(NCH) = XROOT(STORAG(NCH),BASE(NCH),WIDTH(NCH),SLOPE(NCH),
     &                    MAXHGT(NCH))
     $- EVAP/24.0 - INFIL(NCH)
      IF (NDEPTH(NCH) .LT. 0.0) THEN
        NDEPTH(NCH) = 0.0
        DO 98 J = 1, N
98      H(NCH,J) = 0.0
        GOTO 99
      ENDIF
      IF (DEPTH(NCH) .GT. ORIF(NCH) .AND. NDEPTH(NCH) .LT. ORIF(NCH)) 
     & NDEPTH(NCH) = ORIF(NCH)
      DEPAVG(NCH) = (DEPTH(NCH) + NDEPTH(NCH))/2.0
 
      DO 27 K = 1, N
C *** TRACKS HEIGHT OF EACH DISCRETE PARTICLE CLASS IN IMPOUNDMENT ***
 
      IF (H(NCH,K) .LE. 0.0) GOTO 27
       HOLD = H(NCH,K)
       H(NCH,K) = H(NCH,K) - (DEPTH(NCH) - NDEPTH(NCH)) - VEL(K)*DELTIM
       HAVG(NCH) = (H(NCH,K) + HOLD)/2.0
      IF (HAVG(NCH) .LT. 0.0) HAVG(NCH) = HOLD/2.0
      IF (HOLD .GT. ORIF(NCH) .AND. HAVG(NCH) .LT. ORIF(NCH)) 
     & HAVG(NCH) = (HOLD +  ORIF(NCH))/2.0
 
C *** CALCULATES MASS LOST THROUGH DRAIN PIPE ***
      IF (HAVG(NCH) .GT. ORIF(NCH)) THEN
C        WRITE(*,*) HAVG(NCH), DEPAVG(NCH), RHO(NCH)1)
        PROP = (HAVG(NCH) - ORIF(NCH))/(DEPAVG(NCH) - ORIF(NCH)) * 
     &          VOLOUT(NCH) * RHO(NCH,K)
        MASTOT(NCH,K) = PROP + MASTOT(NCH,K)
      ENDIF
 
      IF (H(NCH,K) .LE. 0.0) H(NCH,K) = 0.0
27    CONTINUE
      DEPTH(NCH) = NDEPTH(NCH)
      
** NRZ 
** ACCUMULATE VOLUME OF RUNOFF OUT OF IMPOUNDMENT FOR EACH DAY
      DVOLO(NCH) = DVOLO(NCH) + VOLOUT(NCH)


77    CONTINUE
      DVOLO(NCH) = DVOLO(NCH) + LOST(NCH)

** MAKE SURE VOLUME OUT IS NOT GREATER THAN VOLUME IN
      IF (DVOLO(NCH).GT.VOLUME(NCH)) DVOLO(NCH)=VOLUME(NCH)
** NRZ

      DO 87 I = 1, N
87     MASREM(NCH,I) = RHO(NCH,I)*VOL(H(NCH,I), BASE(NCH),
     &                 WIDTH(NCH),SLOPE(NCH))
99    RETURN
      END
  
      SUBROUTINE SETTLE(DIAM, SPEC, VEL, N)
      DOUBLE PRECISION DIAM(N), VEL(N), VCHECK, RN, CDH, SPEC(N),
     &                 RE,CD
      DO 17 I = 1,N
      VEL(I) = (SPEC(I) - 1.0)*999.0*9.81/(18.0*1.002*10**(-3.0))
     $*DIAM(I)**2
!RZ	look at this equation from earlier in the program to determine
!RZ	what all those numbers stand for:
!RZ	 FV(IC)=AGRAV*(SG(IC)-1.)*VISCOS*DIA(IC)**2/18.
19    RN = RE(VEL, DIAM, N, I)
      IF (RN.LT.1.0) GOTO 17
      CDH = CD(RN)
      VCHECK = DSQRT(DIAM(I)*(SPEC(I)-1.0)*9.81*4.0/(3.0*CDH))
      IF (ABS((VEL(I) - VCHECK)/VEL(I)) .GT. 0.05) THEN
      VEL(I) = VCHECK
      GOTO 19
      ENDIF
17    CONTINUE
      RETURN
      END

      FUNCTION CD(RN)
      DOUBLE PRECISION CD, RN
      IF (RN .GT. 10000) THEN
      CD = 0.4
      ELSEIF (RN .LT. 10000 .AND. RN .GE. 1.0) THEN
      CD = 24.0/RN + 3.0/DSQRT(RN) + 0.34
      ELSE
      CD = 24.0/RN
      ENDIF
      RETURN
      END
 
      FUNCTION RE(VEL, DIAM, N, I)
      DOUBLE PRECISION VEL(N), DIAM(N), RE
      INTEGER I
      RE = VEL(I)*DIAM(I)*997006.0
      RETURN
      END
 
      FUNCTION XROOT(VOL,BA,W,S,MAXHGT)
      DOUBLE PRECISION  X,W,S,A,B,VOL,XERROR,MID,XROOT,F,BA,MAXHGT
      F(X) = BA*W*X + (X**2.)*S*(BA+W) + (4.0/3.0)*(S**2.)*(X**3.)-VOL
      XERROR = 0.05
      A = 0.0
      B = MAXHGT
      DO 20 I = 1,30
      MID = (A + B)/2.
      IF (F(A) * F(MID) .LT. 0.0) THEN
      B = MID
      IF ( (B-A) .LE. XERROR) THEN
      XROOT = (A+B)/2.
      GOTO 23
      ENDIF
      ELSE
      A = MID
      ENDIF
20    CONTINUE
23    RETURN
      END
 
      FUNCTION VOL(X, BASE, WIDTH, SLOPE)
      DOUBLE PRECISION X, BASE, WIDTH, SLOPE, VOL
      VOL = X*BASE*WIDTH + X**2*(BASE+WIDTH)*SLOPE + 4.0/3.0*SLOPE**2*
     $X**3
      RETURN
      END

      SUBROUTINE EVAPFW(LDAY)

      COMMON /FWATER/ AFWEV,DFWEV
      DOUBLE PRECISION AFWEV,DFWEV

***** THIS SUBROUTINE CALCULATES THE DAILY EVAPORATION FROM A FREE WATER
***** SURFACE BASED ON THE MEAN ANNUAL FREE WATER SURFACE EVAPORATION 
***** AND JULIAN CALENDAR DATE.  MONTHLY SOLAR RADIATION VALUES ARE USED
***** TO PROPORTION THE ANNUAL EVAPORATIVE DEPTH INTO REASONABLE ESTIMATES
***** FOR EACH MONTH AND DAY OF THE YEAR.  EVAPORATION RATES ARE CONSIDERED 
***** CONSTANT IN ANY ONE MONTH.

      IF ((LDAY.GE.1).AND.(LDAY.LE.31)) THEN
        DFWEV = 0.050*AFWEV/31.
      ELSEIF ((LDAY.GE.32).AND.(LDAY.LE.59)) THEN
        DFWEV = 0.065*AFWEV/28.
      ELSEIF ((LDAY.GE.60).AND.(LDAY.LE.90)) THEN
        DFWEV = 0.082*AFWEV/31.
      ELSEIF ((LDAY.GE.91).AND.(LDAY.LE.120)) THEN
        DFWEV = 0.099*AFWEV/30.
      ELSEIF ((LDAY.GE.121).AND.(LDAY.LE.151)) THEN
        DFWEV = 0.110*AFWEV/31.
      ELSEIF ((LDAY.GE.152).AND.(LDAY.LE.181)) THEN
        DFWEV = 0.115*AFWEV/30.
      ELSEIF ((LDAY.GE.182).AND.(LDAY.LE.212)) THEN
        DFWEV = 0.112*AFWEV/31.
      ELSEIF ((LDAY.GE.213).AND.(LDAY.LE.243)) THEN
        DFWEV = 0.104*AFWEV/31.
      ELSEIF ((LDAY.GE.244).AND.(LDAY.LE.273)) THEN
        DFWEV = 0.089*AFWEV/30.
      ELSEIF ((LDAY.GE.274).AND.(LDAY.LE.304)) THEN
        DFWEV = 0.071*AFWEV/31.
      ELSEIF ((LDAY.GE.305).AND.(LDAY.LE.334)) THEN
        DFWEV = 0.055*AFWEV/30.
      ELSEIF ((LDAY.GE.335).AND.(LDAY.LE.365)) THEN
        DFWEV = 0.046*AFWEV/31.
      ENDIF
      
      END 

C **** NRZ 10/11/94

C **** NRZ 11/4/94
C **** THIS SUBROUTINE WAS ADDED FOR CONSOLE DISPLAY PURPOSES
C **** IT PRINTS THE CALENDAR MONTH AND DAY, AND INDICATES A STORM
C **** OR FERTILIZATION DAY

      SUBROUTINE XDATE (LDAY,YERBEG,IDATE,SIMDUR,RAITES,NFPR,IRRFLAG)

      CHARACTER*3 MONTH
      INTEGER LDAY,DAYMON,YERBEG,SIMDUR,RAITES
     
      RDATE=REAL(IDATE)
      RSIM=REAL(SIMDUR)

      IF (MOD(YERBEG,4).NE.0) THEN
        IF ((LDAY.GE.1).AND.(LDAY.LE.31)) THEN
          MONTH='JAN'
          NDB=0
        ELSEIF ((LDAY.GE.32).AND.(LDAY.LE.59)) THEN
          MONTH='FEB'
          NDB=31
        ELSEIF ((LDAY.GE.60).AND.(LDAY.LE.90)) THEN
          MONTH='MAR'
          NDB=59
        ELSEIF ((LDAY.GE.91).AND.(LDAY.LE.120)) THEN
          MONTH='APR'
          NDB=90
        ELSEIF ((LDAY.GE.121).AND.(LDAY.LE.151)) THEN
          MONTH='MAY'
          NDB=120
        ELSEIF ((LDAY.GE.152).AND.(LDAY.LE.181)) THEN
          MONTH='JUN'
          NDB=151
        ELSEIF ((LDAY.GE.182).AND.(LDAY.LE.212)) THEN
          MONTH='JUL'
          NDB=181
        ELSEIF ((LDAY.GE.213).AND.(LDAY.LE.243)) THEN
          MONTH='AUG'
          NDB=212
        ELSEIF ((LDAY.GE.244).AND.(LDAY.LE.273)) THEN
          MONTH='SEP'
          NDB=243
        ELSEIF ((LDAY.GE.274).AND.(LDAY.LE.304)) THEN
          MONTH='OCT'
          NDB=273
        ELSEIF ((LDAY.GE.305).AND.(LDAY.LE.334)) THEN
          MONTH='NOV'
          NDB=304
        ELSEIF ((LDAY.GE.335).AND.(LDAY.LE.365)) THEN
          MONTH='DEC'
          NDB=334
        ENDIF
      ELSE
        IF ((LDAY.GE.1).AND.(LDAY.LE.31)) THEN
          MONTH='JAN'
          NDB=0
        ELSEIF ((LDAY.GE.32).AND.(LDAY.LE.60)) THEN
          MONTH='FEB'
          NDB=31
        ELSEIF ((LDAY.GE.61).AND.(LDAY.LE.91)) THEN
          MONTH='MAR'
          NDB=60
        ELSEIF ((LDAY.GE.92).AND.(LDAY.LE.121)) THEN
          MONTH='APR'
          NDB=91
        ELSEIF ((LDAY.GE.122).AND.(LDAY.LE.152)) THEN
          MONTH='MAY'
          NDB=121
        ELSEIF ((LDAY.GE.153).AND.(LDAY.LE.182)) THEN
          MONTH='JUN'
          NDB=152
        ELSEIF ((LDAY.GE.183).AND.(LDAY.LE.213)) THEN
          MONTH='JUL'
          NDB=182
        ELSEIF ((LDAY.GE.214).AND.(LDAY.LE.244)) THEN
          MONTH='AUG'
          NDB=213
        ELSEIF ((LDAY.GE.245).AND.(LDAY.LE.274)) THEN
          MONTH='SEP'
          NDB=244
        ELSEIF ((LDAY.GE.275).AND.(LDAY.LE.305)) THEN
          MONTH='OCT'
          NDB=274
        ELSEIF ((LDAY.GE.306).AND.(LDAY.LE.335)) THEN
          MONTH='NOV'
          NDB=305
        ELSEIF ((LDAY.GE.336).AND.(LDAY.LE.366)) THEN
          MONTH='DEC'
          NDB=335
        ENDIF
      ENDIF

      DAYMON=LDAY-NDB
      PC=(RDATE/RSIM)*100.

      IF (IDATE.EQ.1) THEN
        WRITE (*,*)
        WRITE (*,*)
        WRITE (*,*) '***************************  ANSWERS ',
     &              'INITIALIZED  *************************'
        WRITE (*,*)
        WRITE (*,*)
      ENDIF
!RZ   377 UNIT FILES WRITING ADDED FOR ISOLATION OF PROBLEM WITH QA(IY+1)
      IF (MOD(LDAY,20).EQ.0) THEN
        WRITE (*,10)  'SIMULATING ',MONTH,DAYMON,YERBEG,
     &                'SIMULATION ',INT(PC),'% COMPLETE'
!	  WRITE (377,10) 'SIMULATING ',MONTH,DAYMON,YERBEG
      ELSE
        WRITE (*,10)  'SIMULATING ',MONTH,DAYMON,YERBEG
!	  WRITE (377,10) 'SIMULATING ',MONTH,DAYMON,YERBEG
      ENDIF

      IF (RAITES.EQ.1) THEN 
        WRITE (*,*) '  ...Raining'
        WRITE (*,*)
      ENDIF

      IF (NFPR.EQ.1) THEN
        WRITE (*,*) '  ...Fertilizing'
        WRITE (*,*)
        NFPR = 0
      ENDIF

	IF (IRRFLAG.EQ.1) THEN
	  WRITE (*,*) '  ...Irrigating'
	  WRITE (*,*)
	END IF

      IF (IDATE.EQ.SIMDUR) THEN
        WRITE (*,*)
        WRITE (*,*)
        WRITE (*,*) '**************************  SIMULATION ',
     &              'COMPLETE  ***************************'
        WRITE (*,*)
        WRITE (*,*)
      ENDIF

   10 FORMAT (1X,A11,A3,1X,I2,1X,I4,11X,A11,I4,1X,A10)
      RETURN
      END 

C **** NRZ 11/4/94



!RWZ	The following subroutine was added 7/19/01 to account for atmospheric
!RWZ	deposition of sediment, nutrients, etc.
	SUBROUTINE ATMDEPOSIT(YERBEG,LDAY,M,DX,SOIVOL,DT)

	IMPLICIT DOUBLE PRECISION A-H, O-Z
	COMMON /ATMDEPO/ ATMDEP(21,4),TKNDEP(21,4),AMNDEP(21,4),
	1SEPDEP(21,4)
	COMMON /DEPOSITION/ O0ADD(35000),A0ADD(35000),P0ADD(35000)
	COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
      INTEGER SUR,TIAL(35000),RANE,SOIL
	COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)

	COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL

	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB



	DIMENSION LASTLDAY(21), DEPOSITION(21), SOIVOL(30), 
	1TKNDEPOSIT(21),AMNDEPOSIT(21),SEPDEPOSIT(21)
	INTEGER YEARENDDAY,WINTERDIFF,SPRINGDIFF,FALLDIFF,SUMMERDIFF
	INTEGER YERBEG
	DOUBLE PRECISION DEPOSITION, TKNDEPOSIT

	L=MOD(SUR(M),256)
	!retrieve crop type
	K=SOIL(M)/256
	!retrieve soil type
	IF (LDAY.NE.LASTLDAY(L)) THEN
	!the following loop needs to be taken out as soon as the program reads this with the input
!	DO J=1,4
!		ATMDEP(L,J)=0.0000166*DX**2 
					!0.0000166 is the rate in kg/ha/yr /365/10000
!		TKNDEP(L,J)=0.000000589*DX**2
!		AMNDEP(L,J)=0.000000433*DX**2
!		SEPDEP(L,J)=0.000000054*DX**2
		!SEdiment bound ortho-P
!	END DO
		IF(MOD((YERBEG-1),4).EQ.0) THEN
			YEARENDDAY=366
		ELSE
			YEARENDDAY=365
		END IF
		!above if then checks for a leap year last year
		!this is so that if the period since last rainfall laps
		!a year (namely, lastraites occurs last year), the 
		!correct end of year day is used
	IF ((LDAY.GE.355).OR.(LDAY.LT.80)) THEN !LDAY IS IN WINTER
		IF(LDAY.GE.355) THEN
			LDAYDIFF=LDAY-355
		ELSE
			LDAYDIFF=LDAY+YEARENDDAY-355
		END IF
		IF((LASTRAITES.GE.355).OR.(LASTRAITES.LT.80)) THEN !LASTRAITES IN WIN.
		  TOTALDAYS=80+YEARENDDAY-355
		  IF (LASTRAITES.GE.355) THEN
			LASTRAITDD=YEARENDDAY-LASTRAITES+80
		  ELSE
			LASTRAITDD=80-LASTRAITES
	      END IF
		  WINTERDIFF=LDAYDIFF-(TOTALDAYS-LASTRAITDD)
		  SUMMERDIFF=0
		  SPRINGDIFF=0
		  FALLDIFF=0
		ELSE !LASTRAITES OCCURS NOT IN WINTER
			WINTERDIFF=LDAYDIFF
			SPRINGDIFF=172-LASTRAITES
			IF(SPRINGDIFF.LT.0) SPRINGDIFF=0
			SUMMERDIFF=264-LASTRAITES-SPRINGDIFF
			IF(SUMMERDIFF.LT.0) SUMMERDIFF=0
			FALLDIFF=355-LASTRAITES-SUMMERDIFF-SPRINDIFF
		END IF		
	ELSE IF ((LDAY.GE.80).AND.(LDAY.LT.172)) THEN !LDAY IN SPRING
		LDAYDIFF=LDAY-80
		IF((LASTRAITES.GE.80).AND.(LASTRAITES.LT.172)) THEN !LASTRAITES IN SPR
			WINTERDIFF=0
			SPRINGDIFF=LDAY-LASTRAITES
			SUMMERDIFF=0
			FALLDIFF=0
		ELSE
			CONTINUE 
			IF ((LASTRAITES.GE.172).AND.(LASTRAITES.LT.355)) THEN !SUMM, FALL
				WINTERDIFF=80+YEARENDDAY-355 !ALL OF WINTER INCLUDED
				SUMMERDIFF=264-LASTRAITES
				IF(SUMMERDIFF.LT.0) SUMMERDIFF=0
				FALLDIFF=355-LASTRAITES-SUMMERDIFF
				IF(FALLDIFF.LT.0) FALLDIFF=0
			ELSE
				!LAST RAIN LAST SEASON, IN WINTER
				IF(LASTRAITES.GE.355) THEN
					WINTERDIFF=80+YEARENDDAY-LASTRAITES
				END IF
				IF(LASTRAITES.LT.80) THEN
					WINTERDIFF=80-LASTRAITES
				END IF
				SUMMERDIFF=0
				FALLDIFF=0
			END IF
			SPRINGDIFF=LDAYDIFF
		END IF
	ELSE IF ((LDAY.GE.172).AND.(LDAY.LT.264)) THEN !LDAY IN SUMMER
		LDAYDIFF=LDAY-172
		IF((LASTRAITES.GE.172).AND.(LASTRAITES.LT.264)) THEN !IN SUMMER
			WINTERDIFF=0
			SPRINGDIFF=0
			SUMMERDIFF=LDAY-LASTRAITES
			FALLDIFF=0
		ELSE
			SUMMERDIFF=LDAYDIFF
			IF(((LASTRAITES.GE.264).AND.(LASTRAITES.LT.355)).OR.
     &			((LASTRAITES.GE.80).AND.(LASTRAITES.LT.172))) THEN
				!LASTRAITES IN FALL OR SPRING
				SPRINGDIFF=172-LASTRAITES
				IF(SPRINDIFF.LT.0) THEN !LASTRAITES IN FALL
					SPRINGDIFF=172-80
					WINTERDIFF=80+YEARENDDAY-355
					FALLDIFF=355-FALLDIFF
				ELSE
					WINTERDIFF=0
					FALLDIFF=0
				END IF
			ELSE !LASTRAITES IN WINTER
				IF(LASTRAITES.GE.355) THEN
					WINTERDIFF=80+YEARENDDAY-LASTRAITES
				ELSE
					WINTERDIFF=80-LASTRAITES
				END IF
				SPRINGDIFF=172-80
				FALLDIFF=0
			END IF
		END IF
	ELSE IF ((LDAY.GE.264).AND.(LDAY.LT.355)) THEN !LDAY IN FALL
		LDAYDIFF=LDAY-264
		IF ((LASTRAITES.GE.264).AND.(LASTRAITES.LT.355)) THEN
			!LASTRAITES IN FALL
			WINTERDIFF=0
			SPRINGDIFF=0
			SUMMERDIFF=0
			FALLDIFF=LDAY-LASTRAITES
		ELSE IF((LASTRAITES.GE.80).AND.(LASTRAITES.LT.264)) THEN
			!LASTRAITES IN SPRING OR SUMMER
			WINTERDIFF=0
			SPRINGDIFF=172-LASTRAITES
			IF(SPRINGDIFF.LT.0) SPRINGDIFF=0
			SUMMERDIFF=264-LASTRAITES-SPRINGDIFF
			FALLDIFF=LDAYDIFF
		ELSE !LASTRAITES IN WINTER
			FALLDIFF=LDAYDIFF
			IF(LASTRAITES.GE.355) THEN
				WINTERDIFF=80+YEARENDDAY-LASTRAITES
			ELSE
				WINTERDIFF=80-LASTRAITES
			END IF
			SUMMERDIFF=264-172
			SPRINGDIFF=172-80
		END IF
	END IF


	DEPOSITION(L)=SPRINGDIFF*ATMDEP(L,1)+SUMMERDIFF*ATMDEP(L,2)+
     &FALLDIFF*ATMDEP(L,3)+WINTERDIFF*ATMDEP(L,4)
	TKNDEPOSIT(L)=SPRINGDIFF*TKNDEP(L,1)+SUMMERDIFF*TKNDEP(L,2)+
	1FALLDIFF*TKNDEP(L,3)+WINTERDIFF*TKNDEP(L,4)
	AMNDEPOSIT(L)=SPRINGDIFF*AMNDEP(L,1)+SUMMERDIFF*AMNDEP(L,2)+
	1FALLDIFF*AMNDEP(L,3)+WINTERDIFF*AMNDEP(L,4)
	SEPDEPOSIT(L)=SPRINGDIFF*SEPDEP(L,1)+SUMMERDIFF*SEPDEP(L,2)+
	1FALLDIFF*SEPDEP(L,3)+WINTERDIFF*SEPDEP(L,4)

!	WRITE(377,*) ' LDAY  LDAYOLD  LTRAI  WIN SPR SUM FALL  DEP  
!	1YEARBEG  YEAREND'
!	WRITE(377,2223) LDAY, LDAYOLD, LASTRAITES, WINTERDIFF, SPRINGDIFF, 
!     &SUMMERDIFF, FALLDIFF, DEPOSITION(L), YERBEG, YEARENDDAY

	LDAYOLD=LASTRAITES
	LASTRAITES=LDAY
	LASTLDAY(L)=LDAY
2223	FORMAT (1X,I3,3X,I3,6X,I3,4X,I3,1X,I3,1X,I3,1X,I3,3X,F5.2,1X,I4,5X
	1,I4)
	END IF
	!only do this if it is a new day

	O0ADD(M)=TKNDEPOSIT(L)
	A0ADD(M)=AMNDEPOSIT(L)
	P0ADD(M)=SEPDEPOSIT(L)
	SEL2(M,1)=SEL2(M,1)+DEPOSITION(L)/DT
	!Accumulate atmospheric deposition, if any.  Atmospheric deposition of sediment is assumed
	!to be in the clay particle size class only.
	RETURN
!RZ	above added by Rebecca Zeckoski 7/16/01 to account for atmospheric deposition
	END

!RWZ	Subroutine to calculate wet atmospheric deposition
	SUBROUTINE WETDEP(RATE,M,LDAY,K)

	IMPLICIT DOUBLE PRECISION A-H, O-Z	

	COMMON /WETDEPOSIT/ NO3ZDEP(21,4),WATNHDEP(21,4),SOLUBPDEP(21,4),
	1TSSDEP(21,4)
	DOUBLE PRECISION NO3ZDEP, WATNHDEP, SOLUBPDEP,TSSDEP

	COMMON /SOLUB/ SP2(35000),PEXT(35000),PK(30)
     & ,RBETA(30),SPI(35050),CGEN1(35000)
     & ,T13(35000),SPSP(35000)

      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)
 
      COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)

	COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)
	
	IF((LDAY.LT.80).AND.(LDAY.GE.355)) THEN
	!winter time
	J=4
	ELSE IF ((LDAY.LT.355).AND.(LDAY.GE.264)) THEN
	!fall
	J=3
	ELSE IF ((LDAY.LT.264).AND.(LDAY.GE.172)) THEN
	!summer time
	J=2
	ELSE 
	!spring
	J=1
	END IF
	!above: determine the season in order to select the correct deposition rate
	
	
!	NO3ZDEP(K,J)=1.3
!	WATNHDEP(K,J)=0.9
!	SOLUBPDEP(K,J)=0.05
!	TSSDEP(K,J)=0.5


	AINO3(M)=AINO3(M)+NO3ZDEP(K,J)/1000.*RATE
	AINH4(M)=AINH4(M)+WATNHDEP(K,J)/1000.*RATE
	SPI(M)=SPI(M)+SOLUBPDEP(K,J)/1000.*RATE
	SI(M,1)=SI(M,1)+TSSDEP(K,J)/1000.*RATE
	!assume all deposited sediment is in the clay particle size class
	!rate is in terms of volume of water (m³)/sec on a single cell
	!dep values are in mg/L
	!1000 converts L to m³ and mg to kg

	RETURN
	END


!	subroutine to simulate irrigation of crops

      SUBROUTINE IRRIGATE(LDAY,RAITES,YERBEG,IDATE,IRRIGAT,ICR,T,
	1TMAX,JJ,ITR,CU,N,CU1,DT)
!	This subroutine was completed 8/13/2001 by Rebecca Zeckoski, to whom all questions should
!	be addressed (rzeckoski@yahoo.com).  This subroutine will simulate irrigation on the watershed
!	It requires an irrigation.inp file to be included with the input files.  Three types of
!	irrigation frequencies can be simulated: (1) irrigate every set number of days, rain or shine
!	(2) irrigate every set number of days from the last rainfall or irrigation, never irrigate
!	on a rainfall day; (3) irrigate when the water level in the soil reaches a certain deficit
!	level, and irrigate until a target soil moisture is reached.  Irrigation is connected to the
!	crop types on the watershed.

!	NOTE: because of the positioning of the '...raining', '...fertilizing', and thus the
!	'...irrigating' prints on the screen during program execution, the '...irrigating' message
!	may come up when you are not actually irrigating.  This would only occur if you have specified
!	irrigation of a crop when the crop is not actually in rotation, because it is not possible
!	to check at that position in the program to see what crop types are currently in use.  
!	However, irrigation water will ONLY be applied to crops actually in rotation, so the 
!	calculations will be correct even if the message is not.

      IMPLICIT DOUBLE PRECISION A-H,O-Z      
      
      COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
	COMMON /CRGAGE/ RC(40,200),TC(40,200),R(40,21),FRA(40),JTR(40),
	1RATE(40),SR(40),NF(40),RATE2(40)

C
C **** MAXIMUM NUMBER OF SOIL TYPES IS 30.
C
      COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     & ,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &  CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &  THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &  CRC(30),KE(30,30),ZC(30),BD(30)
      DOUBLE PRECISION LF

      COMMON /ASMF/ ASMBF(30) ,FCAP1(30),TP1(30),RESWAT(30),DF1(30)

      INTEGER SUR,SOIL,RANE,RAITES,YERBEG

	COMMON /IRRIG/ IRRFLAG,IRRCROP,DEFLIMIT(20),STARTDAY(20),
	1ENDDAY(20),FREQ(20),IRREFF(20),IRRATE(20),DURATION(20),
     1IRRTARGET(30),LIMIT(20),IIRRI,IRRCYCLE(20),LASTIRR(20),SKIPFLAG,
     1CROPNOIRR(20),IRRFLAG2(20)
	INTEGER SKIPFLAG,STARTDAY,ENDDAY,FREQ,LIMIT,CROPNOIRR,CROPTEST

	COMMON /MOISTURE/ XMOI(35000)

	COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)

	DOUBLE PRECISION IRREFF,IRRATE,DURATION,IRRTARGET,IRRTAR
	DIMENSION VARIABLE(20),SOILIMIT(30),IRRTAR(20)

	
	GO TO (499,5587) IRRIGAT
!	direct program execution depending on what portion of the main program you are coming from
!	(irrigat is set before exiting the main program).  The first section (499) is for the 
!	beginning of each day, to determine whether or not there should be irrigation; the second
!	section (5587) is to determine if the end of the irrigation for the day has been reached

  499	IF ((IDATE.EQ.1).AND.(IIRRI.EQ.1)) THEN 
!	if it the first day and irrigation app flag = 1, then

	DO I=1,ICR
	STARTDAY(I)=0
	ENDDAY(I)=0
	FREQ(I)=0
	IRREFF(I)=0
	IRRATE(I)=0
	VARIABLE(I)=0
	LIMIT(I)=0
	LASTIRR(I)=0
	END DO
!	initialize variables

	READ (378,*) 
	READ (378,*)
!	read from irrigation.inp file (headers)
	READ (378,100) NEWCROP,STARTDAY(NEWCROP)
!	read the first crop listed and the beginning day of the irrigation cycle for that crop

	BACKSPACE 378
!	this is a function in fortran that moves to the previous line; in this case, it moves 
!	such that the next read for this file will read the newcrop and startday just read again.

 5583 ENDIF

 5584 IF (LDAY.EQ.STARTDAY(NEWCROP)) THEN 
!	if the current day is the startday from the file
	 READ (378,100) NEWCROP,STARTDAY(NEWCROP),ENDDAY(NEWCROP),
	1 FREQ(NEWCROP),IRREFF(NEWCROP),IRRATE(NEWCROP),VARIABLE(NEWCROP), 
	1 LIMIT(NEWCROP)
!	STARTDAY= beginning day of the irrigation season, ENDDAY= last day of the irrigation season,
!	NEWCROP= crop type irrigated, FREQ= frequency type: 1=every certain number of days, 
!	 2= a certain number of days after the last rainfall, 3= when the soil moisture is at a 
!	certain deficit, IRREFF= efficiency of irrigation application, IRRATE= rate of irrigation, 
!	mm/h, VARIABLE= duration of irrigation,min (freq=1 or 2) or moisture deficit target (freq=3),
!	LIMIT= number of days between irrigation (freq=1 or 2) or moisture deficit limit (freq=3)
!	target = when to stop irrigating (mm), limit = when to start irrigating (%) (freq=3)

	IRRCROP=NEWCROP
!	reassign newcrop to the variable 'irrcrop' - this way calculations can be done with the 
!	irrcrop and the next crop on the list can be read without feeding values to the program
!	prematurely

	IF ((FREQ(IRRCROP).EQ.1).OR.(FREQ(IRRCROP).EQ.2)) THEN
		!if the frequency type is 1 or 2 (see above and user's guide for description of frequency
		!types
		DURATION(IRRCROP) =VARIABLE(IRRCROP)
		!set the variable read equal to the duration of each irrigation
	ELSE IF (FREQ(IRRCROP).EQ.3) THEN
		!if the frequency type is 3
		IRRTAR(IRRCROP)=VARIABLE(IRRCROP)
		!irrtar = irrigation soil moisture target, percent of total porosity
		DEFLIMIT(IRRCROP)=FLOAT(LIMIT(IRRCROP))/100.
		!deficit limit = the soil moisture limit; once moisture falls below this value, irrigation
		!begins.  Set equal to the real value of limit/100 to put into decimal form
	ELSE
		WRITE(*,1236) FREQ(IRRCROP)
		
1236	FORMAT ('YOU HAVE SPECIFIED AN INVALID IRRIGATION FREQUENCY
	1(',I1,'); PLEASE REFER TO THE USERS MANUAL AND SPECIFY  
	1A VALID IRRIGATION FREQUENCY (IRRIGATION FREQUENCIES MUST BE 1, 2, 
	1OR 3)')
		!error message if you have specified an invalid frequency type
	STOP
	ENDIF

	IRRATE(IRRCROP)=IRRATE(IRRCROP)*IRREFF(IRRCROP)*CU
	!adjust the input irrigation rate (mm/hr) for efficiency of irrigation and convert to m³/h

	IRRCYCLE(IRRCROP)=1
!	this flag tells that the crop is currently in its irrigation cycle

	READ (378,100,END=5581) NEWCROP,STARTDAY(NEWCROP) 
!	read the next crop for use later



	GO TO 5582
!	skip the rewind statement

5581	REWIND 378
!	you are sent to 5581 if you reach the end of file; REWIND moves the read position to the start
!	of the file
	READ (378,*) 
	READ (378,*)
!	read header from irrigation.inp file
	READ (378,100) NEWCROP,STARTDAY(NEWCROP)
!	read the next crop

5582	BACKSPACE 378
!	go up a line, ready to read new crop again when the if then below (or at 5584 later during 
!	the simulation) is satisfied
!	WRITE(*,*) NEWCROP, STARTDAY(NEWCROP)
	IF(LDAY.EQ.STARTDAY(NEWCROP)) THEN
!	if the new crop's start day is also today, go back up and reinitialize stuff for that crop
	    GOTO 5584
      END IF
	END IF

5585	CONTINUE

5586	IF(MOD((YERBEG-1),4).EQ.0) THEN
		YEARENDDAY=366
	ELSE
		YEARENDDAY=365
	END IF
!	calculate the year end day, checking for leap year condition

	DO I=1,ICR
!	do for i=1 to number of crops
		IF(IRRCYCLE(I).EQ.1) THEN !if the crop is in its irrigation cycle
		IF((LDAY.LE.ENDDAY(I)).OR.(((ENDDAY(I)-STARTDAY(I)).LT.0).AND.
	1		(LDAY.GE.STARTDAY(I)))) THEN
!		if today is before the end day OR this cycle laps the year and today
!		is greater than the start day
			IF (FREQ(I).EQ.1) THEN !if the frequency type is once/LIMIT days
				IRRDIFF=LDAY-STARTDAY(I)
				!calculate the difference between today and the last irrigation
				IF (IRRDIFF.LT.0) THEN !check to see if it laps the year
					IRRDIFF=LDAY+YEARENDDAY-STARTDAY(I)
				END IF
				IF ((LDAY.EQ.STARTDAY(I)).OR.
	1					(MOD(IRRDIFF,LIMIT(I)).EQ.0)) THEN
					!if this is the first day of irrigation or it has been a multiple of
						!LIMIT days since the start day
					IRRFLAG=1
					!irrflag tells the program that at least one crop is being irrigated 
					IRRFLAG2(I)=1
					!irrflag2 tells which crop is being irrigated
					CROPNOIRR(I)=0
					!crop no irr is a variable to tell if the crop should no longer be 
					!irrigated today; a value of 0 means it should be irrigated
				ELSE
					IRRFLAG2(I)=0
					!if the condition is not met, no irrigation for the crop today
				END IF
			ELSE IF (FREQ(I).EQ.2) THEN !if the frequency type is LIMIT days 
										!since last rainfall
				IRRDIFF=LDAY-LASTIRR(I) 
					!days since last irrigation or rainfall
				IF (IRRDIFF.LT.0) THEN !check to see if it laps the year
					IRRDIFF=LDAY+YEARENDDAY-LASTIRR(I)
				END IF
				IF ((IRRDIFF.EQ.LIMIT(I)).AND.(RAITES.NE.1)) THEN
					!if it has been LIMIT days since last rainfall or irrigation
						!and there is no rain today
					IRRFLAG=1
					IRRFLAG2(I)=1
					LASTIRR(I)=LDAY !reset last irrigation day to today
					CROPNOIRR(I)=0
				ELSE
					IRRFLAG2(I)=0
				END IF
			ELSE !FREQ=3, limit type is soil moisture deficit
				IRRTEST=0
				!test to see if one of the cells in the crop type is irrigated; initialize
				!to 0 here
				DO M=1,N
				!do for m = 1 to number of overland flow cells
				IF (MOD(SUR(M),256).EQ.I) THEN
					!if the cell is in the I crop type (outer loop)
					K=SOIL(M)/256
					!find the soil type
					IRRTARGET(I)=IRRTAR(I) 
					!reset irrigation target, where the irrigation stops
					TESTVARIABLE=(1.-PIV(M)*DT/TP1(K))
					!testvariable is just to simplify the writing of the next if then statement
			!		IF (M.EQ.1) WRITE (377,*) TESTVARIABLE, LDAY
					IF (TESTVARIABLE.LT.DEFLIMIT(I)) THEN  
					!if soil moisture deficit (represented by testvariable; piv is air-filled
					!pore space, testvariable converts it to a decimal percent) is less than
					!the deficit limit set by the user
						IRRFLAG=1
						IRRFLAG2(I)=1
						CROPNOIRR(I)=0
						IRRTEST=1
						!after exiting the loop, if one of the cells meets this if then condition
						!the irrtest flag will be 1; if none meet it, it will be 0 still
						DURATION(I)=1440.
						!set the default duration to be the number of minutes in a day.  This
						!is adjusted in the main program later as necessary
					END IF
				END IF
				END DO	
				IF (IRRTEST.EQ.0) THEN
					IRRFLAG2(I)=0
					!if one of the cells in the prior loop tripped the irrtest, then irrtest is
					!1; therefore, if it is still zero, this crop is not irrigated today
				END IF
			END IF
		ELSE !if the current day is past the last day in the cycle
			IRRCYCLE(I)=0
			IRRATE(I)=0
			!reset irrcycle and irrate so crops are not wrongly irrigated
		END IF
		END IF
	END DO

  500 CONTINUE
      RETURN
!	this is the end of the first part of the subroutine
	


!		BEGIN SECOND PART OF THE SUBROUTINE
 5587 CONTINUE
	
!	This part of the subroutine is called for every hydrograph print line (due to its 
!	placement in the main program) - it adds water to the rainfall rate as necessary

	SKIPFLAG=0
!	skipflag is a value returned to the main program that tells the program to skip a certain
!	section of code (based on the value of skip flag); see below for more detail.

	 
	IF (IRRFLAG.EQ.1) THEN
		!if at least one crop is being irrigated today
		DO J=1,ICR
		!do for j=1 to the number of crops
			IF (IRRCYCLE(J).EQ.1) THEN
			!if the crop (j) is in its irrigation cycle then
				IF (T.GT.DURATION(J)) THEN
				!if the hydrograph print time (T(L) in main program) is greater than the set
				!duration of irrigation for this crop
					CROPNOIRR(J)=1
					!do not irrigate any more today
				END IF
			END IF
		END DO
	END IF

	IF ((IRRFLAG.EQ.1).AND.(RAITES.NE.1)) THEN
	!if we have irrigation today but not rainfall then
		CROPTEST=0
		RATE(JJ)=0.
		RC(JJ,ITR)=0.
	!set rainfall rates to zero
		SKIPFLAG=1
	!this indicates that the hydrograph calculations in the main code need to be skipped
	!(skips to line 60 in the main code)
		DO J=1,ICR
			IF (CROPNOIRR(J).EQ.0) THEN
				CROPTEST=1
			END IF
		END DO
		IF (CROPTEST.EQ.0) THEN
			SKIPFLAG=2
		END IF
	!	above loop and if then: test to see if any crops are still being irrigated; if not,
	!	then skip past all the rainfall stuff and finish out the day's calculations
	END IF
!RZ	if we are simulating irrigation and not precipitation we don't need to do the lines
!RZ	skipped by the skipflag (see main program)
	IF (T.GE.TMAX) THEN
		IF (IRRFLAG.EQ.1) THEN
			DO J=1,ICR
				IF (IRRCYCLE(J).EQ.1) THEN
					IF (T.LT.DURATION(J)) THEN
						RATE(JJ)=0.
						SKIPFLAG=1
						RC(JJ,ITR)=0.
					END IF
				END IF
			END DO
			IF (SKIPFLAG.NE.1) THEN
				SKIPFLAG=2
			END IF
		END IF
	END IF

!RZ	if the current time is after the maximum rainfall but before
!RZ	the end of the irrigation, then go ahead and continue simulating 'rainfall'

100	FORMAT (2X,I2,3X,I3,2X,I3,2X,I1,3X,F4.2,1X,F4.1,2X,F6.2,3X,I3)  
	RETURN
      END



!RZ	The following subroutine allows consideration of urban BMPs in the watershed.
!	It was finished by Rebecca Zeckoski in May 2002.  All questions/comments
!	should be directed to her at rzeckoski@yahoo.com.  Please see the user's manual
!	and Rebecca's thesis for a complete description of the processes in this subroutine.

!	The subroutine considers ponds (dry or wet) (types 1 and 2) and infiltration trenches
!	(type 3) in watersheds.  The basic concept is that water enters the BMPs until it 
!	reaches an overflow point - whether a pipe or an embankment - at which point it will
!	flow as it would without the presence of a BMP.  This subroutine assumes that the slope
!	of land in the cell is such that all water will be directed to the location of the
!	BMP in the cell.  Simulation is continued until infiltration of water is complete or 
!	the next rainfall event occurs, whichever happens first.  Infiltration is the primary
!	means of exit from the BMPs.  Free water evaporation is considered for the ponds.  
	SUBROUTINE BMPS(BMPLOC,N,L,T,CU,CU1,CU2,DT,NEXP,FILTS,IDATE,SIMDUR
	1,LDAY,KPR,NDT,P,D,RAINFALL,HASOPENED,CALLBMP,RAITES)
	IMPLICIT DOUBLE PRECISION A-H,O-Z
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)
 
      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)
 
 
      COMMON/NITRO2/ O0SOIL(35000),ONPT(35000,8),ONI(35050,8),
     & ONSEL(35000),ON2(8),ONCELL(35000,8),ONE(8),ON0(35000,8)
 
      COMMON /SOLUB/ SP2(35000),PEXT(35000),PK(30)
     & ,RBETA(30),SPI(35050),CGEN1(35000)
     & ,T13(35000),SPSP(35000)
 
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)

	COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)

	COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)

	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)

	COMMON /ASMF/ ASMBF(30),FCAP1(30),TP1(30),RESWAT(30),DF1(30)

	COMMON /ASMP/ASMPER(35000)

	COMMON /CSOIL/ A(30),FC(30),GWC(30)

	COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
	INTEGER SUR,TIAL(35000),RANE,SOIL  

	COMMON /CROUGH/ ROUGH(20),HU(20),DIR(21),PIT(40,20),PER(20)

	COMMON /ZSEDI/ NPART,NWASH,NWASH1

	COMMON /CUMIN/ CUMIN1(35000),rbit0(35000),testi(35000),timpon
	1(35000),tpon(35000)

	COMMON /ZSEDR/ VISCOS,AGRAV,SWH2O,YALCON,SE(8),VS(35000),DIA(8),
     1SG(8),FV(8),CY1(8),CY2(8),CY4(8),DIAMM(8),EQSDIA(8),EDMM(8),
     2F(30,8),CE1,CE2,CE3,CE4,CE5,CE6C

	COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     &,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &CRC(30),KE(30,30),ZC(30),BD(30)
	DOUBLE PRECISION KS,LF,KE,SUBLF(30)

	COMMON /FWATER/ AFWEV,DFWEV

	COMMON/OUT/SUMSED(35000),SUMNO3(35000),SUMNHW(35000),SUMNHS(35000)
     & ,SUMTKN(35000),SUMPO4(35000),NO3SEL(35000),NHWSEL(35000),
     &NHSSEL(35000),TKNSEL(35000),PO4SEL(35000)
       DOUBLE PRECISION NO3SEL,NHWSEL,NHSSEL

	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB

	COMMON /BMP/ HEIGHTSED(300,8,1500),
     1SEDINPOND(300,8,1500),PHOSINPOND(300,8,1500),
     2ANITINPOND(300,8,1500),ONITINPOND(300,8,1500),
	3ORIFICEH(300),ORIFICED(300),ORIFICEN(300),
     4OUTSLOPE(300)
	
	COMMON /BMP2/ PONDAREA(300),NRO(300),H2ODEPTH(300),
	6ORAREA(300),WEIRVOL(300),ORVOL(300),ORTOP(300),
	7MAXFLOW(300),SOLP(300),SOLNH4(300),SOLNO3(300),
	8LOST(300),WLOST(300),ORBOT(300),TIPE(300),
	9PIPEN(300),PIPED(300),PIPEL(300),RISD(300),PIPEAREA(300),
	1RISH(300)
	INTEGER TIPE

	COMMON /BMP3/ POND(35000),STREAM(300),SUB(300)
	INTEGER POND,SUB

	COMMON /BMP4/ ENDNO3SI,MYSHADOW(35000),MAXPOND
	INTEGER MAXPOND


	DOUBLE PRECISION LENGTH,MAXFLOW,LOST,PONDWIDTH,WEIRH
	DOUBLE PRECISION INFILPOT,NEWSED,LOSTWATER,NH4CONC,NO3CONC
	DOUBLE PRECISION D,DP,RE,WRATIO,LRATIO
	DOUBLE PRECISION FLOW1,FLOW2,FLOW3,FLOW4,FLOW5,LWEIR
	DOUBLE PRECISION LOSSES, STREAMFLOW
	DOUBLE PRECISION OUTNH42,INFNH4,OUTNO32,INFNO3,SP22,INFSP
	INTEGER CELL,OUTLET,HASOPENED,SIMDUR
	INTEGER BMPLOC,P,U,UOLD,DIFFERENCE,OLDLDAY

	DIMENSION T(101),WETINF(300),WETEVAP(300)
	COMMON /BMPPRINT/ TOTALIN(300),TOTALLOST(300),
	1TOTALWLOST(300),TOTALINF(300),TOTALEVAP(300),TOTALSED(300),
	2TOTALPHOS(300),TOTALANIT(300),TOTALONIT(300),TOTALDEPSED(300),
	3TOTALOUTSED(300),TOTALOUTPHOS(300),TOTALOUTANI(300),
	4TOTALOUTONI(300),TOTALDEPPHOS(300),TOTALDEPANI(300),
	5TOTALDEPONI(300),UOLD
     
      COMMON /BMPPRINT2/ TOTALSOLP(300),TOTALSOLNH4(300),
	6TOTALSOLNO3(300),TOTALLOSTSOLP(300),TOTALLOSTSOLNH4(300),
	7TOTALLOSTSOLNO3(300),TOTALINFP(300),TOTALINFNH4(300),
	8TOTALINFNO3(300)

	DIMENSION CALLBMP(35000)
	INTEGER CALLBMP,RAITES

	DOUBLE PRECISION ICU(300), ICU1(300), ICU2(300), CU3,Q3(35000),
	1Q4(35000), RAINFALL

	LOGICAL ARESULT


	GO TO (10,20) BMPLOC
!	This determines which part of the subroutine to execute.  The first part is called
!	from subroutine STRUCT, and performs the initial read of the file and the preliminary
!	calculations for every pond/trench found there.  The second part is called from the main
!	program in the general vicinity of SUBROUTINE SED, and recalculates the flow routing 
!	based on the presence of the BMP.  The second part is also called from the flow calculation
!	part of the main program (determination of Q) in the case where there is water in 
!	the pond but there is no rainfall, or overland flow has ceased.

!	The first part of the subroutine
10	I=1	
!	initialize the bmp counter to zero.

	IF (HASOPENED.EQ.0) THEN
		HASOPENED=1
	!make sure this hasn't been done.  Once you go through this loop, you won't do it again
	!during program execution
		OPEN(UNIT=380, FILE='BMP.INP',STATUS='UNKNOWN')
		READ(380,*)
		READ(380,*)
	!read the first two lines of the input file (headers)
	DO 
	!this loop executes until the end of file is reached
!		READ(380,381,END=81) CELL,TIPE(I),LENGTH,
!    1         PONDWIDTH,ORIFICEH(I),ORIFICED(I),OUTLET
!    1		,WEIRH,ORIFICEN(I),OUTSLOPE(I),AFWEV
		READ(380,381,END=81) CELL, TIPE(I),OUTLET,SUB(I),LENGTH,
	1		PONDWIDTH,PIPEN(I),PIPED(I),PIPEL(I),ORIFICEH(I),
	1		ORIFICED(I),RISE,RISD(I),WEIRH,AFWEV
	!read CELL (cell with the BMP on it), TIPE (type of BMP: 1=dry pond, 2=wet pond, 
	!3=infiltration trench), OUTLET (outlet cell for water running through
	!the orifice), LENGTH (length of pond/trench, meters), PONDWIDTH (width
	!of pond/trench, meters), PIPEN (manning's roughness coefficient for the outlet pipe),
	!PIPED (outlet pipe diameter), PIPEL (length of outlet pipe), ORIFICEH (height of the 
	!center point of the orifice,meters), ORIFICED (diameter of the orifice, meters),  
	!RISH (height of riser opening), RISD (diameter of riser opening), WEIRH (height of the 
	!overflow structure, meters), AFWEV (annual free water evaporation).  
	!When the end of file is reached, skip down to 81
		OPEN(UNIT=1793,FILE='BMPOUT.OUT',STATUS='UNKNOWN')
	!open the output file
		WRITE(1793,381)  CELL, TIPE(I),OUTLET,SUB(I),LENGTH,
	1		PONDWIDTH,PIPEN(I),PIPED(I),PIPEL(I),ORIFICEH(I),
	1		ORIFICED(I),RISE,RISD(I),WEIRH,AFWEV
	!rewrite the input to the output file - as a check

		CALLBMP(CELL)=1
		IF (SUB(I).EQ.1) THEN
		 NR(CELL)=OUTLET
		 NC(CELL)=OUTLET
		 RFL(CELL)=0.
	     POND(CELL)=I
		 MAXPOND=I
		 I=I+1
		GO TO 11
		END IF
		PONDAREA(I)=LENGTH*PONDWIDTH
	!calculate pond surface area - this assumes this is a relatively rectangular pond.  If 
	!the pond is not rectangular, length and width should be selected as to give a good 
	!estimate of the pond area (the shape of the pond does not particularly matter to this 
	!subroutine, it just needs to know the area) - m²
		NRO(I)=OUTLET
	!reassign the outlet cell
		ORAREA(I)=ORIFICED(I)**2*3.14159/4.
	!calculate the orifice opening area - this assumes a circular orifice
		WEIRVOL(I)=WEIRH*PONDAREA(I)
	!calculate the volume of the pond at the maximum height (i.e., the overflow height), m³
		ORVOL(I)=PONDAREA(I)*ORIFICEH(I)
	!calculate the volume of the pond at the midpoint of the orifice opening, m³
		ORTOP(I)=PONDAREA(I)*(ORIFICEH(I)+0.5*ORIFICED(I))
	!calculate the volume of the pond at the top of the orifice opening, m³
		ORBOT(I)=PONDAREA(I)*(ORIFICEH(I)-0.5*ORIFICED(I))
	!calculate the volume of the pond at the bottom of the orifice opening, m³
		RISH(I)=PONDAREA(I)*RISE
		PIPEAREA(I)=3.14159*(PIPED(I)/2)**2
	
		IF (TIPE(I).EQ.2) THEN
			WEIRVOL(I)=(WEIRH-RISE)*LENGTH*PONDWIDTH
			RISH(I)=0.
			ICU(I)=(PONDAREA(I))**2/3600000.
			ICU1(I)=(PONDAREA(I))**2/1000.
			ICU2(I)=DT/((PONDAREA(I))**2)/500.
		END IF

	WRITE(1793,390) ORBOT(I),ORTOP(I),RISH(I),WEIRVOL(I)
  390 FORMAT (1X,'ORBOT=',F9.3,1X,'ORTOP=',F9.3,1X,'RISH=',F9.3,1X,
     1'WEIRVOL=',F9.3)

		IF (TIPE(I).EQ.3) THEN
		WEIRVOL(I)=WEIRVOL(I)*PIPEN(I)
	!type 3 - infiltration trench - porosity of gravel is entered in pipe n place,
	!weirvol is decreased appropriately
		ICU(I)=(PONDAREA(I))**2/3600000.
		ICU1(I)=(PONDAREA(I))**2/1000.
		ICU2(I)=DT/((PONDAREA(I))**2)/500.
	!conversion factors for infiltration trench.  These are like CU,CU1,and CU2 in the main
	!program, but the surface area is modified to represent the  surface area of the 
	!bottom of the trench; if future users find a better way to describe infiltration in
	!the trench, they will note that I have this in its own if-then, the better to easily
	!modify the infiltration trench calculations in the future.
		END IF
		POND(CELL)=I	
	!POND holds the I value for the cell.  Notice that all the calculations in this loop are
	!done for the I value - which could also be considered the pond number.  This was done 
	!because the compiled executable was too large to run with the 3-D arrays (see later) 
	!dimensioned with 35000 as one of the dimensions.  POND has been set up to accomodate
	!300 BMPs in the watershed; if there are more than this, all the 300 dimensioned arrays 
	!in the initialization section need to be redimensioned.  There is a distinct possibility
	!the program will not compile correctly if this is done.  So, anyway, if you give a cell
	!number as an argument to POND, it will spit out the pond number.	
	WETEVAP(I)=0.0
	WETINF(I)=0.0
		MAXPOND=I
		I=I+1
	!increment the pond number counter

11	END DO

	END IF

	LDAYOLD=0
	OLDLDAY=0
	DIFFERENCE=0
	!initialize this variable to zero; see later for description

81	CLOSE(380)
	RETURN

!	Here begins the second part of the subroutine.

20	M=POND(N)
	!recall the pond number (M) from the cell number (N)
	!FINDMEHERE
	OLDHEIGHT=H2ODEPTH(M)
	NEWHEIGHT=H2ODEPTH(M)
	IF (QI(N).GT.0.) THEN
	H2ODEPTH(M)=H2ODEPTH(M)+QI(N)*DT+RAINFALL*DT
	!depth of water in pond = same + water outflow from element * DT (to get from m³/s to m³)
	NEWHEIGHT=H2ODEPTH(M)
!	ELSE
!	H2ODEPTH(M)=H2ODEPTH(M)+RAINFALL*DT
	END IF

	IF (TIPE(M).EQ.3) GO TO 21
	!if the BMP type is 3, this is an infiltration trench, and much less complicated calculations
	!will be performed at 21.  If this BMP is a pond, continue on.

	MAXFLOW(M)=0.

	IF (H2ODEPTH(M).GT.ORBOT(M)) THEN
		FLOW1=0.6*PIPEAREA(M)*DSQRT(2*9.806*(H2ODEPTH(M)/PONDAREA(M)))
		!above case is for the orifice of the pipe limiting the flow
		!equation 9.9, Schwab et al., "Soil and Water Conservation Engineering", 4th edition
		RADIUS=ORIFICED(M)/2.
		X=RADIUS-((H2ODEPTH(M)-ORBOT(M))/PONDAREA(M))
		IF (X.LT.(0.-RADIUS)) THEN
			FLOW2=FLOW1
			!flow is also greater than ortop; weir flow not limiting, so just set equal to 
			!the flow already calculated
		ELSE
			IF (X.LT.0.) THEN
			!would occur if the flow is higher than the midpoint of the orifice
				X=-X
			!make x positive
				ANGLE=ACOS(X/RADIUS)
			!see user's manual for a picture
				SECTORA=2*3.14159-(2*ANGLE)
			!the angle for the sector
			ELSE
			!flow is above the bottom of the orifice, but below the midpoint
				ANGLE=ACOS(X/RADIUS)
			!see user's manual for a picture
				SECTORA=2*ANGLE
			!the angle for the sector
			END IF	
			LWEIR=SECTORA/(2*3.14159)*(ORIFICED(M)*3.14159)
			!length of the weir crest (wetted perimeter of orifice)
			FLOW2=0.0283*(3.1*(LWEIR*3.281)*
	1			(((H2ODEPTH(M)-ORBOT(M))/PONDAREA(M))*3.281)**1.5)
			!above case is for weir flow over the orifice limiting the flow
			!equation 5-8, Va DCR, "Virginia Stormwater Management Handbook", 1st edition 1999
			!converted to metric units
		END IF	
		FLOW3=PIPEAREA(M)*DSQRT(2*9.806*(H2ODEPTH(M)/PONDAREA(M)))/
	1		DSQRT(1+0.5+0.5+(1244522*PIPEN(M)**2/
     2		((PIPED(M)*1000)**(4./3.)))*PIPELENGTH)
		!above case is for full pipe flow limiting the flow
		!equation 9.8, Schwab et al., "Soil and Water Conservation Engineering", 4th edition
		MAXFLOW(M)=MIN(FLOW1,FLOW2,FLOW3)
		!the maximum flow for this case is the minimum of the flows calculated
	END IF
	IF (H2ODEPTH(M).GT.ORTOP(M)) THEN
		FLOW4=0.6*ORAREA(M)*DSQRT(2*9.806*(H2ODEPTH(M)-ORVOL(M))/
	1		PONDAREA(M))
		!above case is for orifice limiting flow (opening on side of riser, see user's manual)
		!equation 9.9, Schwab et al., "Soil and Water Conservation Engineering", 4th edition
		MAXFLOW(M)=MIN(FLOW1,FLOW3,FLOW4)
		!the maximum flow for this case is the minimum of pipe orifice, full pipe, and orifice flow
	END IF
	IF (H2ODEPTH(M).GT.RISH(M)) THEN
		IF (TIPE(M).EQ.1) THEN
		FLOW5=0.0283*(3.1*(3.14159*RISD(M)*3.281)*
	1		(((H2ODEPTH(M)-RISH(M))/PONDAREA(M))*3.281)**(1.5))
		!above case is for the riser orifice limiting flow (weir flow over riser)
		!equation 5-8, Va DCR, "Virginia Stormwater Management Handbook", 1st edition 1999
		!converted to metric units (the 0.0283 converts cfs to m³/s and 3.281 converts m to ft)
		!(yes, that's m to ft, you have to calculate the thing in English and convert to metric
		!because I couldn't find a metric form, I'm sure I didn't look hard enough)
		MAXFLOW(M)=MIN(FLOW1,FLOW3,(FLOW4+FLOW5))
		!the maximum flow for this case is the minimum of pipe orifice, full pipe, and combination 
		!of orifice and riser orifice flow (these last two can happen simultaneously as they 
		!come through different openings).
		END IF
		IF (TIPE(M).EQ.2) THEN
			FLOW3=PIPEAREA(M)*DSQRT(2*9.806*(H2ODEPTH(M)/PONDAREA(M)))
	1			/DSQRT(1+0.5+0.5+(1244522*PIPEN(M)**2/
     2			((PIPED(M)*1000)**(4./3.)))*PIPELENGTH)
			FLOW5=0.0283*(3.1*(3.14159*RISD(M)*3.281)*(((H2ODEPTH(M))/
	1			PONDAREA(M))*3.281)**(1.5))
			MAXFLOW(M)=MIN(FLOW3,FLOW5)
		!above two equations are for a wet pond, which would not have an orifice on the side for 
		!flows1,2,3,4 to be calculated (1,2,4 would be zero because a zero orifice diameter should
		!be specified in this case).  Therefore you need to determine the minimum of the flows that
		!the wet pond can experience - i.e.,the pipe flow and the riser flow.
		END IF
	END IF
	FLOW1=0.
	FLOW2=0.
	FLOW3=0.
	FLOW4=0.
	FLOW5=0.
	!reset flows to zero so they will not be accidentally carried to next bmp calculation

	TOTALSOLP(M)=TOTALSOLP(M)+SPI(N)*DT
	TOTALSOLNH4(M)=TOTALSOLNH4(M)+AINH4(N)*DT
	TOTALSOLNO3(M)=TOTALSOLNO3(M)+AINO3(N)*DT

	!calculate the total inflow of nutrients to the pond for the entire simulation

	LOST(M)=0.0
	WLOST(M)=0.0
	!initialize water lost to zero for every day, will be recalculated below

	IF (H2ODEPTH(M).GT.RISH(M)) THEN
		H2ODEPTH(M)=H2ODEPTH(M)-MAXFLOW(M)*DT
		!calculate the new water level after the maximum flow goes through the pipe
		LOST(M)=MAXFLOW(M)*DT
		!water lost through the pipe at this time step
	!	QI(NRO(M))=QI(NRO(M))+MAXFLOW(M)
		!outflow to the receiving element for the pipe is increased by maxflow
		D1=MAXFLOW(M)-Q(N)
		Q(N)=MAXFLOW(M)
		IF (H2ODEPTH(M).GT.WEIRVOL(M)) THEN
		!if the water level is above the embankment height
			WLOST(M)=H2ODEPTH(M)-WEIRVOL(M)
		!WeirLOST - water lost over the embankment 
			H2ODEPTH(M)=H2ODEPTH(M)-WLOST(M)
		!decrement the water volume in the element by the amount lost over the embankment
	!		QI(NC(N))=QI(NC(N))+((WLOST(M))/DT)*(1.-RFL(N))
	!		QI(NR(N))=QI(NR(N))+(WLOST(M)/DT)*RFL(N)
			D3=(WLOST(M)/DT)*(1.-RFL(N))-Q3(N)
			D4=(WLOST(M)/DT)*RFL(N)-Q4(N)
			Q3(N)=(WLOST(M)/DT)*(1.-RFL(N))
			Q4(N)=(WLOST(M)/DT)*RFL(N)
		!all water above the embankment height is lost and added to the receiving elements
		!these are the receiving elements normally calculated by the program based on slope
		ELSE
			D3=-Q3(N)
			D4=-Q4(N)
			Q3(N)=0.
			Q4(N)=0.
		END IF		
	ELSEIF (H2ODEPTH(M).GT.ORTOP(M)) THEN
	!if the water level is above the top of the orifice
		H2ODEPTH(M)=H2ODEPTH(M)-MAXFLOW(M)*DT
		!calculate the new water level after the maximum flow goes through the pipe
		LOST(M)=MAXFLOW(M)*DT
		!water lost through the pipe at this time step
	!	QI(NRO(M))=QI(NRO(M))+MAXFLOW(M)
		!outflow to the receiving element for the pipe is increased by maxflow
		D1=MAXFLOW(M)-Q(N)
		D3=-Q3(N)
		D4=-Q4(N)
		Q(N)=MAXFLOW(M)
		Q3(N)=0.
		Q4(N)=0.
!		IF (H2ODEPTH(M).GT.WEIRVOL(M)) THEN
		!if the water level is above the embankment height
!			QI(NC(N))=QI(NC(N))+((H2ODEPTH(M)-WEIRVOL(M))/DT)*
!	1			(1.-RFL(N))
!			QI(NR(N))=QI(NR(N))+((H2ODEPTH(M)-WEIRVOL(M))/DT)*RFL(N)
		!all water above the embankment height is lost and added to the receiving elements
		!these are the receiving elements normally calculated by the program based on slope
!			Q3(N)=(H2ODEPTH(M)-WEIRVOL(M))/DT*(1.-RFL(N))
!			Q4(N)=(H2ODEPTH(M)-WEIRVOL(M))/DT*RFL(N)
!			WLOST(M)=H2ODEPTH(M)-WEIRVOL(M)
		!WeirLOST - water lost over the embankment 
!			H2ODEPTH(M)=H2ODEPTH(M)-WLOST(M)
		!decrement the water volume in the element by the amount lost over the embankment
!		END IF
	ELSEIF (H2ODEPTH(M).GE.ORBOT(M)) THEN
	!if the water depth is greater than the orifice bottom but less than orifice top
		IF (((H2ODEPTH(M)-ORBOT(M))/DT).LT.MAXFLOW(M)) THEN
	!IF THERE IS NOT ENOUGH FLOW ABOVE THE ORIFICE BOTTOM TO SATISFY MAXFLOW, EVERYTHING OUT
	!		QI(NRO(M))=QI(NRO(M))+(H2ODEPTH(M)-ORBOT(M))/DT
			!flow into pipe receiving element = same + all water above the orifice bottom
			D1=(H2ODEPTH(M)-ORBOT(M))/DT-Q(N)
			Q(N)=(H2ODEPTH(M)-ORBOT(M))/DT
			LOST(M)=H2ODEPTH(M)-ORBOT(M)
			!water lost through pipe 
			H2ODEPTH(M)=ORBOT(M)
			!decrement the water volume to ORBOT (since everything above ORBOT left)
		ELSE !ENOUGH FLOW TO SATISFY MAXFLOW
	!		QI(NRO(M))=QI(NRO(M))+MAXFLOW(M)
			!flow into pipe receiving element = same + maxflow (calculated using Manning's eq.)
			D1=MAXFLOW(M)-Q(N)
			Q(N)=MAXFLOW(M)
			H2ODEPTH(M)=H2ODEPTH(M)-MAXFLOW(M)*DT
			!decrement water depth by amount lost
			LOST(M)=MAXFLOW(M)*DT
			!water lost through pipe
		END IF
		D3=-Q3(N)
		D4=-Q4(N)
		Q3(N)=0.
		Q4(N)=0.
	ELSE !H2ODEPTH .LT. ORIFICE BOTTOM
		H2ODEPTH(M)=H2ODEPTH(M)
		!no change in water depth (recall water inflow is added in above)
		LOST(M)=0.0
		WLOST(M)=0.0

		D1=-Q(N)
		D3=-Q3(N)
		D4=-Q4(N)
		Q(N)=0.
		Q3(N)=0.
		Q4(N)=0.
	!	GOTO 22
	!	QI(NRO(M))=QI(NRO(M))-Q(N)
	!	QI(NR(N))=QI(NR(N))-Q4(N)
	!	QI(NC(N))=QI(NC(N))-Q3(N)
	END IF

	QI(NRO(M))=QI(NRO(M))+D1
	QI(NC(N))=QI(NC(N))+D3
	QI(NR(N))=QI(NR(N))+D4

!		WRITE(9999,543) N,M,'NRO=',NRO(M),QI(NRO(M)),'NR=',NR(N), 
!	1	QI(NR(N)),'NC=',NC(N),QI(NC(N))
!543		FORMAT(1X,I3,I3,A4,I3,F9.5,A4,I3,F9.5,A4,I3,F9.5)
!		WRITE(9999,*) H2ODEPTH(M)

	IF (Q(N).LT.0.) Q(N)=0.
	IF (Q3(N).LT.0.) Q3(N)=0.
	IF (Q4(N).LT.0.) Q4(N)=0.


	IF (H2ODEPTH(M).LT.0.00000000001) THEN
		H2ODEPTH(M)=0.0
	END IF
	!to prevent errors in the 10^(-16) place

	IF (QI(N).GT.0) THEN
	TOTALIN(M)=QI(N)*DT+TOTALIN(M)
	END IF
	TOTALLOST(M)=TOTALLOST(M)+LOST(M)
	TOTALWLOST(M)=TOTALWLOST(M)+WLOST(M)
	!these variables keep track of the total water inflow, total water lost through pipe,
	!and total water lost over the embankment for the pond, to be printed at the end of the
	!simulation

	IF ((WLOST(M).GT.0.).OR.(LOST(M).GT.0.)) THEN
		WRATIO=WLOST(M)/(LOST(M)+WLOST(M))
		LRATIO=LOST(M)/(LOST(M)+WLOST(M))
	!calculate the ratio of water lost over weir to lost through pipe for use
	!later in partitioning lost sediment&nutrients
	ELSE
		DO K=1,NPART
		TOTALDEPSED(M)=TOTALDEPSED(M)+SI(N,K)*DT
		TOTALDEPPHOS(M)=TOTALDEPPHOS(M)+PI(N,K)*DT
		TOTALDEPANI(M)=TOTALDEPANI(M)+ANI(N,K)*DT
		TOTALDEPONI(M)=TOTALDEPONI(M)+ONI(N,K)*DT
		PI(N,K)=0.
		ANI(N,K)=0.
		ONI(N,K)=0.
		SI(N,K)=0.
		END DO
		GO TO 22
	!if there is no water lost, all sediment and nutrients are trapped in pond, so add
	!to total deposited sediment and nutrients and skip the next loop
	END IF

	DO K=1,NPART
	!do for each particle size class

		TOTALSED(M)=TOTALSED(M)+SI(N,K)*DT
		TOTALPHOS(M)=TOTALPHOS(M)+PI(N,K)*DT
		TOTALANIT(M)=TOTALANIT(M)+ANI(N,K)*DT
		TOTALONIT(M)=TOTALONIT(M)+ONI(N,K)*DT
		!this keeps track of total sediment, sediment bound nutrients, that enter the  
		!pond during the simulation=the outflow for the BMP cell * DT to get into kg

		IF ((QI(N).GT.0.)) THEN
		RE=FV(K)*PONDAREA(M)/((WLOST(M)+LOST(M))/DT) !QI(N) !D
		ELSE
		RE=1.
		END IF
	!removal efficiency = fall velocity of particle * area of pond/outflow rate (taken
	!from Wes Byne's sediment model and Novotny&Olem, 1994 "Water Quality" - the
	!"overflow rate" theory of settling-tank design)			

		IF (RE.GT.1.) RE=1.

		DP=RE*SI(N,K)*DT
	!deposited sediment(kg) = removal efficiency*sediment inflow(kg/s)*time increment(s)

		SEL(N)=SEL(N)+DP/DT

		NEWSED=DP/(SG(K)*1000.)
	!new sediment deposited in pond = deposited sediment/density*1000 for conversion
		TOTALDEPSED(M)=TOTALDEPSED(M)+DP
		TOTALDEPPHOS(M)=TOTALDEPPHOS(M)+RE*PI(N,K)*DT
		TOTALDEPANI(M)=TOTALDEPANI(M)+RE*ANI(N,K)*DT
		TOTALDEPONI(M)=TOTALDEPONI(M)+RE*ONI(N,K)*DT
	!track the total deposition for the pond

		WEIRVOL(M)=WEIRVOL(M)-NEWSED
		ORVOL(M)=ORVOL(M)-NEWSED
		ORBOT(M)=ORBOT(M)-NEWSED
		ORTOP(M)=ORTOP(M)-NEWSED
		RISH(M)=RISH(M)-NEWSED
	!change pond volumes to account for deposited sediment
		IF(ORBOT(M).LT.0.) THEN
			ORVOL(M)=0.
			ORBOT(M)=0.
			ORTOP(M)=0.
		END IF

		IF (WEIRVOL(M).LT.0.) WEIRVOL(M) = 0.

		IF (RISH(M).LT.0.) RISH(M)=0.

	!prevent volumes from falling below zero (this will cause problems
	!in the rest of the program)


		SI(NC(N),K)=SI(NC(N),K)+WRATIO*(1.-RFL(N))*(1.-RE)*SI(N,K)
		SI(NR(N),K)=SI(NR(N),K)+WRATIO*(RFL(N))*(1.-RE)*SI(N,K)
		PI(NC(N),K)=PI(NC(N),K)+WRATIO*(1.-RFL(N))*(1.-RE)*PI(N,K)
		PI(NR(N),K)=PI(NR(N),K)+WRATIO*(RFL(N))*(1.-RE)*PI(N,K)
		ANI(NC(N),K)=ANI(NC(N),K)+WRATIO*(1.-RFL(N))*(1.-RE)*ANI(N,K)
		ANI(NR(N),K)=ANI(NR(N),K)+WRATIO*(RFL(N))*(1.-RE)*ANI(N,K)
		ONI(NC(N),K)=ONI(NC(N),K)+WRATIO*(1.-RFL(N))*(1.-RE)*ONI(N,K)
		ONI(NR(N),K)=ONI(NR(N),K)+WRATIO*(RFL(N))*(1.-RE)*ONI(N,K)
	!calculate the inflow of sediment and sediment bound nutrients for receiving cells

		SI(NRO(M),K)=SI(NRO(M),K)+LRATIO*(1.-RE)*SI(N,K)
		PI(NRO(M),K)=PI(NRO(M),K)+LRATIO*(1.-RE)*PI(N,K)
		ANI(NRO(M),K)=ANI(NRO(M),K)+LRATIO*(1.-RE)*ANI(N,K)
		ONI(NRO(M),K)=ONI(NRO(M),K)+LRATIO*(1.-RE)*ONI(N,K)
	!calculate the outflow - to the pipe receiving element
	!use 1-re because re represents the amount deposited; 1-re is the amount flowing
	!through

		TOTALOUTSED(M)=TOTALOUTSED(M)+(1.-RE)*SI(N,K)*DT
		TOTALOUTPHOS(M)=TOTALOUTPHOS(M)+(1.-RE)*PI(N,K)*DT
		TOTALOUTANI(M)=TOTALOUTANI(M)+(1.-RE)*ANI(N,K)*DT
		TOTALOUTONI(M)=TOTALOUTONI(M)+(1.-RE)*ONI(N,K)*DT
	!add to total sediment/nutrient losses for the simulation

		PI(N,K)=0.
		ANI(N,K)=0.
		ONI(N,K)=0.
		SI(N,K)=0.

	END DO

22	IC=SOIL(N)/256
	IS=MOD(SUR(N),256)
	SUPP=H2ODEPTH(M)/DT
	IF (IS.EQ.0) IS=MOD(SUR(MYSHADOW(N)),256)
!	ASMPER(N)=0.98
!	SUBLF(IS)=1.01
!	PIV(N)=0.02
	!THIS IS THE AVAILABLE SUPPLY TO INFILTRATE, M³/S; THEORETICALLY, IF THE
	!SOIL COULD INFILTRATE THE ENTIRE VOLUME OF WATER, THEN IT IS AVAILABLE FOR 
	!INFILTRATION,OR EFFECTIVELY, H2ODEPTH CAN BE INFILTRATED IN ONE SECOND
	!MYSHADOW IS A CHANNEL ELEMENT'S SHADOW ELEMENT
!	INFILPOT=FILT(PIV(N),FCAP1(IS),GWC(IS),DR(N),S(N),SUPP,CU2,ROUGH
   !  1(IC),HU(IC),NEXP,ASMPER(N),KE(IS,IC),PSIF(IS),PHIC(IS),T(L),CU,
   !  2SUBLF(IS),KS(IS),IC,is,N,CUMIN1(N),rbit0(N),testi(N),timpon(N),
   !  3tpon(N),FILTS,DT,CU1,TP1(IS),A(IS))*DT
	!calculate potential infiltration

	IF (URB(N).NE.1) THEN
	INFILPOT=FILT2(PIV(N),FCAP1(IS),GWC(IS),DR(N),S(N),SUPP,ICU2(M),
     1ROUGH(IC),HU(IC),NEXP,ASMPER(N),KE(IS,IC),PSIF(IS),PHIC(IS),T(L),
     2ICU(M),LF(IS),KS(IS),IC,is,N,CUMIN1(N),rbit0(N),testi(N),timpon(N)
     3,tpon(N),FILTS,DT,ICU1(M),TP1(IS),A(IS),CU3)*DT
	ELSE
	INFILPOT =0.
	END IF

	CALL EVAPFW(LDAY)
	!determine potential free water evaporation for today

	IF(TIPE(M).EQ.2) THEN
		WETEVAP(M)=DFWEV
		WETINF(M)=INFILPOT/DT
	END IF

	IF(INFILPOT.GT.H2ODEPTH(M)) INFILPOT=H2ODEPTH(M)
	IF(INFILPOT.LT.0.) INFILPOT=0.
	!check to make sure nothing ends up negative

	TESTDEPTH=H2ODEPTH(M)-INFILPOT-DFWEV/86400*DT
	!DFWEV is in m³/day, so divide by 86400 to get m³/s, mult. by dt to get volume
	IF(TESTDEPTH.LT.0.) THEN
		DFWEV=86400/DT*(H2ODEPTH(M)-INFILPOT)
		IF(DFWEV.LT.0.0000001) DFWEV=0.
		H2ODEPTH(M)=0.
	ELSE	
		H2ODEPTH(M)=TESTDEPTH
	END IF
	!above testdepth and if then checks to see if the evaporative losses are greater than
	!the volume of water after infiltration.  No evaporation if this is the case.

	TOTALINF(M)=TOTALINF(M)+INFILPOT
	TOTALEVAP(M)=TOTALEVAP(M)+DFWEV/86400*DT
	!sum up total infiltration and evaporation for the simulation

	LOSTWATER=INFILPOT+WLOST(M)+LOST(M)
	!this is the sum of water losses (other than evaporative, which doesn't carry nutrients) 
	!for this time step.

!RZ	CLIP this is where I cut the stuff from my first version to the textpad version

	IF((LOSTWATER.LE.0.).AND.(RAITES.EQ.1)) THEN
	STONH4(N)=STONH4(N)+AINH4(N) !ALL WERE ZEROS, RAITES.EQ.1 WASN'T IN TEST
	STONO3(N)=STONO3(N)+AINO3(N)
	SPSP(N)=SPSP(N)+SPI(N)
	!If there is no water lost during this time increment, then all the inputs get added
	!to the storage on the element; note that this is slightly different from the main
	!program nutrient case BECAUSE in that case, if the flow=0., everything drops out
	!however, in this case it just means that the water level is below the outlet...
	!although theoretically there should still be infiltration, this check prevents
	!NaN from the next part of this if then.
	ELSEIF (LOSTWATER.LE.0) THEN
		CONTINUE
	ELSE
	!Okay, the stuff below is taken from Faycal Bouraoui's work on the nutrient
	!subroutines in this program.  Only I did it more straightforward and 
	!hopefully it won't take you a full day to figure it out like it did for me to 
	!understand what he did.
	OUTNH4(N)=(AINH4(N)+STONH4(N))*WLOST(M)
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	!outnh4 is the nh4 lost over the weir and thus routed to nc and nr.  ainh4 and 
	!stonh4 are the inflow and preexisting nh4 in the pond, then you multiply by 
	!the ratio of wlost/(pondvolume+lostwater) to apportion the nutrient loss due
	!to the loss over the weir in relation to the nutrient losses due to 
	!the other potential outflows.  The ratio is percentage
	!of the total water involved (whether it's still in the pond or was until
	!it flowed out during this time step) that flows over the weir.
	OUTNH42=(AINH4(N)+STONH4(N))*LOST(M)
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	!outnh42 is the nh4 lost through the pipe and thus routed to nro.  See previous
	!comment; this time lost is in the numerator of the ratio to get the percentage
	!of the total water involved that flows through the pipe.
	INFNH4=(AINH4(N)+STONH4(N))*INFILPOT
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	!infnh4 is the nh4 lost with the infiltrating water.  See two comments ago; this
	!time infilpot is in the numerator of the ratio to get the percentage of the 
	!total water involved that leaves via infiltration.

	AINH4(NR(N))=(RFL(N))*OUTNH4(N)+AINH4(NR(N))
	AINH4(NC(N))=(1.-RFL(N))*OUTNH4(N)+AINH4(NC(N))
	AINH4(NRO(M))=OUTNH42+AINH4(NRO(M))
	!the above 3 are pretty self-explanatory.  Apportion the losses mentioned before
	!to the respective receiving elements.
	STONH4(N)=STONH4(N)+AINH4(N)-OUTNH4(N)-OUTNH42-INFNH4
	!stonh4 is the new storage on the element = the storage that was on the element (of
	!the nutrient) + the nutrient that came in - the nutrient that left over the 
	!weir - the nutrient that left through the pipe - the nutrient that infiltrated
	NHWSEL(N)=NHWSEL(N)+OUTNH4(N)+OUTNH42
	!this sums up the total nh4 loss for this cell for the simulation that goes to a 
	!receiving cell (i.e., doesn't infiltrate).

	OUTNO3(N)=(AINO3(N)+STONO3(N))*WLOST(M)
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	OUTNO32=(AINO3(N)+STONO3(N))*LOST(M)
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	INFNO3=(AINO3(N)+STONO3(N))*INFILPOT
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	AINO3(NR(N))=(RFL(N))*OUTNO3(N)+AINO3(NR(N))
	AINO3(NC(N))=(1.-RFL(N))*OUTNO3(N)+AINO3(NC(N))
	AINO3(NRO(M))=OUTNO32+AINO3(NRO(M))
	STONO3(N)=STONO3(N)+AINO3(N)-OUTNO3(N)-OUTNO32-INFNO3
	NO3SEL(N)=NO3SEL(N)+OUTNO3(N)+OUTNO32
	!the above block is like the nh4 block, but replace the nh4s in the comments
	!with no3s

	SP2(N)=(SPI(N)+SPSP(N))*WLOST(M)
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	SP22=(SPI(N)+SPSP(N))*LOST(M)
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	INFSP=(SPI(N)+SPSP(N))*INFILPOT
	1	/(H2ODEPTH(M)+WLOST(M)+LOST(M)+INFILPOT)
	SPI(NR(N))=(RFL(N))*SP2(N)+SPI(NR(N))
	SPI(NC(N))=(1.-RFL(N))*SP2(N)+SPI(NC(N))
	SPI(NRO(M))=SP22+SPI(NRO(M))
	SPSP(N)=SPSP(N)+SPI(N)-SP2(N)-SP22-INFSP
      PO4SEL(N)=PO4SEL(N)+SP2(N)+SP22
	!the above block is like the nh4 block, but replace the nh4s in the comments
	!with sps

	IF(STONH4(N).LT.0) STONH4(N)=0.
	IF(STONO3(N).LT.0) STONO3(N)=0.
	IF(SPSP(N).LT.0) SPSP(N)=0.
	!the above three just make sure the storage on the element doesn't fall below zero

	TOTALLOSTSOLP(M)  =TOTALLOSTSOLP(M)  +SP22*DT+SP2(N)*DT
	TOTALLOSTSOLNH4(M)=TOTALLOSTSOLNH4(M)+OUTNH42*DT+OUTNH4(N)*DT
	TOTALLOSTSOLNO3(M)=TOTALLOSTSOLNO3(M)+OUTNO32*DT+OUTNO3(N)*DT
	!above three accumulate the total nutrients lost for the simulation over the weir
	!and through the pipe for the pond M

	TOTALINFP(M)=TOTALINFP(M)+INFSP*DT
	TOTALINFNH4(M)=TOTALINFNH4(M)+INFNH4*DT
	TOTALINFNO3(M)=TOTALINFNO3(M)+INFNO3*DT
	!sum up total outflow and infiltration losses of dissolved nutrients for the simulation

	CLENO3(N) = CLENO3(N) + INFNO3
	!add to the no3 that deep percolates
	END IF
	
	AINO3(N)=0.
	AINH4(N)=0.
	SPI(N)=0.
	!reset everything to zero

	IF ((RAITES.NE.1).AND.((H2ODEPTH(M)/PONDAREA(M)).LT.0.013)) THEN
		TOTALINF(M)=TOTALINF(M)+H2ODEPTH(M)
		TOTALINFP(M)=TOTALINFP(M)+SPSP(N)
		TOTALINFNH4(M)=TOTALINFNH4(M)+STONH4(N)
		TOTALINFNO3(M)=TOTALINFNO3(M)+STONO3(N)
		STONH4(N)=0.
		STONO3(N)=0.
		SPSP(N)=0.
		H2ODEPTH(M)=0.0
	END IF
	!when the pond depth gets really low on a pond
	!(1.3 cm or 0.5 in) it will automatically infiltrate instead of
	!taking 4 or 5 days to flow out (which happens when
	!there isn't enough head to force the water through
	!the riser)

	RETURN

21	CONTINUE

!	Here begins the part of the subroutine for infiltration trenches (tipe=3)
	
	NEWSED=0.
	!initialize newsed (newly deposited sediment) to zero

	IF (D.GT.0) THEN
	TOTALIN(M)=D*DT+TOTALIN(M)
	END IF
	!sum up total inflow of water for the simulation

	IF (H2ODEPTH(M).GT.WEIRVOL(M)) THEN
	!this is the only way for water to leave the trench (other than infiltration) - over the
	!embankment
		RATIO=(H2ODEPTH(M)-WEIRVOL(M))/(D*DT)
	!this determines the ratio of the excess water to the inflowing water (thus, the incoming
	!nutrients and sediment can be appropriately partitioned)
		QI(NR(N))=(H2ODEPTH(M)-WEIRVOL(M))/DT*RFL(N)+QI(NR(N))
		QI(NC(N))=(H2ODEPTH(M)-WEIRVOL(M))/DT*(1.-RFL(N))+QI(NC(N))
	!calculate water flowing into the receiving elements - assumed equal to the depth of water
	!above the trench height

		DO K=1,NPART
			SI(NR(N),K)=RATIO*SE(K)*RFL(N)+SI(NR(N),K)
			SI(NC(N),K)=RATIO*SE(K)*(1.-RFL(N))+SI(NC(N),K)
			ONI(NR(N),K)=RATIO*ONI(N,K)*RFL(N)+ONI(NR(N),K)
			ONI(NC(N),K)=RATIO*ONI(N,K)*(1.-RFL(N))+ONI(NC(N),K)
			ANI(NR(N),K)=RATIO*ANI(N,K)*RFL(N)+ANI(NR(N),K)
			ANI(NC(N),K)=RATIO*ANI(N,K)*(1.-RFL(N))+ANI(NC(N),K)
			PI(NR(N),K)=RATIO*PI(N,K)*RFL(N)+PI(NR(N),K)
			PI(NC(N),K)=RATIO*PI(N,K)*(1.-RFL(N))+PI(NC(N),K)
			NEWSED=(1.-RATIO)*SE(K)*DT/(SG(K)*1000.)+NEWSED
		END DO
		!calculate the sediment and nutrients flowing to receiving elements, determined 
		!according to the proportion of inflow leaving the element 
		!NEWSED is the sediment that does not overflow

		AINH4(NR(N))=RATIO*AINH4(N)*RFL(N)+AINH4(NR(N))
		AINH4(NC(N))=RATIO*AINH4(N)*(1.-RFL(N))+AINH4(NC(N))
		AINO3(NR(N))=RATIO*AINO3(N)*RFL(N)+AINO3(NR(N))
		AINO3(NC(N))=RATIO*AINO3(N)*(1.-RFL(N))+AINO3(NC(N))
		SPI(NR(N))=RATIO*SPI(N)*RFL(N)+SPI(NR(N))
		SPI(NC(N))=RATIO*SPI(N)*(1.-RFL(N))+SPI(NC(N))
		!calculate the dissolved nutrients flowing into the receiving elements
		AINH4(N)=0.
		AINO3(N)=0.
		SPI(N)=0.

		TOTALWLOST(M)=TOTALWLOST(M)+(H2ODEPTH(M)-WEIRVOL(M))
		!sum up the water lost over the edge of the trench for the simulation
		H2ODEPTH(M)=WEIRVOL(M)
		!new water volume is equal to the water volume of the full trench
	ELSE
		DO K=1,NPART
			NEWSED=NEWSED+SE(K)*DT/(SG(K)*1000.)
		END DO
		!this is for the case when water does not overtop the trench - all sediment is deposited
	END IF
	
	WEIRVOL(M)=WEIRVOL(M)-NEWSED
	!decrement the trench volume by the amount of deposited sediment

	IF (WEIRVOL(M).LT.0.) WEIRVOL(M)=0.
	!check for negative

	IC=SOIL(N)/256
	IS=MOD(SUR(N),256)
	IF (IS.EQ.0) IS=MOD(SUR(MYSHADOW(N)),256)
	!check.  There is not an IS defined for channel cells, so need to define it here 
	!as the same soil type as the shadow element

	SUPP=H2ODEPTH(M)
	!THIS IS THE AVAILABLE SUPPLY TO INFILTRATE, M³/S; THEORETICALLY, IF THE
	!SOIL COULD INFILTRATE THE ENTIRE VOLUME OF WATER, THEN IT IS AVAILABLE FOR 
	!INFILTRATION

	CU3=CU

	INFILPOT=FILT2(PIV(N),FCAP1(IS),GWC(IS),DR(N),S(N),SUPP,ICU2(M),
     1ROUGH(IC),HU(IC),NEXP,ASMPER(N),KE(IS,IC),PSIF(IS),PHIC(IS),T(L),
     2ICU(M),LF(IS),KS(IS),IC,is,N,CUMIN1(N),rbit0(N),testi(N),timpon(N)
     3,tpon(N),FILTS,DT,ICU1(M),TP1(IS),A(IS),CU3)*DT
	!calculate the potential infiltration for the time step; the soil lining the trench
	!is assumed to be the same soil as normally exists on the element


	IF(INFILPOT.GT.H2ODEPTH(M)) INFILPOT=H2ODEPTH(M)
	IF(INFILPOT.LT.0.) INFILPOT=0.
	!check for negatives

	H2ODEPTH(M)=H2ODEPTH(M)-INFILPOT
	TOTALINF(M)=TOTALINF(M)+INFILPOT
	!decrement water volume in trench by the amount infiltrated; accumulate total infiltration
	!for the simulation

 381	FORMAT (1X,I5,2X,I1,3X,I5,3X,I1,3X,F7.3,1X,F6.2,1X,F4.2,1X,F5.2,1X
	1,F4.1,1X,F6.3,2X,F6.3,2X,F6.3,1X,F6.3,1X,F5.2,3X,F5.3)

	RETURN
	END

!	******************************************************************************************
!RZ	The following function is almost identical to function filt.  The only difference is in the 
!RZ	first few lines of the subroutine.  Where in the other function there is rbit = r/cu, it is
!RZ	changed to rbit=r/cu3.  This was done because, for infiltration trenches, the surface area
!RZ	for infiltration is different than for the rest of the cells, because there are sides and a 
!RZ	bottom to the infiltration trench.  Therefore CU,CU1,and CU2 were changed in subroutine BMPS
!RZ	to reflect the larger surface area in the trench.  However, rbit=r/cu is converting the 
!RZ	rainfall in mm/hr to rainfall in m³/s, and this is not affected by the surface area of the 
!RZ	trench.  CU3 is equal in value to CU in the main program.  The inputs for CU,CU1, and CU2 
!RZ	serve the same function as in the main program, but the values are altered to represent
!RZ	the increased surface area present in a trench.
!     ******************************************************************************************

      FUNCTION FILT2(PIV,FCAP1,GWC,DR,S,R,CU2,ROUGH,HU,NEXP,ASMPER,
     & KE,PSIF,PHIC,T,CU,LF,KS,K,kk,M,CUMIN1,rbit0,testi,timpon,
     & TPON,FILTS,DT,CU1,TP1,AZRAT,CU3)
      IMPLICIT DOUBLE PRECISION A-H,O-Z
      DOUBLE PRECISION NS,KE,KS,LF
C
C **** POTENTIAL INFILTRATION CAPACITY -- WHOLE SURFACE COVERED.
C     IF (T.LE.O.) GOTO 50
C
C **** UNSATURATED INFILTRATION ZONE.
C
************************************
*********************************
******EFFECTIVE MATRIX POTENTIAL
	NS=PHIC*(1.0-ASMPER)*PSIF
***************************************
 
 
 
**DETERMINE THE CUMULATIVE INFILTRATION USING THE NEWTON ITERATION
**TECHNIQUE
**KE*T=F-NS*LN(1+F/NS); G=(F-KE*T)-NS*LN((NS+F)/NS)
** DG/DF= 1-NS/(F+NS)=F/F+NS
** F2=F1-G1/(DG/DF1)
*      if(m.eq.503)write(6,*) filts/cu
*     if(R.lt.0.) stop
 
      if (t.eq.0.) then
	 fmax=r
	 testi=0
	 test1=10
	 goto 2
      endif
       T2=T
       rbit=r/cu3
 
	  if ((r.eq.0.).and.(testi.eq.1).and.(s.lt.0)) then
	  fmax=filts
	  testi=0
	  goto 2
	  endif
 
       if((ke.gt.rbit).and.(testi.eq.1).and.(s.gt.0)) then
	  testi=1
	  goto 8
       else
	 if((ke.gt.rbit).and.(testi.eq.1).and.(s.lt.0)) then
	  testi=0
	  goto 2
	endif
       endif
 
      if(rbit0.eq.r) goto 111
 
 
      if((ke.le.rbit).and.(testi.eq.1)) then
		 testi=1
		test1=13
		 goto 8
      endif
 
 
       if((ke.gt.rbit).and.(testi.eq.0)) then
	  fmax=filts
	  if(r.gt.0.)fmax=r
	  testi=0
	  goto 2
	endif
 
	  if ((r.eq.0.).and.(testi.eq.1).and.(s.lt.0)) then
	  fmax=filts
	  testi=0
	  goto 2
	  endif
 
 
 
 
      cumpon=ns/((rbit/ke)-1.)
 
	if((cumpon-cumin1).lt.0.) then
	      timpon=t2
	      Tpon=60*((cumin1)-NS*DLOG(1.0+(cumin1)/NS))/KE
	      goto 112
	endif
 
      timpon=(cumpon-cumin1)*60./rbit+t2
      Tpon=60*((cumpon)-NS*DLOG(1.0+(cumpon)/NS))/KE
	 test1=15
 
      goto 112
 
111    continue
 
      if(testi.eq.1) goto 8
 
      if ((ke.ge.rbit).and.(testi.eq.0.)) then
	   fmax=filts
	   if(r.gt.0) fmax=r
	   testi=0.
	   timpon=0.
	   tpon=0.
	 test1=16
	   goto 2
      endif
 
 
 112  if(t2.lt.timpon) then
	   fmax=r
	   testi=0
*         test1=17
	   goto 2
      endif
 
 
  8    t1=t2-timpon+tpon
       if(t1.lt.0.) then
	fmax=filts
	goto 2
       endif
       testi=1.
 77    if(cumin1.gt.0) then
		cumf=cumin1
       else
		cumf=0.1
       endif
 88     ZU1=(T1/60.)*KE-(CUMF-NS*DLOG(1.0+CUMF/NS))
	DEL=CUMF/(NS+CUMF)
	TEST=ZU1/DEL
	XX=CUMF+TEST
	IF(ABS(TEST).GT.0.000001) THEN
	CUMF=XX
       GOTO 88
       ENDIF
       CUMINF=CUMF
 
   7    CONTINUE
	FMAX=KE*(1+NS/CUMINF)*CU
	ZXA=FMAX/CU
	FILT2=FMAX
 
*  2    rbit0 = rbit
   2    FILT2=FMAX
*        if (m.eq.76) write(5,888)ke,r/cu,t,timpon,tpon,fmax/cu,testi,
*     & cumin1,cumpon,filts/cu,s/cu,t2
 888   format(12(f10.4,1x),f3.1,5(f10.4,1x))
       rbit0=r
       cumpon=0.
       test1=0.
       IF (PIV) 30,40,10
 
 10   IF (PIV.LT.GWC) GO TO 20
      DR=0.
      RETURN
 
********************************
 20     CONTINUE
	RKFC=KS*AZRAT*(1-PIV*DT/TP1)**(-2.655/DLOG10(FCAP1))
	TI=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)/RKFC
*        computing drainage for one hour
      ZFAY=1./TI
      IF(ZFAY.GT.75.) TI=1./75.
 
	DR=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)*(1.-DEXP(-1/(TI)))*CU
	ASMFI=(1-PIV*DT/TP1)*TP1/CU1

	RETURN
********************************
C
C **** INFILTRATION ZONE SATURATED.
C
  30  PIV=0.
  40  RKFC=KS*AZRAT*(1-PIV*DT/TP1)**(-2.655/DLOG10(FCAP1))
      TI=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)/RKFC
      ZFAY=1./TI
      IF(ZFAY.GT.75.) TI=1./75.
	DR=(((1-PIV*DT/TP1)-FCAP1)*TP1/CU1)*(1.-DEXP(-1./(TI)))*CU
 
      FMAX=DR
      FILT2=FMAX
       testi=1
      RETURN
C
      END



	SUBROUTINE URBANIZED(URBAN,J,JM1,IEL,JMAX,NPAR2,ISTRUC,IC,M,ISR,PR
	1,I,UNITS,SOIVOL,IELC,DX,XZW,XR,DT,XDIR,N,N2,LCC,LCR,CROP)
!	This subroutine was designed by Rebecca W. Zeckoski in Spring/Summer 2001 in partial 
!	completion of the requirements of the Master's of Science degree in Biological
!	Systems Engineering.  Questions on this portion of the code should be directed 
!	to her at rzeckoski@yahoo.com.  Comments denoted by RZ WB are copied from ANSWERS
!	and were originally made by Wes Byne.

!	This subroutine is designed to route flow, sediment, and nutrients through 
!	urbanizing areas.  The original version of ANSWERS-2000 was inadequate to 
!	accomplish this task.

!	The setup of this subroutine is as follows: the variable 'urban' is assigned a 
!	value right before the subroutine is called in the main program.  This value is 
!	dependent upon which part of the program you are exiting.  The first thing this 
!	subroutine does is read the variable 'urban' and direct you to different portions
!	of the subroutine based on its value.  For instance, if you are in the flow routing 
!	portion of the program, a value of (2) is assigned and you will be directed to line
!	(20) of this subroutine, which deals with flow routing.  Urban is assigned a different 
!	value, (4), if you are exiting the sediment portion of the main program; line (40)
!	deals with the sediment routing of urbanizing areas.  The general flow of this subroutine
!	is as follows:

!	10 Read in impervious soil parameters (called from XDATA) - finished 5/22/01
!	20 Read in impervious crop parameters (called from XDATA) - finished 5/24/01
!	30 Reroute flow for curbs or stormwater drains - finished 2/28/01
!	RAINFA subroutine calculations - done in main program 2/28/01
!	40 Sediment detachment calculations - finished 7/6/01 
!	50 Sediment initialization scheme - finished? 7/26/01
!	 Atmospheric deposition - dry and wet - finished in separate subroutine 7/25/01
!	60 Sediment bound nutrient calculations - finished 7/26/01
!	70 Dissolved nutrient calculations - finished 7/26/01
!	 Adjust net rainfall rate - including additions for irrigation (incorporate into RAINFA?) - finished 8/14/01
!	80 Urban BMPs - finished in separate subroutine 9/5/01


!	LOTS OF VARIABLE DEFINITIONS HERE
!	These are listed per section of code (10,20,30,40,50,60,70,80) for user reference.
!	COMMON statements in comments are just listed for user reference - different parts of 
!	the subroutine call on each common statement; if there is more than one section using
!	the same COMMON statement, it can only be defined once; the common block name is listed in
!	the other section's declaration area so the user can determine where the variables in
!	each section come from.

	IMPLICIT DOUBLE PRECISION A-H,O-Z
!	The following are variables new for the urban subroutine:
	COMMON /URBAN/ SEL2(35000,8),ROADWIDTH(20),URBSOIL(35000),
	1PRTCLSSEL(35000,8),DETCAP(8),TRANSCAP(8),URB(35000),URBCR,ISRURB,
     2STORM(35000),CURB(35000)		
	INTEGER URBSOIL, URBAN, URB, URBCR, STORM, CURB

	DIMENSION LCC(35000), LCR(35000)


!	Below are variables for the "10" call:
!	**************************************
	COMMON /ZSEDR/ VISCOS,AGRAV,SWH2O,YALCON,SE(8),VS(35000),DIA(8),
     1SG(8),FV(8),CY1(8),CY2(8),CY4(8),DIAMM(8),EQSDIA(8),EDMM(8),
     2F(30,8),CE1,CE2,CE3,CE4,CE5,CE6
	CHARACTER*4 UN, UNITS 

	COMMON /GRAMPT/ CL(30),SA(30),ST(30),OM(30),AC(30)
     &,AO(30),BC(30),BO(30),PHI(30),VCF(30),WCF(30),CFC(30),
     &CEC(30),EAC(30),PHIC(30),XF(30),PSIF(30),CBF(30),
     &THETAR(30),KS(30),CF(30),Z(30),LF(30),CS(30),SCF(30),
     &CRC(30),KE(30,30),ZC(30),BD(30)

	DATA UN /'METR'/
!	Below are variables for the "20" call:
!	**************************************
	DIMENSION CROP(20,2), RN(20), DIRM(20), CBAR(20), SPER(30),
	1 STRNAM(3,4)
      
      COMMON / CROPAD/  DIRM2(20)
	COMMON /CROUGH/ ROUGH(20),HU(20),DIR(21),PIT(40,20),PER(20)
	COMMON /PLANTN/DATPLA(20),DATHAR(20),CP1(20),CP2(20),DMY(20)
     &  ,YP(20),ROTMAX(20),ROTDAY(20),RLAIMX(20)
     &  ,RES(20),RES20(20),RES90(20)
	COMMON/RILLEROS/NORILLS,RILLSPC(20),QEFF,RILLWID,MNSOIL(21),
     1MNTOT(21),FLOWDEP,HYDRAD,DCAP,FCFRAC(30),FOFD,FPOFD,FDPOFD,
	2FLDEPOLD,MNCHNSL(35000),MNCHNTOT(35000),MNCS(30),MNCT(30),MNCSTMP
	3(35000),MNCTTMP(35000),MAXWID,NOTILL(21),NOEROS(21),DWSOIL,
	4HYDRADOLD(35000)
	DOUBLE PRECISION MNSOIL,MNTOT,MNCHNSL,MNCHNTOT,MNCS,MNCT,MNCSTMP,
	1MNCTTMP,NORILLS,MAXWID
	COMMON /WETDEPOSIT/ NO3ZDEP(21,4),WATNHDEP(21,4),SOLUBPDEP(21,4),
	1TSSDEP(21,4)
	DOUBLE PRECISION NO3ZDEP, WATNHDEP, SOLUBPDEP,TSSDEP
	COMMON /ATMDEPO/ ATMDEP(21,4),TKNDEP(21,4),AMNDEP(21,4),
	1SEPDEP(21,4)

	CHARACTER*4 PRI, PR, CROP
	DATA PRI /'PRIN'/

!	Below are variables for the "30" call:
!	**************************************
      DIMENSION IEL(3,JMAX,NPAR2), NSTRUC(ISTRUC), WID(10), CN(10)
      DIMENSION IELC(3,300,2)
	COMMON /CFLOW/ Q(35000),RFL(35000),FLINS(35000),SS(35000),
	1PIV(35000),B(35000),DR(35000),
     2SL(35000),SEL(35000),SI(35050,8),QI(35050),DIN(35000),
     3SST(35000,8),PIVTMP(35000),SSTMP(35000)

	CHARACTER*2 IELC

!	Below are variables for the "40" call:
!	**************************************
!	Duplicates: /ZSEDR/,/CFLOW/,/RILLEROS/
      COMMON /PHOS1/ P0SOIL(35000),SSA(30,8),SSAT(30),EDI(35000),
     & P0(35000,8),ERP(8),STOLD(35000,8),SEDNEW(35000,8),PPT(35000,8),
     & PI(35050,8),PSEL(35000),STNEW(8),P2(8),PCELL(35000,8),PE(8)
     & ,DRFT(8)      
	COMMON /ZSEDI/ NPART,NWASH,NWASH1
	COMMON /CFLOW2/NR(35000),NC(35000),S(35000)
      COMMON /OUTLET/ NCHAN,NIOUT(9),NJOUT(9),MOUT(9),CHNUM(35000),
     &                CHOUT(9),NCELLS(9),CHNUMBER(35000)
	INTEGER CHNUM,CHOUT,CHNUMBER
      DIMENSION SE1(8),SE2(8),DELTA(8),PS(8),TF(8),TFMSE2(8)
     *,DS1(8),DS2(8),S22(8)
      DIMENSION FILTS(35000), CWID(35000),CWIDTMP(35000)
      COMMON /CSURF/ SUR(35000),RANE(35000),SOIL(35000)
      INTEGER SUR,TIAL(35000),RANE,SOIL
!WB	soil variables:
	COMMON/SOILVAR/CLAY(30),SAND(30),SILT(30),VFSPER(30),VFS(30),
	1ORGMAT(30),MASSCF(30),RANROU(30),RANROUM(30)
	DOUBLE PRECISION MASSCF
!WB	rill erodibility variables:
	COMMON/RILLVARS/KRBASE(35000),KRBR(35000),BR(20),BURRES(20),
	1KRADJHLD(35000),KRCONS(35000),KRSC(35000),KRADJ(35000)
	DOUBLE PRECISION KRBASE,KRBR,KRADJHLD,KRCONS,KRSC,KRADJ
!WB	critical shear variables:
	COMMON/CRTSHEAR/TAUCB(35000),TAURR(35000),TAUCHLD(35000),TAUCONS
	1(35000),TAUSC(35000),TAUCADJ(35000),TAUEFF
!WB	interrill erodibility variables:
	COMMON/IRILLVARS/KIBASE(35000),KICAN(35000),KIGRCOV(35000),KICONS
	1(35000),KISC(35000),KIADJ(35000),CANOPY(20),AUCFACT(20),
     2HEIGHT(20),MAXPLHGT(20),HGTFACT(20),GROWFACT(20)
	DOUBLE PRECISION KIBASE,KICAN,KIGRCOV,KICONS,KISC,KIADJ,MAXPLHGT
!WB	interrill cover common block:
	COMMON /IRILLCOV/ INRCOV(20),INRCOVI(20),INRCOVF(20),INRFACT(20),
	1LROOT(21),DROOT(21),KDROOTI(35000),KLROOTI(35000),DDROOTI(21),
	2DDROOTF(21),DDRTFAC(21),LRFAC(21),LIVEROOT(21),KDROOTR(35000),
	3KLROOTR(35000)
	DOUBLE PRECISION INRCOV,INRCOVI,INRCOVF,INRFACT,LROOT,KDROOTI,
	1KLROOTI,LRFAC,LIVEROOT,KDROOTR,KLROOTR
!WB	interrill erosion variables
	COMMON /IRILLEROS/RNOFIR,SEDDR(35000,8),DIINT(35000,8),DETR(8)
	1,DETF(8),DACT(35000,8)
!WB	PLANT GROWTH VARIABLES
	COMMON /PLANTS/ DAYNOW(35000),YEARNOW(35000),DYYRNOW
	1(35000),DAYTHEN(35000),YEARTHEN(35000),DYYRTHEN(35000),
     2DAYDIFF(35000),BEGROTDT(35000)
!WB	CHANNEL BOTTOM EROSION VARIABLES	
	COMMON /CHANEROS/WIDINC(35000),DOWNRATE(35000),
	1DEPTHINC(35000),IMPERM(30),ROCKBOT(35000),RBTEMP(35000),
     2BULKDENS(30),CHNSOIL(35000),CHNSL(35000),CHNSLTMP(35000)
	3,DEPRATE(35000),DEPPREV(35000),CONSTHLD(35000),XHOLD(35000)
     4,CONSTTMP(35000),XTMP(35000)
	COMMON /ARMOUR/ARMOUR(35000),NOERODE(35000)
	1,NERODTMP(35000)
!WB	HYDROGRAPH PLOT VARIABLES
	COMMON /HYPLT/PRINHYD,IMPFLAG,QHYP(101,10),PHYP(101,10)
	1,DPHYP(101,10),A4SHYP(101,10),A4DHYP(101,10),ONHYP(101,10)
	2,A3HYP(101,10)
	CHARACTER(11) HYPNAM(10)
	DOUBLE PRECISION DIFF,RGTSID,LFTSID,IMPERM,NOERODE,NERODTMP
	INTEGER CNT,CNTER,CNTFLAG,NOTILL,INIT,NOEROS,CHNSL,CHNSOIL,
	1CHNSLTMP,PRINHYD
!RZ FOLLOWING ARE FOR MY NEW VARIABLES IN THIS SUBROUTINE
	DIMENSION FLOWDEPOLD(35000)
	DOUBLE PRECISION FLOWDEPOLD

!	Below are the variables for the "50" (&60) call.
!	************************************************
!	Duplicates: /PHOS1/,/ZSEDR/
 
      COMMON/NITRO1/ A0SOIL(35000),ANPT(35000,8),ANI(35050,8),
     & ANSEL(35000),AN2(8),ANCELL(35000,8),ANE(8),AN0(35000,8)
     & ,CNH4(35000)
 
 
      COMMON/NITRO2/ O0SOIL(35000),ONPT(35000,8),ONI(35050,8),
     & ONSEL(35000),ON2(8),ONCELL(35000,8),ONE(8),ON0(35000,8)

	COMMON /SOLUB/ SP2(35000),PEXT(35000),PK(30)
     & ,RBETA(30),SPI(35050),CGEN1(35000)
     & ,T13(35000),SPSP(35000)

      COMMON /CUMIN/ CUMIN1(35000),rbit0(35000),testi(35000),timpon
	1(35000),tpon(35000)

	DIMENSION SEL2T(30),SOIVOL(30)

	COMMON /DEPOSITION/ O0ADD(35000),A0ADD(35000),P0ADD(35000)

!	Below are the variables for the "70" call.
!	******************************************
!	Duplicates:	/SOLUB/
 
      COMMON/WATNH4/VOLSZ(35000),SZNH4(35000),AINH4(35050),STONH4(35000)
     & ,OUTNH4(35000),EDINH4(35000),VOLSZ1(35000),VOLSOI(35000)

	COMMON/NO3/SZNO3(35000),AINO3(35050),STONO3(35000),OUTNO3(35000)
     & ,CNO3(35000),EDINO3(35000),CLENO3(35000)

	LOGICAL ARESULT

!BEGIN TEST INITIALIZATIONS (TO BE REMOVED UPON SUBROUTINE COMPLETION)
!	URBAN = 2
!	J=10
!	JM1=9
!	DRAIN = 5
!	IEL(1,J,URBAN)=0
!	IEL(3,J,URBAN)=0
!	IEL(2,JM1,URBAN)=1
!	IEL(2,J+1,URBAN)=0
!	I=4
!	RFL(I)=0.5
!	IEL(2,J,DRAIN)=1
!	NR(I)=6
!	IEL(2,JM1,3)=8
!	IEL(2,J+1,3)=6
!	NC(I)=7
!	IEL(1,J,3)=7
!	IEL(3,J,3)=9
	
	DX2=DX**2

!END TEST INITIALIZATIONS
505   CONTINUE

	GO TO (10,20,30,40,50,50,70), URBAN


!************************************************************************************************
!	First, a separate read if the soil type is impervious (the formatting of impervious soil
!	types is different from the formatting of 'real' soils)
!************************************************************************************************
10	CONTINUE
	READ (1,19) URBSOIL(I), (SSA(I,J),J=1,8)
!	This is a flag to indicate that the soil type is urban.  In future calculations in the 
!	program, if urbsoil(i)=1 (where i is the soil type), different calculations will be 
!	performed than for regular soil types.  
	SPER(I)=0.
!	In the main program, this variable seems to keep track of the percentage of the watershed
!	in each soil type, the if statement triggering the call to urbanized skips over the 
!	initialization of SPER in the main program, as well as AGRAV, VISCOS, SWH2O, ZC.
	AGRAV=32.174
!RZ WB	acceleration due to gravity
      VISCOS=0.0000108
!RZ WB	water viscosity
      SWH2O=62.32
!RZ WB	specific weight of water
      IF(UNITS.NE.UN) GO TO 18
!RZ WB	UN = 'METR' , so if its not metric, jump on down
      AGRAV=9.8066352
      VISCOS=0.000001003352832
C     SWH2O=9789.69088
      SWH2O=999.1677535

!	Below: calculations from do loop 57 in main program.

	ZC(I) = 0.0
18	CONTINUE
19	FORMAT (9X,I1,1X,8F8.4)

	RETURN
!************************************************************************************************
!	Now, a separate read if the crop type is impervious.  The formatting is different and 
!	different inputs are required.  If a user wishes to simulate different types of urban
!	areas, he does so by creating different crop rotations.
!************************************************************************************************
20	CONTINUE
	READ (1,27) CROP(I,1),CROP(I,2),PIT(1,I),PER(I),ROUGH(I),HU(I),
     1DIRM(I)
!	Crop(i,1) should always be ' urb' for urban 'crop' types.  Crop(i,2) indicates what type 
!	of urban surface it is and should be a 4 letter abbreviation; e.g., 'road', 'hous', etc.
!	PIT, PER will by default be 0.0, but if there is a significant amount of overhang from plants
!	then they can be changed.  Rough, hu, and dirm should be estimated from the particular 
!	surface types.
	DIRM2(I)=DIRM(I)
	READ (1,28) RANROU(I),MNSOIL(I),MNTOT(I),
     1ROADWIDTH(I)
!	DATPLA and DATHAR for urban purposes are the beginning and end of each stage of a 
!	construction project.  If this is not a construction project (i.e., it is an already 
!	existing structure), then DATPLA and DATHAR should span one julian year.  RANROU should be
!	estimated for each surface type.  MNSOIL and MNTOT are available from the user's manual.  
!	ROADWIDTH is the width of road for the 'crop' type, meters; see user's manual.
	RANROUM(I)=RANROU(I)/1000
!RZ WB	CONVERT RANDOM ROUGHNESS TO M FROM MM
!RZ WB	ERROR CHECKS
	IF (MNSOIL(I).GT.MNTOT(I)) THEN
	WRITE (2,1950) MNSOIL(I),MNTOT(I),I 
	WRITE (*,1950) MNSOIL(I),MNTOT(I),I
 	STOP
	ENDIF
!RZ WB	ERROR CHECKS

      DO 24 KKK=1,ISR
!	In the main program, this loop searches for the correct hydraulic conductivity.  Impervious
!	'soils' have no hydraulic conductivity, so it is set to zero.
 	KE(KKK,I)= 0.0
24    CONTINUE

      IF (PRI.EQ.PR) WRITE (2,960) I,CROP(I,1),CROP(I,2),PIT(1,I),PER(I)
     1,ROUGH(I),HU(I),DIRM(I)

	DO K=1,4
	READ (1,29) ATMDEP(I,K), TKNDEP(I,K), AMNDEP(I,K), SEPDEP(I,K), 
	1NO3ZDEP(I,K), WATNHDEP(I,K), SOLUBPDEP(I,K), TSSDEP(I,K)
	END DO

27	FORMAT (11X,A4,A4,6X,F5.2,6X,F4.2,5X,F4.2,4X,F6.2,4X,F5.3)
28	FORMAT (1X,F5.1,1X,F5.3,1X,F5.3,F5.2)
29	FORMAT (7X,8(F5.2,1X))
  960 FORMAT (1X,I2,1X,2A4,F7.2,2PF12.0,0PF8.2,F8.1,F10.3,F10.2)
 1950 FORMAT (1X,'THE FRICTION FACTOR FOR CROP',F6.3,' EXCEEDS THE '
	1,/,' COMBINED FRICTION FACTOR:',F6.3,' FOR CROP #: ',I3
     2,/,' PLEASE CHANGE THIS.')
	!RZ: changed 'soil' to 'crop' in above message, as the message directed the user incorrectly
	RETURN

!************************************************************************************************
!	Reroute flow if there are curbs or stormwater drains
!************************************************************************************************
30	CONTINUE
!	first reroute for curbs
	IF (IEL(2,J,24).EQ.1) THEN
!	If one of the adjacent column cells is an urban cell then...
	IF (IEL(1,J,21).EQ.1.OR.IEL(3,J,21).EQ.1) THEN
!	If the cell above or the cell below is an urban cell and the column flow is directed
!	to the urban element then...
	IF ((IEL(1,J,21).EQ.1.AND.NC(I).EQ.IEL(1,J,3)).OR.
     1(IEL(3,J,21).EQ.1.AND.NC(I).EQ.IEL(3,J,3))) THEN
!	If one of the adjacent row cells is an urban cell then...
	IF (IEL(2,JM1,21).EQ.1.OR.IEL(2,J+1,21).EQ.1) THEN
!	If the row cell on the left is a urban cell and the flow is routed there, return 
!	to program after checking for storm drains(the flow routing is okay because it is routed
!	to the appropriate urban cells)
		IF (IEL(2,JM1,21).EQ.1.AND.NR(I).EQ.IEL(2,JM1,3)) THEN
			GO TO 35
!	Else if the row cell on the right is an urban cell w/curb and the flow is routed there, 
!	return to program after checking for storm drains (see explanation above)
		ELSEIF (IEL(2,J+1,21).EQ.1.AND.NR(I).EQ.IEL(2,J+1,3)) THEN
			GO TO 35
!	End if for the if elseif loop
		END IF
!	The cell to left or right is urban, but flow is not routed there.  Adjust.
!	If row flow exists (is not less than 0.01) then...
	IF (RFL(I).GT.0.01) THEN
!	Row flow exists, but is evidently routed to a non urban cell.  In this case, water will NOT
!	flow uphill so therefore all flow will be in the column direction, as a curb prevents the
!	movement of water in the row direction.
		RFL(I)=0.0
		GO TO 35
	END IF
!	End if for the right or left cell urban loop
	END IF
!	There are no urban cells to the right or left. All flow should be in the urban column cells.
	RFL(I)=0.0
	GO TO 35
!	End if for the correct column routing loop
	END IF
!	There are column urban cells but they are not routed properly
!	This means that the column flow must not occur because the water cannot flow uphill
!	and the column cell the flow is routed to is not urban (thus the curb does not route flow
!	that way).  So, check:
!	If one of the adjacent row cells is an urban cell w/curb and the flow is routed to that
!	cell then all flow is in rows (because no urban column receiving cells reach this point) 
!	and flow needs to be redirected so it is all in rows.
      IF ((IEL(2,JM1,21).EQ.1.AND.NR(I).EQ.IEL(2,JM1,3)).OR.
     1(IEL(2,J+1,21).EQ.1.AND.NR(I).EQ.IEL(2,J+1,3))) THEN
	RFL(I)=1.0
	GO TO 35
	END IF

!	Check to see if there are diagonal receiving elements
!	if the flow is primarily in rows then
	IF (RFL(I).GT.0.5) THEN
!	if the flow is to the left then
	IF (NR(I).LT.I) THEN
!	check to see whether the column receiving element is above or below the current cell
		IF (NC(I).EQ.IEL(1,J,3)) THEN
!	column receiving element is above the cell; if the urban flag for the cell before that
!	(according to row flow) is 1, then set this as the receiving cell
			IF (IEL(1,JM1,21).EQ.1) NR(I)=NC(I)-1
		ELSE
!	column receiving element is below the cell; if the urban flag for the cell before that
!	(according to row flow) is 1, then set this as the receiving cell
			IF (IEL(3,JM1,21).EQ.1) NR(I)=NC(I)-1
		END IF
!	same thing for the row flow going to the right
	ELSE
		IF (NC(I).EQ.IEL(1,J+1,3)) THEN
			IF (IEL(1,J+1,21).EQ.1) NR(I)=NC(I)+1
		ELSE
			IF (IEL(3,J+1,21).EQ.1) NR(I)=NC(I)+1
		END IF
	END IF
!	flow is primarily in columns
	ELSE
!	check to see whether the column receiving element is above or below the current cell
		IF (NC(I).EQ.IEL(1,J,3)) THEN
!	column receiving element is above the cell; check the adjacent row cells to determine
!	if one of them is urban; if so, route flow there
			IF (IEL(1,JM1,21).EQ.1) NR(I)=NC(I)-1
			IF (IEL(1,J+1,21).EQ.1) NR(I)=NC(I)+1
		ELSE
!	column receiving element is below the cell; check the adjacent row cells to determine
!	if one of them is urban; if so, route flow there
			IF (IEL(3,JM1,21).EQ.1) NR(I)=NC(I)-1
			IF (IEL(3,J+1,21).EQ.1) NR(I)=NC(I)+1
		END IF
	END IF
!	If a cell reaches this point, it is not flowing in columns because it cannot flow uphill
!	and it is not flowing in rows for the same reason (anything that gets through the last loop
!	does not have a downhill urban cell to flow to).  It is assumed that any such situation would
!	have a storm drain at the point of concern, whether or not declared in the input file.  
!	Otherwise severe ponding and flooding would result.
!	Therefore, assign the storm drain flag to 1 if it is not already.
	IEL(2,J,22)=1
	GO TO 35
!	End if for the original column cell loop
	END IF
!	The program reaches this point only if neither one of the adjacent column cells are urban.
!	Check to see if one of the adjacent row cells is urban.
	IF (IEL(2,JM1,21).EQ.1.OR.IEL(2,J+1,21).EQ.1) THEN
!	If one of the adjacent row cells is an urban cell w/curb and the flow is routed to that
!	cell then all flow is in rows (because no urban column cells reach this point) 
!	and flow needs to be redirected so it is all in rows.
	IF ((IEL(2,JM1,21).EQ.1.AND.NR(I).EQ.IEL(2,JM1,3)).OR.
     1(IEL(2,J+1,21).EQ.1.AND.NR(I).EQ.IEL(2,J+1,3))) THEN
	RFL(I)=1.0
	GO TO 35
	END IF
!	Check to see if there are diagonal receiving elements
!	if the flow is primarily in rows then
	IF (RFL(I).GT.0.5) THEN
!	if the flow is to the left then
	IF (NR(I).LT.I) THEN
!	check to see whether the column receiving element is above or below the current cell
		IF (NC(I).EQ.IEL(1,J,3)) THEN
!	column receiving element is above the cell; if the urban flag for the cell before that
!	(according to row flow) is 1, then set this as the receiving cell
			IF (IEL(1,JM1,21).EQ.1) NR(I)=NC(I)-1
		ELSE
!	column receiving element is below the cell; if the urban flag for the cell before that
!	(according to row flow) is 1, then set this as the receiving cell
			IF (IEL(3,JM1,21).EQ.1) NR(I)=NC(I)-1
		END IF
!	same thing for the row flow going to the right
	ELSE
		IF (NC(I).EQ.IEL(1,J+1,3)) THEN
			IF (IEL(1,J+1,21).EQ.1) NR(I)=NC(I)+1
		ELSE
			IF (IEL(3,J+1,21).EQ.1) NR(I)=NC(I)+1
		END IF
	END IF
!	flow is primarily in columns
	ELSE
!	check to see whether the column receiving element is above or below the current cell
		IF (NC(I).EQ.IEL(1,J,3)) THEN
!	column receiving element is above the cell; check the adjacent row cells to determine
!	if one of them is urban; if so, route flow there
			IF (IEL(1,JM1,21).EQ.1) NR(I)=NC(I)-1
			IF (IEL(1,J+1,21).EQ.1) NR(I)=NC(I)+1
		ELSE
!	column receiving element is below the cell; check the adjacent row cells to determine
!	if one of them is urban; if so, route flow there
			IF (IEL(3,JM1,21).EQ.1) NR(I)=NC(I)-1
			IF (IEL(3,J+1,21).EQ.1) NR(I)=NC(I)+1
		END IF
	END IF

!	Cell reaching this point has row urban cells, no column urban cells, but the flow is not
!	directed properly.  Since water doesn't run uphill, no outflow.  Insert drain if there isn't
!	one.
	IEL(2,J,22)=1
	END IF
	END IF

!	Cells are now tested for storm water drains. 
35	CONTINUE

!	If the cell is not a stormwater drain cell, return to main program.
	IF (IEL(2,J,22).NE.1) GO TO 38
!	Assign the row and column outflow to a dummy drain cell, equal to one more than the number
!	of overland flow cells, channel cells, and structure cells
	IF (IEL(2,J,23).EQ.0) THEN	
	NR(I)=NMAX+ISTRUC+2
	NC(I)=NMAX+ISTRUC+2
	LCC(I)=1
	LCR(I)=1
	OUTSID=OUTSID+1.
	ELSE !THERE IS A DRAIN POINT SPECIFIED
	NR(I)=IEL(2,J,23)
	NC(I)=IEL(2,J,23)
	END IF

38	RETURN

!************************************************************************************************
!	Fix sediment detachment calculations
!************************************************************************************************
40	CONTINUE
!****
!	This subroutine is copied completely from the main program, with my modifications inserted
!	at the appropriate places.  This seemed far less complicated than trying to exit the main 
!	program every time I had something to change for urban cells.  Anything commented with
!	WB that you have questions about should be addressed to Frank Wes Byne, who originally
!	created most of this subroutine.
!****
	
 !input variables: (XZW,XR,DT,XDIR,M,N,KK,DX,N2) these are called in URBANIZED call, defs below:
!WB	XZW = element or channel width, XR = net rainfall rate for raingage
!WB	i on surface type j, DT=TIME INCREMENT, XDIR = retention depth 
!WB	for cropping practice i, M = element # counter, N = # overland flow 
!WB	elements, KK = soil type for current element, DX = length of side
!WB	of square element,N2=# OF O.F. CELLS + CHANNEL CELLS      
	KK=SOIL(M)/256 	

	IF (SEL(M).GT.0) THEN

	PRTCLSSEL(M,1)=(SEL2(M,1))/SEL(M)
	PRTCLSSEL(M,3)=(SEL2(M,3))/SEL(M)
	PRTCLSSEL(M,2)=(SEL2(M,2))/SEL(M)
	PRTCLSSEL(M,4)=(SEL2(M,4))/SEL(M)

	ELSE

	PRTCLSSEL(M,1)=0.25
	PRTCLSSEL(M,3)=0.25
	PRTCLSSEL(M,2)=0.25
	PRTCLSSEL(M,4)=0.25

	END IF

!	DO J=1,4
!		WRITE(*,6) J,PRTCLSSEL(M,J)
!	END DO
!    6 FORMAT ('PRTCLSSEL',I1,1X,F6.3)

	NP=1
	
      IF(Q(M).GT.0.) GO TO 130
!WB	if the outflow from element i at start of time increment is
!WB	greater than 0, then jump on down to 30

C
C.......NO OUTFLOW, ALL SEDIMENT ASSUMED DEPOSITED............
C
      GO TO 110

  105 NP=NWASH1
!WB	you are sent to line 105 after line 50 if the summation of deltas 
!WB	is less than 0

  110 CONTINUE
      DO 120 IC=NP,NPART
!WB	the first time through, the IC=NP is =1, so this loop is performed
!WB	from 1 until the # of particle size classes
	SEL(M)=SEL(M)+.5*(SST(M,IC)+SI(M,IC))
!WB	accum sed in el i for a storm = same + 0.5*(sum of initial values in
!WB	sedi. continuity eqn + rate of sediment inflow into el i from 
!WB	adjacent elements)

	IF (SEL(M).LT.0.) SEL(M)=0.

	SEL2(M,IC)=SEL2(M,IC)+.5*(SST(M,IC)+SI(M,IC))
!	The above equation was inserted to keep track of the sediment in each
!	particle size class.  This is used later when calculating sediment detachment.
	
	IF (SEL2(M,IC).LT.0.) SEL2(M,IC)=0.
!	Above is a general error check.  SEL2 should not fall below 0 for an urban
!	cell anyway, but this just makes sure.
!	WRITE(*,1) M,IC,SEL2(M,IC)
 !   1	FORMAT('SEL2',1X,I8,1X,I1,F5.2)
 	SST(M,IC)=SI(M,IC)
!WB	sum of initial values in sediment continuity equation is equal to 
!WB	the rate of sediment inflow into element i from adjacent elements
!WB	the M, IC denotes the element # we are going through and the particle
!WB	size class #
!WB	the previous two lines indicate that the sed accum in an element is
!WB	equal to the accum sed from the previous time step + 0.5 (the sed 
!WB	inflow from the prev time step + sed inflow at current time step)
!DETERMINING THE NEWLY GENERATED SEDIMENT

	SEDNEW(M,IC)=0.
!WB	rate of new erosion occurring in cell for a particle class i (kg/sec)
!WB	and M,IC is element #, particle size class #
	STNEW(IC)=0.
!WB	soil storage for particle class i

C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=0.
!WB	rate of sediment movement from an element for this particle size 
!WB	(kg/s) class is equal to 0

C *** NRZ END
  120 CONTINUE
!WB	this is the end of the first section loop that sets the sediment
!WB	continuity equation for the cells equal to the sediment inflow
!WB	and then sets the new sed generated in cell equal to 0

      IF(NP.EQ.NWASH1.AND.NWASH.NE.0) GO TO 165
!WB	NWASH = # washload particle size classes, NWASH1 = NWASH+1
!WB	NWASH1 is a counter for particle size classes that are settleable
!WB	(remember that washload particles (NWASH) are not settleable unless
!WB	flow is 0), so if there are for example 5 particle size classes,
!WB	and two of those are settleable, then NWASH1 to NPART is a count
!WB	of settleable particles 
!WB	this sends you down to do washload calculations
	GO TO 1410
      RETURN              
!
!.......OUTFLOW...............................................
!
  130 CONTINUE
      SMDIR=S(M)-XDIR
!WB	 = storage at start of time increment for el i - ret. depth for 
!WB	cropping practice i (m3/s)
!WB	I think that this says that the amount of storage at the start
!WB	of the time increment minus the ret depth, so this tells if there
!WB	is water available to runoff
!RZ	SMDIR = Storage Minus xDIR
      IF(SMDIR.LE.0.) GO TO 110
!WB	if the above var is less than or equal to 0, then jump back up
!WB	and redo the intialization of the cont eqn, sed gen var.'s
!WB	so, from above, if there is no runoff, you jump back up and calc.
!WB	the sediment inflow into a cell, and reset the continuity eqn
!WB	equal to inflow to the cell

!
!.......CALCULATE TRANSPORT CAPACITY FOR EACH ...........
!................PARTICLE SIZE CLASS.....................
!
      SDEL=0.
!WB	summation of delta = 0
!WB	essentially, delta is the dimensionless excess of the tractive 
!WB	force, and Yalin made the assumption that the # of particles in
!WB	transport was equal to a linear function of delta
      VSTAR=VS(M)*DSQRT(SMDIR)
!WB	shear velocity = simplification var * sqrt(storage-ret. depth)
!WB	in the text, Vstar = (g R S)^0.5, where g is gravity, R is 
!WB	hydraulic radius assumed equal to flow depth, S is slope of 
!WB	the energy gradeline
!WB	
      CY5=VSTAR*XZW
!WB	simplifying constant = shear vel * element or channel width
!WB	
      DO 150 IC=NWASH1,NPART
!WB	
	REYN=CY1(IC)*VSTAR
!WB	constant(NWASH1)*shear velocity
!WB	this appears to be the Reynold's # calculation for the particle size
!WB	class
	YCR=SHIELD(REYN)
!WB	dimensionless critical shear = shields function of reynolds #

	DELTA(IC)=VSTAR**2/(CY2(IC)*YCR)-1.0
!WB	variable = shear vel^2 / [const(NWASH1)*dimensionless crit shear)-1
!WB	dimensionless excess of the tractive force = shear velocity^2 / 
!WB	simplifying constant (particle size class) * dimensionless critical
!WB	shear) - 1.0
	IF(DELTA(IC).LE.0) GO TO 145
!WB	if the dimensionless critical shear is less than or equal to 0	
!WB	then jump down to line 45 because there is no transport
	SIGMA=1.65908*DELTA(IC)*DSQRT(YCR)
!WB	sigma = 1.65098*delta(NWASH1)*DSQRT(dimensionless crit shear)
!WB	sigma is unnamed, and this equation differs from the paper by the 
!WB	factor 2.45*particle spec grav^-0.4, whereas this equation has the
!WB	constant 1.65908
!RZ	1.65908=2.45*2.65^(-0.4); particle specific gravity is assumed 2.65 in ANSWERS
	PS(IC)=YALCON*DELTA(IC)*(1.-DLOG(1.+SIGMA)/SIGMA)
!WB	variable = Yalin's constant*delta*(1-natural log(1+sigma)/sigma)
!WB	PS is unnamed, however this is used in the trans cap equation
!WB	from the paper
	SDEL=SDEL+DELTA(IC)
!WB	summation of delta = sum + delta
!WB	this is important because it is assumed that for a mixture, the # 
!WB	of particles of a size i in transport is proportional to delta i
	GO TO 150
  145    CONTINUE
	DELTA(IC)=0.
!WB	this one is where you are sent if Y<= Ycr (shear stress < crit value)
	PS(IC)=0.
!WB	essentially sets the transport capacity equal to 0
  150  CONTINUE
      IF(SDEL.LE.0.) GO TO 105
!WB	if the summation of delta is <= 0, go on back to the top to 
!WB	reapportion inflow and sum the sediment continuity eqn
      DO 160 IC=NWASH1,NPART
!WB	reset the count variable IC equal to the NWASH1 variable, and add
!WB	it up to number of particle size classes
	TF(IC)=PS(IC)*DELTA(IC)/SDEL*CY5*CY4(IC)
!WB	transport cap = var * delta / sum delta * const * const
!WB	this says that the transp cap is a function of the ratio of the 
!WB	amount of dimensionless critical shear of this particle size class
!WB	to the summed delta of all particle size classes.

  160  CONTINUE
C
  165  CONTINUE
!WB	you are sent here from above if nwash not equal 0 and NP 
!WB	equals NWASH1
      AREA=DX*XZW

CC....CALCULATE RAINFALL DETACHMENT & POTENTIAL FLOW DETACHMENT....
C
!WB	************* NEW SEDIMENT DETACHMENT ROUTINE *****************
!WB	********************* flow detachment *************************
	JK=MOD(SUR(M),256)
!WB	jk extracts the crop descriptor #=cover type

	IF (urb(m).ne.1) then
	continue
	end if

	IF (M.GT.N) GO TO 9400
!	Below: if the cell is an urban cell, as all cells will be if they're
!	going through this routine, rill spacing is the road width and 
!	number of rills is either 1 or 2 depending on road width.

	RILLSPC(JK)=ROADWIDTH(JK)
	IF (ROADWIDTH(JK).LT.0.1) THEN
		NORILLS=0
		RILLSPC(JK)=DX
		QEFF=Q(M)
	ELSE
		IF (ROADWIDTH(JK).LE.DX) THEN
			NORILLS=2
			RILLWID=0.3
			QEFF=Q(M)/(NORILLS)	
		ELSE
			NORILLS=1
			RILLWID=0.3
			QEFF=Q(M)/(NORILLS)	
		END IF
	END IF


 9400 CONTINUE
	IF (M.GT.N) THEN
	QEFF=Q(M)
	RILLWID=XZW+WIDINC(M)
	JK=21
	MNSOIL(JK)=MNCHNSL(M)
	MNTOT(JK)=MNCHNTOT(M)
	NORILLS=1.
	IF (MNSOIL(JK).GT.MNTOT(JK)) THEN
	WRITE (2,1002) 
	WRITE (*,1002) 
	STOP
	ENDIF
!WB	IF THE CELL IS A CHANNEL CELL, THEN SET THE QEFF EQUAL TO FLOW 
!WB	RATE, AND RILLWID=CWID (PASSED AS XZW IN THE SUBROUTINE CALL),
!WB	IF THE CELL IS DESIGNATED NOEROS THEN SET THE WIDTH INCREASE = 0
!WB	THEN SET JK=21, WHICH IS THE LAST POSITION
!WB	IN THE ARRAY MNSOIL, AND USE THIS POSITION TO HOLD THE FRICTION 
!WB	FACTOR FOR EACH CHANNEL CELL.  SAME GOES FOR MNTOT.  FINALLY, THERE'S
!WB	AN ERROR STATEMENT IF MNSOIL EXCEEDS MNTOT.
	ENDIF


	DO IC=1,NPART
!		Detachment Capacity=sediment accumulation on the cell for the particle size class (note
!		that the detachment capacity here is an actual amount of sediment and IS NOT the same
!		as the detachment capacity in the main program, which is based on shear stress; hence
!		the different names).
		DETCAP(IC)=SEL2(M,IC)
		TRANSCAP(IC)=TF(IC)-SST(M,IC)
		IF (TRANSCAP(IC).LT.0.) TRANSCAP(IC)=0.		
		IF(TRANSCAP(IC).GE.DETCAP(IC)) THEN
			DACT(M,IC)=DETCAP(IC)
		ELSE
			DACT(M,IC)=TRANSCAP(IC)
		END IF
!	WRITE(*,5) IC,DETCAP(IC),IC,TRANSCAP(IC)
!    5 FORMAT('DETCAP',I1,1X,F6.3,3X,'TRANSCAP',I1,1X,F6.3)
	IF ((SST(M,IC).GT.TF(IC)).OR.((SST(M,IC).GE.0).AND.
	1(TF(IC).LE.0))) THEN
!WB	IF THE SED IN TRANSPORT IS GT TRANS CAP, YOU WILL HAVE
!WB	A NEGATIVE DCAP, SO SET DACT=0
!RZ	DACT=ACTual Detachment
	DACT(M,IC)=0
!	ELSE
!	DACT(M,IC)=DCAP*(1-(SST(M,IC)/TF(IC)))
!RZ	see equation 17 in Wes Byne's thesis.
	END IF
	END DO



 	IF (DACT(M,IC).GT.10) THEN
!WB	JUST A GENERAL ERROR CHECK, DACT IS IN KG/S
	WRITE (*,*) 'DACT(M,IC) GT 10',DACT(M,IC),M,IC
	PAUSE
	ENDIF

!	IF (M.GT.N) GO TO 9405
!WB	IF ITS A CHANNEL CELL, THEN JUMP DOWN TO CHANNEL DETACHMENT
!WB	**************** Rainfall detachment **********************	
!	RNOFIR=QEFF/(DX*RILLSPC(JK))
!	IF (RNOFIR.GT.1) THEN
!WB	GENERAL ERROR CHECK
!	WRITE (2,*) 'RNOFIR EXCEEDS 1,2',M
!RZ	PAUSE
!RZ	PAUSE COMMENTED OUT AND MSG WRITTEN TO OUTPUT FILE SO THE THING WILL RUN 11/11/01
!	ENDIF
!WB	rnofir=interrill runoff rate, assumed equal to the effective runoff
!WB	rate per rill / (flow length*distance b/t rills).  This equals the
!WB	flowdepth at present time
!RZ	RuNOFf InterRill


!RZ	The following if then statements determine which value to use for the interrill 
!RZ	erodibility factor.  This is the base factor, without the adjustments made in the main
!RZ	program, as the adjustments in the main program have no meaning for impervious area.  The
!RZ	values are taken from (Frank) Wes Byne's thesis, equations 70-73.
!	IF (PRTCLSSEL(M,3).GT.30) THEN
!		IF (PRTCLSSEL(M,4).GT.40) THEN
!			KIADJ(M)=10412000.
!		ELSE 
!			KIADJ(M)=2728000.+19210000.*PRTCLSSEL(M,4)
!	END IF
!	END IF

!	IF (PRTCLSSEL(M,3).LE.30) THEN
!		IF (PRTCLSSEL(M,1).LE.10) THEN
!			KIADJ(M)=5502700.
!		ELSE 
!			KIADJ(M)=6054000.-5513000.*PRTCLSSEL(M,1)
!	END IF
!	END IF
!RZ	PRTCLSSEL(m,1)=clay; (m,2)=silt; (m,3)=sand; (m,4)=very fine sand



! 	DO 9500 IC=1,NPART
!	DIINT(M,IC)=(KIADJ(M)*XR*RNOFIR*1.00/AREA)
!WB	DIINT=INTERRILL DETACHMENT, KIADJ=ADJUSTED INTERRILL ERODIBILITY,
!WB	XR=NET RAINFALL RATE CONVERTED TO M3/S,
!WB	RNOFIR=INTERRILL RUNOFF RATE,SEDDR=SED DELIVERY
!WB	RATIO, AREA=AREA OF CELL OR CHANNEL, USED TO ADJUST THE RAINFALL
!WB	RATE TO A UNIT AREA BASIS, AND THEN THE DETACHMENT IS MULTIPLIED
!WB	BY AREA BELOW.
!	IF (DIINT(M,IC).GT.150) THEN
!WB	GENERAL ERROR CHECK
!	WRITE (*,*) 'DIINT EXCEEDS 100'
!	WRITE (2,*) 'DIINT EXCEEDS 100,2',M
!RZ	DIINT(M,IC) = DIINT(M,IC)/2.
!RZ	PAUSE
!RZ	STOP
!	ENDIF
!	DIINT(M,IC)=DIINT(M,IC)*((DX*DX)-(NORILLS*RILLWID*DX))
!WB	THIS SAYS THAT THE INTERRILL CONTRIBUTION IN KG/S*M2 SHOULD BE
!WB	MULTIPLIED BY THE INTERRILL AREA, WHICH EQUALS THE CELL AREA
!WB	MINUS THE RILL AREA
! 9500	END DO
!	DO IC=1,NPART
 !     DETR(IC)=DIINT(M,IC)
!WB	rainfall detachment (kg/s) = 
 !     DETF(IC)=DACT(M,IC)
!WB	flow detachment (kg/s) = 

!	END DO

 !     GO TO 175

 9405 CONTINUE

  170  DO IC=1,NPART
	DETR(IC)=0.
!WB	reset rainfall detach to 0
      DETF(IC)=DACT(M,IC)
!WB	you are sent here to reset flow and rainfall detachment if the 
!WB	element is a channel cell
	END DO

  175  CONTINUE
!WB	you skip the reset of the rainfall and flow detachments to 0 if
!WB	you are still doing calculations on overland flow cells
      DO IC=1,NPART
	DRFT(IC)=DETF(IC)   !DETR(IC)*PRTCLSSEL(M,IC)+DETF(IC)
!	PRTCLSSEL was multiplied by DETR so that both DETR and DETF would be
!	in terms of the particle size class (before being multiplied by fraction
!	particle size in soil, DETR is only in terms of the entire soil present).
	IF (DRFT(IC).GT.DETCAP(IC)) DRFT(IC)=DETCAP(IC)
!	WRITE(*,4) IC,DETR(IC),DETF(IC),DRFT(IC)
!   4 FORMAT ('PART. CLASS',I1,1X,'DETR',F6.3,1X,'DETF',F6.3,1X,
!     &'DRFT',F6.3)
!WB	sum of rainfall & flow detach (kg/s)
	END DO
      X1=Q(M)/S(M)
!WB	X1 = flow / water storage on element
!WB	(it's a volumetric flow/volum storage)
      X2=1./(1.+X1)
!WB	X2 = 1 / (1+flow/storage)
!WB	this is also:  storage/(storage+flow)
      IF(NP.EQ.NWASH1.AND.NWASH.NE.0) GO TO 1310
!WB	if np equals NWASH + 1 and # of washload particles doesn't equal 0
!WB	line 310 is the beginning of the washload particle calculations
      X3=X1*X2
!WB	X3 = (flow / storage) * (1 / (1+flow/storage))
!WB	this is also flow/(flow+storage)
      X4=1./X1
!WB	X4 = storage / flow
      DO 180 IC=NWASH1,NPART
!WB	do from counter IC = # washload particles + 1 up to # of particles
	DS1(IC)=SI(M,IC)  !+PRTCLSSEL(M,IC)*DETR(IC)
!	In the main program, the place held by prtclssel is f(kk,ic) (fraction of 
!	particle size class in the soil).  However, here there is no f(kk,ic), so 
!	the fraction of the deposited sediment in each particle size class is used instead.
!	PaRTicle CLaSs SEL

!WB	max rate of sed. inflow & erosion in element with only rainfall 
!WB	detach (kg/s) = sed. inflow + fraction of particles of type i in 
!WB	original soil * detach rate for rainfall
	DS2(IC)=DS1(IC)+DETF(IC)
!	Here the f(kk,ic) variable is eliminated because DETF(IC) is calculated for each
!	particle size class above (in the main program, the DETF(IC) is calculated for the
!	element in general and then multiplied here by f(kk,ic) to get it in terms of the
!	particle size distribution).

!WB	max rate of sed inflow & erosion in element with rainfall & 
!WB	flow detachment (kg/s) = above + fraction of particles of type i in 
!WB	original soil (soil type of current element, particle size class)
!WB	 * flow detachment (kg/s)
	S22(IC)=(SST(M,IC)+DS2(IC))*X2
!WB	S22 = (sum of initial values in sed. cont eqn (kg/s) + 
!WB	max rate sed inflow & erosion w/ rainfall & flow detach (kg/s)) * 
!WB	 (1/(1+(flow/storage)))
	SE1(IC)=(SST(M,IC)+DS1(IC))*X3
!WB	SE1 (rate of sed movement w/o flow detachment
!WB	 = (sum of initial values in sed cont eqn + 
!WB	max rate of sed. movement w/ rainfall detach) * X3
	SE2(IC)=S22(IC)*X1
!WB	SE2 (rate of sed movement w/ rainfall and flow detachment)
!WB	 = sed cont eqn + erosion w/rainfall & flow detach * (1/1+
!WB	 (flow/storage)) * flow/storage
  180  CONTINUE
!WB	you are sent here after completing the last loop for the # of 
!WB	settleable size classes
C
C.........APPORTION ANY TRANSPORT EXCESS TO DEFICITS..........
C
      NPM=NPART-NWASH
!WB	NPM = # of particle size classes - # of washload size classes
!WB	this is equal to the # of settleable size classes
  190  I1=0
!WB	counter
!WB	you are sent here from later in the prog
      I2=0
!WB	counter
      I3=0
!WB	counter 
      SDEL=0.
!WB	sum of delta
      TFXCES=0.
!WB	trans cap excess

!WB********calculate transport capacity excess ******************
      DO 1150 IC=NWASH1,NPART
!WB	do from nwashload part's + 1 to # particle size classes
	TFMSE2(IC)=TF(IC)-SE2(IC)
!WB	 = trans cap - sediment w/ rainfall and flow detach
	IF(TFMSE2(IC))1130,1140,1110
!WB	if above var < = > 0, then go to 130, 140, 110, respectively
!WB	this says, is trans cap less than sediment erosion 
!WB	capacity with rainfall and flow detachment, or equal to or 
!WB	greater than
C
C............TRANSPORT > SE2........................
C
!WB	this says that the transport capacity exceeds the detachment
!WB	rate with rainfall and flow detachment
 1110    I1=I1+1
!WB	count
	TFXCES=TFXCES+TFMSE2(IC)
!WB	trans cap excess = excess + (cap - no flow detachment)
!WB	this says that the excess is equal to the previous excess + the
!WB	definition of trans cap excess
	TF(IC)=SE2(IC)
!WB	trans cap = rate of sed movement w/ rainfall and flow detach	
!WB	set trans cap equal to the detachment rate if you have an excess
!WB	of t.c.
      GO TO 1150
C
C............TRANSPORT < SE2........................
C
!WB	this says that if the transport capacity is less than the 
!WB	detachment rate 
 1130    I3=I3+1
!WB	count
	SDEL=SDEL+DELTA(IC)
!WB	summ of delta = same + delta (= dimensionless crit shear)
 1140    I2=I2+1
!WB	count.  You are sent here if the t.c. excess is equal to the 
!WB	detachment rate.
 1150  CONTINUE
!WB	you are sent here to skip the I3 counter and the sum of delta
!WB	for the condition of t.c. < detachment rate (or equal to det.
!WB	rate), and the I2 counter
      IF(SDEL.LE.0.) GO TO 1200
!WB	sum of delta less than or equal to 0.  You get here if t.c.
!WB	exceeds SE2 for all particle size classes, or if t.c. is 
!WB	equal to SE2 for all particle size classes
      IF(I1.EQ.NPM.OR.I2.EQ.NPM.OR.I3.EQ.NPM) GO TO 1200
!WB	if the count equals the # of settleable particle size classes or
!WB	if count I2 or if count I3 equals the same, then go to 200
!WB	this says that if you have gone through the loop the same #
!WB	of times as the # of settleable particle size classes, then skip
!WB	the reapportionment of trans capacity
!WB********end of transport capacity excess loop/section********

!WB	***********reapportion the transport capacity************
!WB	I believe that this loop is done until T.C < SE2
      DO 1160 IC=NWASH1,NPART
!WB	do from the counter that represents the # of particle size classes
!WB	that are settleable up to the # of particles
	IF(TFMSE2(IC).GE.0..OR.DELTA(IC).LE.0.) GO TO 1160
!WB	if trans cap excess > 0 or delta (= excess tractive force) < 0
	TF(IC)=TF(IC)+TFXCES*DELTA(IC)/SDEL
!WB	trans cap = same + accum trans cap excess * delta / sum of deltas
	IF(I3.EQ.1) GO TO 1170
!WB	if the I3 counter equals 1, which occurs when t.c. is lt se2, 
!WB	and there won't be sufficient energy for transport, and then
 1160 CONTINUE
      GO TO 190
!WB	this sends you back to the top to redo the calculations on trans
!WB	capacity.  you are sent here if trans cap excess is greater than
!WB	or equal to 0 or if the excess tractive force = 0
 1170 IF(TF(IC).GT.SE2(IC)) TF(IC)=SE2(IC)
!WB	if the trans cap > detach rate, then trans cap = 
!WB	detachment rate
!WB	you get here if the I3 counter is = 1, which means that t.c. < det
!WB	rate
C
C.........SOLVE CONTINUITY EQUATION FOR SEDIMENT TRANSPORT.....
C
 1200  CONTINUE
!WB	you are sent here if any of the counters equals to the # of 
!WB	settleable particle classes
      DO 1300 IC=NWASH1,NPART
!WB	do from # washload particles + 1 up to # particles size classes
!WB	I believe that the NWASH1 var is used to keep count of the same
!WB	thing as NPM
	IF(TF(IC).LT.SE1(IC)) GO TO 1240
!WB	if trans cap < rainfall detach
	IF(TF(IC).LT.SE2(IC)) GO TO 1220
!WB	if trans cap < max detach rate with rainfall & flow
!WB	so you jump over the next section if the trans cap is not equal
!WB	to maximum, and you're directed according to the amt of detachment
C
C..........MAXIMUM RAINFALL AND FLOW DETACHMENT...............
C...................NO DEPOSITION.............................
C
!WB	this is the section for t.c.>SE2 and so all detachment can be 
!WB	transported
	SST(M,IC)=DS2(IC)-SE2(IC)+S22(IC)
!WB	SST = (detachment rate w/rainfall & flow detach + sed inflow prev
!WB	time step) -
!WB	[(sed cont eqn prev time step +
!WB    detachment w/ rainfall & flow detach)*(1/1+
!WB	 (flow/storage)) * flow/storage] *
!WB	(flow/storage) + [sed cont eqn prev time step +
!WB    detachment w/ rainfall & flow detach)*(1/(1+(flow/storage)))]
!RZ	sediment in transport = detached soil - sediment exiting + sediment already 
!RZ	in transport?

C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=SE2(IC)
!WB	sediment movement from a cell is equal to max detach rate 
!WB	with rainfall & flow 
C *** NRZ END
	SEL(M)=SEL(M)-DRFT(IC)
!	F(KK,IC) was taken out as DRFT is already in terms of the particle 
!	size class.
!WB	sed accum = sed accum (per storm) - fraction of particles in 
!WB	class i * sum of rainfall & detachment 
	IF (SEL(M).LT.0) SEL(M) = 0.

!	Below: accumulated sediment in each particle size class is calculated
	SEL2(M,IC)=SEL2(M,IC)-DRFT(IC)
	IF(SEL2(M,IC).LT.0.) SEL2(M,IC)=0.
!	Above, a check to make sure SEL2 does not fall below zero (not possible
!	as impervious area is not erodible).

*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)=DRFT(IC)
!	Again, F(kk,ic) is taken out b/c DRFT is already in terms of particle size class.
!WB	sednew = fraction of particles in class i * sum of rainfall & 
!WB	detach

	STNEW(IC)=S22(IC)/2.
!WB	new soil storage
!WB	this says that the new soil storage is equal to:
!WB	 [sed cont eqn + erosion w/rainfall & flow detach * (1/1+
!WB	 (flow/storage))] / 2
	GO TO 1290
!WB	this sends you down to the section on washload particle calculation
!WB	and then out the bottom of this subroutine
C
C..........MAXIMUM RAINFALL, PARTIAL FLOW DETACHMENT..........
C.....................NO DEPOSITION...........................
C
!WB	This is the section for when t.c.<detach cap, but not < rain detach

 1220 ZI2=TF(IC)*(1.+X4)-SST(M,IC)
!WB	 = trans cap * (1+storage/flow by volume) - sum of values 
!WB	in cont eqn
	SEL(M)=SEL(M)+SI(M,IC)-ZI2
!WB	 = sed accum + sed inflow - (rate of sed inflow + erosion at 
!WB	end of time increment)
	SEL2(M,IC)=SEL2(M,IC)+SI(M,IC)-ZI2
!	Above was inserted to keep account of the particle size distribution of 
!	the deposited sediment.

	IF (SEL(M).LT.0.) SEL(M)=0.
	IF (SEL2(M,IC).LT.0.) SEL2(M,IC)=0.

	SST(M,IC)=ZI2+TF(IC)*(X4-1.)
!WB	 cont eqn = (sed inflow + erosion) + t.c.(storage/flow -1)
C *** NRZ 
C *** CHANNEL ADDITION
	SE(IC)=TF(IC)
!WB	rate of sed movement from element = t.c.
C *** NRZ END
 
*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)=ZI2-SI(M,IC)
!WB	this newly generated sediment is equal to the transport capacity
!WB	times a scaling factor according to the flow minus the values 
!WB	in the sed. cont eqn minus the value of sed inflow

	STNEW(IC)=TF(IC)*X4/2.
!WB	this appears to say that the new soil storage is equal to the
!WB	transport capacity times (storage / flow) / 2
	GO TO 1290
!WB	this sends you down to the section on washload particle calculation
!WB	and then out the bottom of this subroutine
C
C..........DEPOSITION, NO FLOW DETACHMENT.....................
C
!WB	this is the section for when t.c.<SE1, and therefore there is
!WB	deposition
 1240    RE=FV(IC)*AREA/Q(M)
!WB	partial removal eff. during dep = fall velocity * area / flow
!WB	this says that the partial removal variable is equal to the 
!WB	fall velocity of the particle size class * catchment AREA 
!WB	as a sum of element areas, ha / outflow from element i at start
!WB	of time increments (m3/s)
	IF(RE.GT.1.) RE=1.
!WB	if that removal efficiency is greater than 1 (more than 
!WB	everything deposits), then set it equal to total removal
	
      DP=RE*(SE1(IC)-TF(IC))
!WB	dep rate = remov eff (rainfall detachment - t.c.)
	DEPPREV(M)=DP
!WB	IF THERE IS DEPOSITION IN A CHANNEL CELL, THEN THIS VARIABLE IS
!WB	USED TO ADJUST THE ERODED DEPTH INCREMENT.  SEE DEPTHINC ABOVE
C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=SE1(IC)-DP
!WB	sed movement from cell = rainfall detachment - deposition rate
	ZI2=SE(IC)*(1.+X4)-SST(M,IC)
!WB	sed. inflow & erosion = sed. movement * (1+storage/flow) - cont eqn
	IF(ZI2.LT.0.) ZI2=0.
	SEL(M)=SEL(M)+SI(M,IC)-ZI2
!WB	sed accum = accum + sed inflow - inflow + erosion
	SEL2(M,IC)=SEL2(M,IC)+SI(M,IC)-ZI2
!	Above was added to keep track of particle size distribution of 
!	deposited sediment.
	SST(M,IC)=ZI2+SE(IC)*(X4-1.)
!WB	cont eqn = sed. inflow & erosion + sed. movement * 
!WB	 (storage/flow - 1)

*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)= 0. !PRTCLSSEL(M,IC)*DETR(IC)
!	Changed F(kk,ic) to PRTCLSSEL(M,IC) because F has no meaning for urban cells.
!WB	 = fraction in size class * det. rate by rainfall

	STNEW(IC)=SE(IC)*X4/2.
!WB	new soil in storage = sed movement * (storage / 2*flow)
C *** NRZ END

 

C *** NRZ
C *** CHANNEL ADDITION
 1290    IF(SE(IC).LT.0.) SE(IC)=0.
!WB	if sediment exiting less than 0, set it = 0
C *** NRZ END
	IF(SST(M,IC).LT.0.) SST(M,IC)=0.
!WB	if cont eqn < 0 , it = 0
	IF (SEL2(M,IC).LT.0.) SEL2(M,IC)=0.
	IF (SEL(M).LT.0.) SEL(M)=0.
!	Above is a general error check.  SEL2 should not fall below 0 for an urban
!	cell anyway, but this just makes sure.
 1300  CONTINUE
      IF(NWASH.EQ.0) GO TO 1410
!WB	 # of particles in washload equals 0
C
C....WASH LOAD CALCULATIONS..................................
C
 1310 CONTINUE
      DO 1400 IC=1,NWASH
	DS=SI(M,IC)+DRFT(IC)
!	F(KK,IC) eliminated because already part of DRFT(IC)
!WB	max rate of inflow & erosion in an element = sed. inflow + size 
!WB	fraction * (sum of flow & rainfall detach)

	S2=(SST(M,IC)+DS)*X2
!WB	 = (cont eqn + max inflow & erosion) * ( 1/(1+flow/storage))
C *** NRZ
C *** CHANNEL ADDITION
	SE(IC)=S2*X1
!WB	sed movement = S2 * flow / storage
	SST(M,IC)=DS-SE(IC)+S2
!WB	cont eqn = max inflow & erosion - sed leaving + S2
	IF(SST(M,IC).LT.0.)SST(M,IC)=0.
!WB	if cont eqn < 0, then set it = 0
	SEL(M)=SEL(M)-DRFT(IC)
!	F(KK,IC) removed because already a part of DRFT.  DRFT replaces
!	(DETR+DETF) because they are equivalent.
!WB	sed accum = sed accum - size fraction * (rainfall + flow detach)

	SEL2(M,IC)=SEL2(M,IC)-DRFT(IC)
!	Above inserted to keep track of particle size distribution
!	of deposited sediment.

	IF (SEL(M).LT.0.) SEL(M) = 0.
	IF (SEL2(M,IC).LT.0.) SEL2(M,IC) = 0.

 
*DETERMING THE NEWLY GENERATED SEDIMENT
	SEDNEW(M,IC)=DRFT(IC)
!	F(KK,IC) removed because already part of DRFT
!WB	sednew = size fraction * total detach
	STNEW(IC)=S2/2.
!WB	STORAGE new = S2/2


 1400 CONTINUE
 1410 CONTINUE
 1000 FORMAT ('RILL WIDTH EXCEEDS RILL SPACING AT: ',/,
     1I4,' RILL WIDTH ',F5.3,' RILLSPACING ',F5.3
     2,/,'  PLEASE CHANGE THE RILL SPACING.')
 1002 FORMAT ('THE MANNINGS N FOR CHANNEL SOILS EXCEEDS'  
	1,/,' THE VALUE FOR SOIL + VEGETATION.  PLEASE CHANGE THIS.')
 1004 FORMAT ('FLOW-DEPTH CALCULATED MORE THAN 10,000 TIMES AND'
	1,/,' DOES NOT APPEAR TO CONVERGE.  PLEASE CONTACT ANSWERS'
	2,/,' ASSISTANCE FOR HELP.  THE ERROR OCCURRED AT:'
	3,/,' CELL #: ',I5,' QEFF =',F12.8,' RILLWID =',F6.3,' SL(M)=',
	4F5.3,/,' DWSOIL =',F5.3,' FLDEPOLD =',F6.3)
 1006 FORMAT ('THE FLOWDEPTH IS NEGATIVE.',' M =',I3,' FOFD =',F11.6
	1,/,' FPOFD =',F11.6,' FDPOFD =',F11.6,' FLOWDEP =',F11.6
     2,/,' FLOWDEPOLD =',F11.6,' RILLWID =',F11.6,'QEFF=',F11.6
     3,/,' SL =',F5.3,' DWSOIL =',F6.3,' DIFF = ',F11.6
	4,/,' IF YOU RECEIVE THIS MESSAGE, PLEASE CONTACT ANSWERS'
     5,/,' SUPPORT AND PROVIDE THE INFORMATION ON THIS SCREEN.')   
 1008	FORMAT ('AN ERROR HAS OCCURRED AND THE PROGRAM HAS STOPPED'
	1,/,' ACTUAL RILL DETACHMENT EXCEEDS CAPACITY'
	2,/,' ACTUAL DETACHMENT =',F11.7,' AT CELL: ',I3,' FOR PARTICLE'
	3,/,' CLASS :',I3,' WHILE CAPACITY EQUALS: ',F11.7)
	

	RETURN
!************************************************************************************************
!	Sediment initialization scheme - this is to calculate values for SSA, SSAT, and F for 
!	each cell every day, based on the sediment on the cell.
!************************************************************************************************
50	CONTINUE
	
	ISOIL=SOIL(M)/256

	DO I=1,NPART
		SEL2T(ISOIL)=SEL2T(ISOIL)+SEL2(M,I)
		SOIVOL(ISOIL)=SOIVOL(ISOIL)+SEL2(M,I)*DT
		!soivol is used in atmdeposition calculations later; it is equal to the mass of soil
		!on the element; sel2 is in kg/s, so multiply by dt (s) to get into kg soil.
	END DO
	
	IF(SEL2T(ISOIL).LE.0) THEN
		SEL2T(ISOIL)=0
		DO I=1,NPART
			SSAT(ISOIL)=0.
			F(ISOIL,I)=0.
		END DO
!		GO TO 60
	ELSE
	DO I=1,NPART
		F(ISOIL,I)=SEL2(M,I)/SEL2T(ISOIL)
		SSAT(ISOIL)=F(ISOIL,I)*SSA(ISOIL,I)+SSAT(ISOIL)
	END DO

	DO 88 I=1,NPART
	  SSA(ISOIL,I)=SSA(ISOIL,I)*F(ISOIL,I)
	  SASA=SASA+SSA(ISOIL,I)
   88 CONTINUE
	DO 82 I=1,NPART
	 SSA(ISOIL,I)=SSA(ISOIL,I)*SSAT(ISOIL)/SASA
   82 CONTINUE
	END IF



!	DO 88 loop is copied from the main program, resets SSA to the value used in the rest of the 
!	program.
!	The sediment initialization continues into the next segment of the subroutine because
!	of positioning in the main program.
!************************************************************************************************
!	Calculations for sediment bound nutrients
!************************************************************************************************
!60	CONTINUE

	ISOIL= SOIL(M)/256 
!WB	 ISOIL = soil type of element M 
	IF(SSAT(ISOIL).LE.0.) THEN
		PSSA=0.
		ANPSSA=0.
		ONPSSA=0.
		GO TO 32
	END IF

	IF (SOIVOL(ISOIL).EQ.0.) THEN
		PSSA = P0SOIL(M)/SSAT(ISOIL)
	ELSE
		PSSA=(P0SOIL(M)+(P0ADD(M)/SOIVOL(ISOIL)))/SSAT(ISOIL) 
!WB    sediment bound P conc. = (original P mass +(atmdep p/soivol)) / total specific surface area
	END IF

	IF (SOIVOL(ISOIL).EQ.0.) THEN
		ANPSSA=A0SOIL(M)/SSAT(ISOIL)
	ELSE
!RZ	I think A0 and O0 soil are in kg nutrient/kg soil
		ANPSSA=(A0SOIL(M)+(A0ADD(M)/SOIVOL(ISOIL)))/SSAT(ISOIL) 
	END IF

	IF (SOIVOL(ISOIL).EQ.0.) THEN
		ONPSSA = O0SOIL(M)/SSAT(ISOIL)
	ELSE
!WB	 = sed. bound ammonium soil conc.
		ONPSSA=(O0SOIL(M)+(O0ADD(M)/SOIVOL(ISOIL)))/SSAT(ISOIL) 
!WB	 = sed. bound org-N conc.
	END IF

   32	DO 33 IC=1,NPART 
!WB	 do from counter IC = 1 to # of particle size classes

		IF(F(ISOIL,IC).LE.0.) THEN
			P0(M,IC)=0.
			AN0(M,IC)=0.
			ON0(M,IC)=0.
			ERP(IC)=0.
			STOLD(M,IC)=0.
			STNEW(IC)=0.
			ANPT(M,IC)=0. 
			PPT(M,IC)=0. 
			ONPT(M,IC)=0. 
			ANI(M,IC)=0.
			PI(M,IC)=0.
			ONI(M,IC)=0.
			GO TO 33
		END IF
!	above is a check to make sure there are no divide by zeros

	 P0(M,IC)=SSA(ISOIL,IC)*PSSA/F(ISOIL,IC)
!rwz looks like phosphorus per particle size class
	 AN0(M,IC)=SSA(ISOIL,IC)*ANPSSA/F(ISOIL,IC) 
!rwz looks like nitrate per particle size class
	 ON0(M,IC)=SSA(ISOIL,IC)*ONPSSA/F(ISOIL,IC)
!rwz looks like organic nitrogen per particle size class
	 ERP(IC)=0.
!rwz not used in program; from faycal's dissertation,=P enrichment ratio
	 STOLD(M,IC)=0. 
!WB	 SEDIMENT STORAGE AT PREVIOUS TIME STEP
	 STNEW(IC)=0. 
!WB	 SEDIMENT STORAGE AT THIS TIME STEP 

	 ANPT(M,IC)=0. 
	 PPT(M,IC)=0. 
	 ONPT(M,IC)=0. 
!RZ	see faycal's dissertation: sum of the initial values of the nutrient 
!RZ	specie under consideration

	 ANI(M,IC)=0.
	 PI(M,IC)=0.
	 ONI(M,IC)=0.
!RZ	inflowing value for each nutrient

** NRZ 9/23/94

   33 CONTINUE

	 T12=0.0
	 T13(M)=0.0
 
      KK=SOIL(M)/256 
!WB	soil type of current element = 
!RZ	this is an integer, so if you look at soil(m), this gives the soil
!RZ	type because the remainder, rotation number, is truncated 
      rbit0(m)=0. 
!WB	unknown
      tpon(m)=0. 
!WB	equiv. time to ponding, time to infiltrate cum. ponding under 
!WB	ponded conditions
      timpon(m)=0. 
!WB	time to ponding (min)
      testi(m)=0.
!WB	flag indicating ponding

	RETURN
!************************************************************************************************
!	Adjust soluble nutrient calculations.  The nutrient inflow is set to the nutrient outflow.
!************************************************************************************************
70	CONTINUE
	
	IF (Q(M).GT.0.0) THEN
	OUTNH4(M)=AINH4(M)+STONH4(M)
	SP2(M)=SPI(M)+SPSP(M)
	OUTNO3(M)=AINO3(M)+STONO3(M)
	STONH4(M)=0.
	SPSP(M)=0.
	STONO3(M)=0.
	AINH4(M)=0.
	SPI(M)=0.
	AINO3(M)=0.
	ELSE
	OUTNH4(M)=0.
	STONH4(M)=AINH4(M)
	SP2(M)=0.
      SPSP(M)=SPI(M)
	OUTNO3(M)=0.
      STONO3(M)=AINO3(M)
	END IF

	RETURN
!	Finally! The end of the urbanized subroutine!  Aren't you excited?
	
	END
