Skip to content

Commit 01b4741

Browse files
HishamEldardiryHishamEldardiry
authored
Add files via upload
1 parent d502e4f commit 01b4741

25 files changed

Lines changed: 8606 additions & 0 deletions

‎routing/input/fluxes_45.2500_45.0000‎

Lines changed: 1827 additions & 0 deletions
Large diffs are not rendered by default.

‎routing/input/fluxes_45.3750_45.1250‎

Lines changed: 1827 additions & 0 deletions
Large diffs are not rendered by default.

‎routing/model/Makefile‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
########################################################################
2+
### rout.f makefile ####################################################
3+
########################################################################
4+
#
5+
# Routing algorithm written D. Lohmann
6+
#
7+
# This is a slightly modified code (main algotrithms unchanged -IO and
8+
# array dimensions simplified).
9+
# Maintained by G. O'Donnell (tempgd@hydro.washington.edu) and Andy Wood
10+
#
11+
# $Id: Makefile,v 1.1 2005/04/07 05:07:28 vicadmin Exp $
12+
#
13+
14+
#This program uses the non-standard Fortran argument GETARG
15+
#Different compilers require different flags to link with this function
16+
#Comment out one of the following depending on your compiler
17+
18+
#If compiling on SUN and LINUX use (remember -O)
19+
#FFLAGS = -O -C -ffixed-line-length-none -mcmodel=medium
20+
#CFLAGS = -g -Wall
21+
#If compiling on MacOS (remember -L)
22+
FFLAGS = -O -C -ffixed-line-length-none -L /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib
23+
#If compiling on HP use
24+
#FFLAGS = -C -O +U77 -ffixed-line-length-none
25+
#for debugging
26+
#FFLAGS = -C -g -lm -ffixed-line-length-none
27+
28+
FC= gfortran -m64
29+
30+
31+
HFILES= parameter.h
32+
33+
OBJECTS= rout.o \
34+
reservoir.o \
35+
write_routines.o \
36+
unit_hyd_routines.o \
37+
init_routines.o
38+
39+
40+
exe: $(OBJECTS)
41+
$(FC) $(FFLAGS) $(OBJECTS) -o rout
42+
43+
rout.o: rout.f
44+
reservoir.o: reservoir.f
45+
write_routines.o: write_routines.f
46+
unit_hyd_routines.o: unit_hyd_routines.f
47+
init_routines.o: init_routines.f
48+
49+
50+
clean:
51+
rm -fr rout *.o core
52+
.f.o :
53+
${FC} ${INC} ${FFLAGS} -c $<
54+

‎routing/model/init_routines.f‎

Lines changed: 214 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,214 @@
1+
c SUBROUTINES FOR INITIALIZATION (roughly)
2+
3+
C************************************************************************************************************************************************************************************
4+
C ARRAY INITIALIZATION
5+
C************************************************************************************************************************************************************************************
6+
7+
SUBROUTINE INIT_ARRAY( A, NROW, NCOL, VALUE )
8+
C Initialiase float array A to VALUE
9+
IMPLICIT NONE
10+
c RCS ID STRING
11+
CHARACTER*50 RCSID
12+
c DATA RCSID/"$Id: init_routines.f,v 1.1 2005/04/07 05:07:28 vicadmin Exp $"/
13+
INTEGER NCOL, NROW
14+
INTEGER I, J
15+
REAL A(NCOL,NROW)
16+
REAL VALUE
17+
DO J=1, NROW
18+
DO I=1, NCOL
19+
A(I,J)=VALUE
20+
END DO
21+
END DO
22+
RETURN
23+
END
24+
25+
C************************************************************************************************************************************************************************************
26+
C CREATE VIC NAMES
27+
C************************************************************************************************************************************************************************************
28+
29+
SUBROUTINE CREATE_VIC_NAMES( JLOC, ILOC, EXTEN, CLEN, DPREC )
30+
c create string containing vic file names to be
31+
c appended to path given in input file
32+
c filenames allowed a maximum of 5 decimal places
33+
IMPLICIT NONE
34+
CHARACTER*10 JICHAR(2)
35+
CHARACTER*20 EXTEN
36+
REAL JLOC, ILOC
37+
INTEGER NSPACE, CLEN, CLEN_OLD, DPREC, I
38+
WRITE(JICHAR(1),'(F10.5)')JLOC
39+
WRITE(JICHAR(2),'(F10.5)')ILOC
40+
CLEN_OLD=1
41+
DO I=1,2
42+
NSPACE=1
43+
5 IF(JICHAR(I)(NSPACE:NSPACE).EQ.' ')THEN
44+
NSPACE=NSPACE+1
45+
GOTO 5
46+
ENDIF
47+
CLEN=CLEN_OLD+11-NSPACE-5+DPREC
48+
EXTEN(CLEN_OLD:CLEN)=JICHAR(I)(NSPACE:5+DPREC)
49+
IF(I.EQ.1)THEN
50+
EXTEN(CLEN:CLEN)='_'
51+
ENDIF
52+
CLEN_OLD=CLEN+1
53+
END DO
54+
CLEN=CLEN-1 ! Character Length
55+
RETURN
56+
END
57+
58+
C************************************************************************************************************************************************************************************
59+
C READ RESERVOIR LOCATION - THIS SUBROUTINE READS THE RESERVOIR MATRIX
60+
C************************************************************************************************************************************************************************************
61+
62+
SUBROUTINE READ_RESE(RESER,ICOL,IROW,NCOL,NROW,RFILENAME,NRESER)
63+
IMPLICIT NONE
64+
INTEGER IROW, ICOL
65+
INTEGER I,J
66+
CHARACTER*72 RFILENAME
67+
INTEGER NROW, NCOL
68+
INTEGER RESER(NCOL,NROW),VALID_RESERS(10000)
69+
INTEGER NRESER
70+
INTEGER NVALID, VAL
71+
OPEN(11, FILE = RFILENAME,FORM = 'FORMATTED',
72+
$ STATUS='OLD',ERR=9001)
73+
DO J = IROW,1,-1
74+
READ(11,*) (RESER(I,J), I=ICOL,1,-1)
75+
END DO
76+
CLOSE(11)
77+
NVALID = 0 ! added to avoid counting the reservoir area with 9999 as reservoir location
78+
DO J = 1, NROW
79+
DO I = 1, NCOL
80+
VAL = RESER(I,J)
81+
IF (VAL .GT. 0 .AND. VAL .NE. 9999) THEN
82+
NVALID = NVALID + 1
83+
VALID_RESERS(NVALID) = VAL
84+
END IF
85+
END DO
86+
END DO
87+
IF (NVALID .GT. 0) THEN
88+
NRESER = MAXVAL(VALID_RESERS(1:NVALID))
89+
ELSE
90+
NRESER = -1 ! or 0, or some error flag
91+
PRINT *, 'WARNING: No valid reservoir values found.'
92+
END IF
93+
print*,'Number of Reservoirs in the reservoir location file=',NRESER
94+
RETURN
95+
9001 WRITE(*,*) 'CANNOT OPEN RESERVOIR LOCATION FILE'
96+
STOP
97+
END
98+
99+
C************************************************************************************************************************************************************************************
100+
C LIMIT CALCULATION BOUNDARY - THIS SUBROUTING FILTERS CELLS WHICH DO NOT CONTRIBUTE TO THE FLOW AT THE BASIN OUTLET
101+
C************************************************************************************************************************************************************************************
102+
103+
SUBROUTINE SEARCH_WHOLECATCHMENT
104+
& (PI,PJ,DIREC,NCOL,NROW,NO_OF_BOX,CATCHIJ,PMAX,
105+
$ IROW,ICOL,NORESERVOIRS,RES_DIRECT,RESER,NRESER_MAX)
106+
IMPLICIT NONE
107+
INTEGER PI,PJ,I,J,NCOL,NROW,PMAX,ICOL,IROW,NRESER_MAX,N
108+
INTEGER II,JJ,III,JJJ,K
109+
INTEGER DIREC(NCOL,NROW,2)
110+
INTEGER NO_OF_BOX(NRESER_MAX)
111+
INTEGER CATCHIJ(PMAX,2,NRESER_MAX)
112+
INTEGER NORESERVOIRS
113+
INTEGER RES_DIRECT(NRESER_MAX,3)
114+
INTEGER RESER(NCOL,NROW)
115+
INTEGER CELL_OF_RES
116+
NORESERVOIRS = 0
117+
NORESERVOIRS = NORESERVOIRS + 1
118+
RES_DIRECT(NORESERVOIRS,1) = NORESERVOIRS
119+
NO_OF_BOX(NORESERVOIRS) = 0
120+
CELL_OF_RES = 0
121+
DO I = 1, ICOL
122+
DO J = 1, IROW
123+
II = I
124+
JJ = J
125+
300 CONTINUE
126+
IF ((II .GT. ICOL) .OR. (II .LT.1) .OR.
127+
& (JJ .GT. IROW) .OR. (JJ .LT.1)) THEN
128+
GOTO 310
129+
END IF
130+
IF ((II .EQ. PI) .AND. (JJ .EQ. PJ)) THEN
131+
NO_OF_BOX(NORESERVOIRS) = NO_OF_BOX(NORESERVOIRS) + 1
132+
CATCHIJ(NO_OF_BOX(NORESERVOIRS),1,NORESERVOIRS) = I
133+
CATCHIJ(NO_OF_BOX(NORESERVOIRS),2,NORESERVOIRS) = J
134+
GOTO 310
135+
ELSE
136+
IF ((DIREC(II,JJ,1).NE.0) .AND.
137+
& (DIREC(II,JJ,2) .NE.0)) THEN
138+
III = DIREC(II,JJ,1)
139+
JJJ = DIREC(II,JJ,2)
140+
II = III
141+
JJ = JJJ
142+
GOTO 300
143+
END IF
144+
END IF
145+
310 CONTINUE
146+
IF ((RESER(I,J)>0) .AND. (II .EQ. PI) .AND. (JJ .EQ. PJ)
147+
& .AND. (RESER(I,J) .NE. 9999)) THEN
148+
RES_DIRECT(NORESERVOIRS,1) = RESER(I,J)
149+
NORESERVOIRS = NORESERVOIRS + 1
150+
CELL_OF_RES = 0
151+
RES_DIRECT(NORESERVOIRS,1) = NORESERVOIRS
152+
NO_OF_BOX(NORESERVOIRS) = NO_OF_BOX(NORESERVOIRS-1) ! NOB equal to previous step so we can use it for cumulative addition in line 116
153+
NO_OF_BOX(NORESERVOIRS-1) = 0 ! previous NOB equal to zero (since it is alread yassigned to current step) --> This means NOB is a zeros vector except the last element = NORESERVOIRS
154+
DO K = 1, NO_OF_BOX(NORESERVOIRS)
155+
CATCHIJ(K,1,NORESERVOIRS) = CATCHIJ(K,1,NORESERVOIRS-1) ! Same as NOB, all layers of NORESERVOIRS in CATCHIJ will be equal to zeros except the last NORESERVOIRS
156+
CATCHIJ(K,2,NORESERVOIRS) = CATCHIJ(K,2,NORESERVOIRS-1) ! This is something that can be changed because no need to have the dimension NORESERVOIRS in the matrix CATCHIJ
157+
CATCHIJ(K,1,NORESERVOIRS-1) = 0
158+
CATCHIJ(K,2,NORESERVOIRS-1) = 0
159+
END DO
160+
END IF
161+
END DO
162+
END DO
163+
WRITE(*,*) 'Number of grid cells', no_of_box(NORESERVOIRS) ! NOB is a zeros vector except the last element = NORESERVOIRS
164+
RETURN
165+
END
166+
C************************************************************************************************************************************************************************************
167+
C Generate simulation dates (instead of reading from fluxes)
168+
C************************************************************************************************************************************************************************************
169+
SUBROUTINE GENERATE_DATES(start_year, start_month, stop_year, stop_month, IIYEAR, IIMONTH, IIDAY, NDAY,DAYS)
170+
IMPLICIT NONE
171+
INTEGER start_year, start_month, stop_year, stop_month,DAYS
172+
INTEGER IIYEAR(DAYS), IIMONTH(DAYS), IIDAY(DAYS)
173+
INTEGER NDAY
174+
175+
INTEGER year, month, day, days_in_month
176+
177+
NDAY = 0
178+
year = start_year
179+
month = start_month
180+
181+
DO WHILE (year < stop_year .OR. (year == stop_year .AND. month <= stop_month))
182+
SELECT CASE (month)
183+
CASE (1,3,5,7,8,10,12)
184+
days_in_month = 31
185+
CASE (4,6,9,11)
186+
days_in_month = 30
187+
CASE (2)
188+
IF ((MOD(year,4) == 0 .AND. MOD(year,100) /= 0) .OR. MOD(year,400) == 0) THEN
189+
days_in_month = 29
190+
ELSE
191+
days_in_month = 28
192+
END IF
193+
END SELECT
194+
195+
DO day = 1, days_in_month
196+
NDAY = NDAY + 1
197+
IIYEAR(NDAY) = year
198+
IIMONTH(NDAY) = month
199+
IIDAY(NDAY) = day
200+
END DO
201+
202+
month = month + 1
203+
IF (month > 12) THEN
204+
month = 1
205+
year = year + 1
206+
END IF
207+
END DO
208+
209+
210+
END SUBROUTINE GENERATE_DATES
211+
212+
C************************************************************************************************************************************************************************************
213+
C END OF FILE
214+
C************************************************************************************************************************************************************************************

‎routing/model/init_routines.o‎

7.41 KB
Binary file not shown.

0 commit comments

Comments
 (0)