-
Notifications
You must be signed in to change notification settings - Fork 3
/
modules.f90
executable file
·181 lines (138 loc) · 5.94 KB
/
modules.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
!***************************************************************
! Copyright (c) 2017 Battelle Memorial Institute
! Licensed under modified BSD License. A copy of this license can be
! found in the LICENSE file in the top level directory of this
! distribution.
!***************************************************************
!
! NAME: modules
!
! VERSION and DATE: MASS1 v0.75 3/25/1998
!
! PURPOSE: contains all module-level variable declarations
!
! RETURNS: void
!
! REQUIRED:
!
! LOCAL VARIABLES:
!
! COMMENTS:
!
!
! MOD HISTORY:
! changed maxlevels to 1500 from 1000; mcr 10/16/1997
! added variables for bed shear, friction slope, froude number,
! top width - enhanced output; mcr 11/21/1997
! added variables for uniform lateral inflows; mcr 3/25/98
!
!
!***************************************************************
! CVS ID: $Id$
! Last Change: Mon Feb 21 11:54:55 2011 by William A. Perkins <[email protected]>
!----------------------------------------------------------
MODULE general_vars
DOUBLE PRECISION, SAVE :: time,time_begin,time_end,delta_t,time_mult,time_step
INTEGER, SAVE :: units, channel_length_units
INTEGER, SAVE :: time_units,debug_print
INTEGER, SAVE :: maxlinks,maxpoint,scalar_steps
INTEGER, SAVE :: dsbc_type
DOUBLE PRECISION, SAVE :: res_coeff,grav
DOUBLE PRECISION, SAVE :: unit_weight_h2o,density_h2o
DOUBLE PRECISION, SAVE :: depth_threshold, depth_minimum
INTEGER, SAVE :: print_freq
END MODULE general_vars
!------------------------------------------------------------------
MODULE date_vars
INTEGER, SAVE :: time_option
CHARACTER (LEN=10) :: date_string, date_run_begins, date_run_ends
CHARACTER (LEN=8) :: time_string, time_run_begins, time_run_ends
END MODULE date_vars
!----------------------------------------------------------
MODULE logicals
LOGICAL, SAVE :: do_flow,do_gas,do_temp,do_printout,do_gageout,do_profileout
LOGICAL, SAVE :: do_restart,do_hotstart
LOGICAL, SAVE :: temp_diffusion, temp_exchange
LOGICAL, SAVE :: gas_diffusion, gas_exchange
LOGICAL, SAVE :: print_sections
LOGICAL, SAVE :: do_latflow
LOGICAL, SAVE :: do_accumulate
END MODULE logicals
!----------------------------------------------------------
MODULE file_vars
CHARACTER (LEN = 100), SAVE :: filename(20)
INTEGER, SAVE :: ii,fileunit(20) = (/(ii,ii=20,39)/)
END MODULE file_vars
!-----------------------------------------------------
!----------------------------------------------------------
MODULE link_vars
INTEGER, DIMENSION(:),ALLOCATABLE, SAVE :: maxpoints,linkname,linkorder,comporder,linktype,input_option
INTEGER, DIMENSION(:),ALLOCATABLE, SAVE :: linkbc_table,num_con_links,ds_conlink,&
& dsbc_table, transbc_table, tempbc_table, &
&latflowbc_table, lattransbc_table, lattempbc_table
INTEGER, DIMENSION(:),ALLOCATABLE, SAVE :: met_zone
INTEGER, DIMENSION(:,:),ALLOCATABLE, SAVE :: con_links
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE :: crest
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE :: lpiexp
END MODULE link_vars
!----------------------------------------------------------
MODULE point_vars
DOUBLE PRECISION, DIMENSION(:,:),ALLOCATABLE, SAVE :: x, q,thalweg,y,manning,vel,kstrick
DOUBLE PRECISION, DIMENSION(:,:),ALLOCATABLE, SAVE :: area, area_old, q_old,y_old,k_diff
DOUBLE PRECISION, DIMENSION(:,:),ALLOCATABLE, SAVE :: top_width, hyd_radius, froude_num, friction_slope, bed_shear
DOUBLE PRECISION, DIMENSION(:,:),ALLOCATABLE, SAVE :: lateral_inflow, lateral_inflow_old
DOUBLE PRECISION, DIMENSION(:,:),ALLOCATABLE, SAVE :: courant_num, diffuse_num
INTEGER, DIMENSION(:,:),ALLOCATABLE, SAVE :: section_number
END MODULE point_vars
!----------------------------------------------------------
! global data module for cross section variables
!
MODULE section_vars
INTEGER, PARAMETER :: maxpairs=1000,maxlevels=3500
INTEGER, SAVE :: total_sections
INTEGER, DIMENSION(:),ALLOCATABLE, SAVE :: section_id,section_type
DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE, SAVE :: &
&bottom_width,bottom_width_flood,depth_main
DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE, SAVE :: delta_y,sect_levels
DOUBLE PRECISION, DIMENSION(:,:),ALLOCATABLE, SAVE :: &
§_area,sect_hydradius,sect_depth,sect_width,sect_convey,sect_perm
CONTAINS
! ----------------------------------------------------------------
! SUBROUTINE allocate_section_vars
! ----------------------------------------------------------------
SUBROUTINE allocate_section_vars()
IMPLICIT NONE
INTEGER :: maxsections
maxsections = total_sections
ALLOCATE(section_id(maxsections))
ALLOCATE(section_type(maxsections))
ALLOCATE(delta_y(maxsections))
ALLOCATE(sect_levels(maxsections))
ALLOCATE(bottom_width(maxsections))
ALLOCATE(bottom_width_flood(maxsections))
ALLOCATE(depth_main(maxsections))
ALLOCATE(sect_area(maxsections,maxlevels))
ALLOCATE(sect_hydradius(maxsections,maxlevels))
ALLOCATE(sect_depth(maxsections,maxlevels))
ALLOCATE(sect_width(maxsections,maxlevels))
ALLOCATE(sect_convey(maxsections,maxlevels))
ALLOCATE(sect_perm(maxsections,maxlevels))
END SUBROUTINE allocate_section_vars
END MODULE section_vars
!----------------------------------------------------------
MODULE flow_coeffs
DOUBLE PRECISION, DIMENSION(:,:),ALLOCATABLE, SAVE :: e,f,l,m,n
END MODULE flow_coeffs
!----------------------------------------------------------
MODULE fluvial_coeffs
! REAL, SAVE :: alpha=1.0,beta=0.5,theta=1.0,q1,q2,a1,a2,b1,b2,k1,k2 &
! ,ky1,ky2,y2,y1
DOUBLE PRECISION, SAVE :: alpha=1.0,beta=0.5,theta=1.0,q1,q2,a1,a2,b1,b2,k1,k2,ky1,ky2,y2,y1
DOUBLE PRECISION, SAVE :: d1, d2, fr1, fr2
END MODULE fluvial_coeffs
!---------------------------------------------------------
MODULE transport_vars
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE, SAVE :: c,k_surf
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE, SAVE :: dxx
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE, SAVE :: temp
END MODULE transport_vars