|
| 1 | +module BGIN |
| 2 | +! |
| 3 | +implicit none |
| 4 | +! |
| 5 | +! Integer variables |
| 6 | +! |
| 7 | + integer:: nwpd |
| 8 | +! |
| 9 | +! Character variables |
| 10 | +! |
| 11 | + character (len=8) :: end_date,start_date |
| 12 | + character (len=8) :: lat |
| 13 | + character (len=10):: long |
| 14 | +! |
| 15 | +! Integer variables |
| 16 | +! |
| 17 | +integer:: start_year,start_month,start_day |
| 18 | +integer:: end_year,end_month,end_day |
| 19 | +integer:: head_name,trib_cell |
| 20 | +integer:: jul_start,main_stem,nyear1,nyear2,nc,ncell,nseg |
| 21 | +integer:: ns_max_test,nndlta,node,ncol,nrow,nr,cum_sgmnt |
| 22 | +! |
| 23 | +! Logical variables |
| 24 | +! |
| 25 | +logical:: first_cell,source |
| 26 | +! |
| 27 | +! Real variables |
| 28 | +! |
| 29 | + real :: rmile0,rmile1,xwpd |
| 30 | +! |
| 31 | + |
| 32 | +! |
| 33 | +contains |
| 34 | +! |
| 35 | +! |
| 36 | +Subroutine BEGIN(param_file,spatial_file) |
| 37 | +! |
| 38 | +use Block_Energy |
| 39 | +use Block_Hydro |
| 40 | +use Block_Network |
| 41 | +! |
| 42 | +implicit none |
| 43 | +! |
| 44 | + character (len=200):: param_file,source_file,spatial_file |
| 45 | + integer:: Julian |
| 46 | +! |
| 47 | +! |
| 48 | +! Mohseni parameters, if used |
| 49 | +! |
| 50 | +! |
| 51 | +! |
| 52 | +! Card Group I |
| 53 | +! |
| 54 | +read(90,*) start_date,end_date |
| 55 | +read(start_date,'(i4,2i2)') start_year,start_month,start_day |
| 56 | +read(end_date, '(i4,2i2)') end_year,end_month,end_day |
| 57 | +nyear1=start_year |
| 58 | +nyear2=end_year |
| 59 | +write(*,'(2(2x,i4,2i2))') & |
| 60 | + start_year,start_month,start_day,end_year,end_month,end_day |
| 61 | +! |
| 62 | +! Establish the Julian day for which simulations begin |
| 63 | +! |
| 64 | +jul_start = Julian(start_year,start_month,start_day) |
| 65 | +! |
| 66 | +read(90,*) nreach,flow_cells,heat_cells,source |
| 67 | +! |
| 68 | +! Allocate dynamic arrays |
| 69 | +! |
| 70 | + allocate(ndelta(heat_cells)) |
| 71 | + allocate(mu(nreach)) |
| 72 | + allocate(alphamu(nreach)) |
| 73 | + allocate(beta(nreach)) |
| 74 | + allocate(gmma(nreach)) |
| 75 | + allocate (smooth_param(nreach)) |
| 76 | + allocate(dx(heat_cells)) |
| 77 | + allocate(no_celm(nreach)) |
| 78 | + no_celm=0 |
| 79 | + allocate(no_cells(nreach)) |
| 80 | + no_cells=0 |
| 81 | + allocate(no_tribs(heat_cells)) |
| 82 | + no_tribs=0 |
| 83 | + allocate(trib(heat_cells,10)) |
| 84 | + trib=0 |
| 85 | + allocate(head_cell(nreach)) |
| 86 | + allocate(segment_cell(nreach,ns_max)) |
| 87 | + allocate(x_dist(nreach,0:ns_max)) |
| 88 | +! |
| 89 | +! Check to see if there are point source inputs |
| 90 | +! |
| 91 | +if (source) then |
| 92 | +! |
| 93 | + read(90,'(A)') source_file ! (WUR_WF_MvV_2011/05/23) |
| 94 | + print *,'source file: ', source_file ! (WUR_WF_MvV_2011/05/23) |
| 95 | + open(40,file=TRIM(source_file),status='old') |
| 96 | +! |
| 97 | +end if |
| 98 | +! |
| 99 | +! Start reading the reach date and initialize the reach index, NR |
| 100 | +! and the cell index, NCELL |
| 101 | +! |
| 102 | +ncell=0 |
| 103 | +! |
| 104 | +ns_max_test=-1 |
| 105 | +! |
| 106 | +! Card Group IIb. Reach characteristics |
| 107 | +! |
| 108 | +do nr=1,nreach |
| 109 | +! |
| 110 | +! Initialize NSEG, the total number of segments in this reach |
| 111 | +! |
| 112 | + nseg=0 |
| 113 | + write(*,*) ' Starting to read reach ',nr |
| 114 | +! |
| 115 | +! Read the number of cells in this reach, the headwater #, |
| 116 | +! the number of the cell where it enters the next higher order stream, |
| 117 | +! the headwater number of the next higher order stream it enters, and |
| 118 | +! the river mile of the headwaters. |
| 119 | +! |
| 120 | + read(90,'(i5,11x,i4,10x,i5,15x,i5,15x,f10.0,i5)') no_cells(nr) & |
| 121 | + ,head_name,trib_cell,main_stem,rmile0 |
| 122 | +! |
| 123 | +! If this is reach that is tributary to cell TRIB_CELL, give it the |
| 124 | +! pointer TRIB(TRIB_CELL) the index of this reach for further use. |
| 125 | +! Also keep track of the total number of tributaries for this cell |
| 126 | +! |
| 127 | + if (trib_cell.gt.0) then |
| 128 | + no_tribs(trib_cell)=no_tribs(trib_cell)+1 |
| 129 | + trib(trib_cell,no_tribs(trib_cell))=nr |
| 130 | + end if |
| 131 | +! |
| 132 | +! Reading Mohseni parameters for each headwaters (UW_JRY_2011/06/18) |
| 133 | +! |
| 134 | + read(90,*) alphaMu(nr),beta(nr) & |
| 135 | + ,gmma(nr),mu(nr),smooth_param(nr) |
| 136 | +! |
| 137 | +! Reading Reach Element information |
| 138 | +! |
| 139 | + first_cell=.true. |
| 140 | + do nc=1,no_cells(nr) |
| 141 | + ncell=ncell+1 |
| 142 | +! |
| 143 | +! Read the data for point sources |
| 144 | +! |
| 145 | + if (source) then |
| 146 | +! |
| 147 | +! Place holder for point source input |
| 148 | +! |
| 149 | + end if |
| 150 | +! |
| 151 | +! The headwaters index for each cell in this reach is given |
| 152 | +! in the order the cells are read |
| 153 | +! |
| 154 | +! Card Type 3. Cell indexing #, Node # Row # Column Lat Long RM |
| 155 | +! |
| 156 | +! Variable ndelta read in here. At present, number of elements |
| 157 | +! is entered manually into the network file (UW_JRY_2011/03/15) |
| 158 | +! |
| 159 | + read(90,'(5x,i5,5x,i5,8x,i5,6x,a8,6x,a10,7x,f10.0,i5)') & |
| 160 | + node,nrow,ncol,lat,long,rmile1,ndelta(ncell) |
| 161 | +! |
| 162 | +! Set the number of segments of the default, if not specified |
| 163 | +! |
| 164 | + if (ndelta(ncell).lt.1) ndelta(ncell)=n_default |
| 165 | + if(first_cell) then |
| 166 | + first_cell=.false. |
| 167 | + head_cell(nr)=ncell |
| 168 | + x_dist(nr,0)=5280.*rmile0 |
| 169 | + end if |
| 170 | +! |
| 171 | +! Added variable ndelta (UW_JRY_2011/03/15) |
| 172 | +! |
| 173 | + dx(ncell)=5280.*(rmile0-rmile1)/ndelta(ncell) |
| 174 | + rmile0=rmile1 |
| 175 | + nndlta=0 |
| 176 | +200 continue |
| 177 | + nndlta=nndlta+1 |
| 178 | + nseg=nseg+1 |
| 179 | + segment_cell(nr,nseg)=ncell |
| 180 | + x_dist(nr,nseg)=x_dist(nr,nseg-1)-dx(ncell) |
| 181 | +! |
| 182 | +! Write Segment List for mapping to temperature output (UW_JRY_2008/11/19) |
| 183 | +! |
| 184 | + open(22,file=TRIM(spatial_file),status='unknown') ! (changed by WUR_WF_MvV_2011/01/05) |
| 185 | + write(22,'(4i6,1x,a8,1x,a10,i5)') nr,ncell,nrow,ncol,lat,long,nndlta |
| 186 | +! |
| 187 | +! |
| 188 | +! |
| 189 | +! Added variable ndelta (UW_JRY_2011/03/15) |
| 190 | +! |
| 191 | + if(nndlta.lt.ndelta(ncell)) go to 200 |
| 192 | + no_celm(nr)=nseg |
| 193 | + segment_cell(nr,nseg)=ncell |
| 194 | + x_dist(nr,nseg)=5280.*rmile1 |
| 195 | +! |
| 196 | +! End of segment loop |
| 197 | +! |
| 198 | + end do |
| 199 | +if(ns_max_test.lt.nseg) ns_max_test=nseg |
| 200 | +! |
| 201 | +! End of reach loop |
| 202 | +! |
| 203 | +end do |
| 204 | +if(ns_max_test.gt.ns_max) then |
| 205 | + write(*,*) 'RBM is terminating because' |
| 206 | + write(*,*) 'NS_MAX exceeded. Change NS_MAX in Block_Network to: ',ns_max_test |
| 207 | + stop |
| 208 | +end if |
| 209 | +! |
| 210 | +nwpd=1 |
| 211 | +xwpd=nwpd |
| 212 | +dt_comp=86400./xwpd |
| 213 | +! |
| 214 | +! ****************************************************** |
| 215 | +! Return to RMAIN |
| 216 | +! ****************************************************** |
| 217 | +! |
| 218 | +900 continue |
| 219 | +! |
| 220 | +! |
| 221 | +end subroutine BEGIN |
| 222 | +! |
| 223 | + END Module BGIN |
|
0 commit comments