Changes in trunk/src/readreleases.f90 [20:27]
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/src/readreleases.f90
r20 r27 33 33 ! Update: 29 January 2001 * 34 34 ! Release altitude can be either in magl or masl * 35 ! HSO, 12 August 2013 36 ! Added optional namelist input 35 37 ! * 36 38 !***************************************************************************** … … 55 57 ! xpoint2,ypoint2 geograf. coordinates of upper right corner of release * 56 58 ! area * 57 ! weta, wetb parameters to determine the wet scavenging coefficient * 59 ! weta, wetb parameters to determine the below-cloud scavenging * 60 ! weta_in, wetb_in parameters to determine the in-cloud scavenging * 61 ! wetc_in, wetd_in parameters to determine the in-cloud scavenging * 58 62 ! zpoint1,zpoint2 height range, over which release takes place * 59 63 ! num_min_discrete if less, release cannot be randomized and happens at * … … 69 73 implicit none 70 74 71 integer :: numpartmax,i,j,id1,it1,id2,it2, specnum_rel,idum,stat75 integer :: numpartmax,i,j,id1,it1,id2,it2,idum,stat 72 76 integer,parameter :: num_min_discrete=100 73 77 real :: vsh(ni),fracth(ni),schmih(ni),releaserate,xdum,cun … … 76 80 logical :: old 77 81 82 ! help variables for namelist reading 83 integer :: numpoints, parts, readerror 84 integer*2 :: zkind 85 integer :: idate1, itime1, idate2, itime2 86 real :: lon1,lon2,lat1,lat2,z1,z2 87 character*40 :: comment 88 integer,parameter :: unitreleasesout=2 89 real,allocatable, dimension (:) :: mass 90 integer,allocatable, dimension (:) :: specnum_rel,specnum_rel2 91 92 ! declare namelists 93 namelist /releases_ctrl/ & 94 nspec, & 95 specnum_rel 96 97 namelist /release/ & 98 idate1, itime1, & 99 idate2, itime2, & 100 lon1, lon2, & 101 lat1, lat2, & 102 z1, z2, & 103 zkind, & 104 mass, & 105 parts, & 106 comment 107 108 numpoint=0 109 110 ! allocate with maxspec for first input loop 111 allocate(mass(maxspec),stat=stat) 112 if (stat.ne.0) write(*,*)'ERROR: could not allocate mass' 113 allocate(specnum_rel(maxspec),stat=stat) 114 if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel' 115 116 ! presetting namelist releases_ctrl 117 nspec = -1 ! use negative value to determine failed namelist input 118 specnum_rel = 0 119 78 120 !sec, read release to find how many releasepoints should be allocated 79 80 open(unitreleases,file=path(1)(1:length(1))//'RELEASES',status='old', & 81 err=999) 82 83 ! Check the format of the RELEASES file (either in free format, 84 ! or using a formatted mask) 85 ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION' 86 !************************************************************************** 87 88 call skplin(12,unitreleases) 89 read (unitreleases,901) line 90 901 format (a) 91 if (index(line,'Total') .eq. 0) then 92 old = .false. 93 else 94 old = .true. 95 endif 121 open(unitreleases,file=path(1)(1:length(1))//'RELEASES',status='old',form='formatted',err=999) 122 123 ! check if namelist input provided 124 read(unitreleases,releases_ctrl,iostat=readerror) 125 126 ! prepare namelist output if requested 127 if (nmlout.eqv..true.) then 128 open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist',access='append',status='new',err=1000) 129 endif 130 131 if ((readerror.ne.0).or.(nspec.lt.0)) then 132 133 ! no namelist format, close file and allow reopening in old format 134 close(unitreleases) 135 open(unitreleases,file=path(1)(1:length(1))//'RELEASES',status='old',err=999) 136 137 readerror=1 ! indicates old format 138 139 ! Check the format of the RELEASES file (either in free format, 140 ! or using a formatted mask) 141 ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION' 142 !************************************************************************** 143 144 call skplin(12,unitreleases) 145 read (unitreleases,901) line 146 901 format (a) 147 if (index(line,'Total') .eq. 0) then 148 old = .false. 149 else 150 old = .true. 151 endif 152 rewind(unitreleases) 153 154 155 ! Skip first 11 lines (file header) 156 !********************************** 157 158 call skplin(11,unitreleases) 159 160 read(unitreleases,*,err=998) nspec 161 if (old) call skplin(2,unitreleases) 162 do i=1,nspec 163 read(unitreleases,*,err=998) specnum_rel(i) 164 if (old) call skplin(2,unitreleases) 165 end do 166 167 numpoint=0 168 100 numpoint=numpoint+1 169 read(unitreleases,*,end=25) 170 read(unitreleases,*,err=998,end=25) idum,idum 171 if (old) call skplin(2,unitreleases) 172 read(unitreleases,*,err=998) idum,idum 173 if (old) call skplin(2,unitreleases) 174 read(unitreleases,*,err=998) xdum 175 if (old) call skplin(2,unitreleases) 176 read(unitreleases,*,err=998) xdum 177 if (old) call skplin(2,unitreleases) 178 read(unitreleases,*,err=998) xdum 179 if (old) call skplin(2,unitreleases) 180 read(unitreleases,*,err=998) xdum 181 if (old) call skplin(2,unitreleases) 182 read(unitreleases,*,err=998) idum 183 if (old) call skplin(2,unitreleases) 184 read(unitreleases,*,err=998) xdum 185 if (old) call skplin(2,unitreleases) 186 read(unitreleases,*,err=998) xdum 187 if (old) call skplin(2,unitreleases) 188 read(unitreleases,*,err=998) idum 189 if (old) call skplin(2,unitreleases) 190 do i=1,nspec 191 read(unitreleases,*,err=998) xdum 192 if (old) call skplin(2,unitreleases) 193 end do 194 !save compoint only for the first 1000 release points 195 read(unitreleases,'(a40)',err=998) compoint(1)(1:40) 196 if (old) call skplin(1,unitreleases) 197 198 goto 100 199 200 25 numpoint=numpoint-1 201 202 else 203 204 readerror=0 205 do while (readerror.eq.0) 206 idate1=-1 207 read(unitreleases,release,iostat=readerror) 208 if ((idate1.lt.0).or.(readerror.ne.0)) then 209 readerror=1 210 else 211 numpoint=numpoint+1 212 endif 213 end do 214 readerror=0 215 endif ! if namelist input 216 96 217 rewind(unitreleases) 97 218 98 99 ! Skip first 11 lines (file header) 100 !********************************** 101 102 call skplin(11,unitreleases) 103 104 105 read(unitreleases,*,err=998) nspec 106 if (old) call skplin(2,unitreleases) 107 do i=1,nspec 108 read(unitreleases,*,err=998) specnum_rel 109 if (old) call skplin(2,unitreleases) 219 ! allocate arrays of matching size for number of species (namelist output) 220 deallocate(mass) 221 allocate(mass(nspec),stat=stat) 222 if (stat.ne.0) write(*,*)'ERROR: could not allocate mass' 223 allocate(specnum_rel2(nspec),stat=stat) 224 if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel2' 225 specnum_rel2=specnum_rel(1:nspec) 226 deallocate(specnum_rel) 227 allocate(specnum_rel(nspec),stat=stat) 228 if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel' 229 specnum_rel=specnum_rel2 230 deallocate(specnum_rel2) 231 232 !allocate memory for numpoint releaspoints 233 allocate(ireleasestart(numpoint),stat=stat) 234 if (stat.ne.0) write(*,*)'ERROR: could not allocate ireleasestart' 235 allocate(ireleaseend(numpoint),stat=stat) 236 if (stat.ne.0) write(*,*)'ERROR: could not allocate ireleaseend' 237 allocate(xpoint1(numpoint),stat=stat) 238 if (stat.ne.0) write(*,*)'ERROR: could not allocate xpoint1' 239 allocate(xpoint2(numpoint),stat=stat) 240 if (stat.ne.0) write(*,*)'ERROR: could not allocate xpoint2' 241 allocate(ypoint1(numpoint),stat=stat) 242 if (stat.ne.0) write(*,*)'ERROR: could not allocate ypoint1' 243 allocate(ypoint2(numpoint),stat=stat) 244 if (stat.ne.0) write(*,*)'ERROR: could not allocate ypoint2' 245 allocate(zpoint1(numpoint),stat=stat) 246 if (stat.ne.0) write(*,*)'ERROR: could not allocate zpoint1' 247 allocate(zpoint2(numpoint),stat=stat) 248 if (stat.ne.0) write(*,*)'ERROR: could not allocate zpoint2' 249 allocate(kindz(numpoint),stat=stat) 250 if (stat.ne.0) write(*,*)'ERROR: could not allocate kindz' 251 allocate(xmass(numpoint,maxspec),stat=stat) 252 if (stat.ne.0) write(*,*)'ERROR: could not allocate xmass' 253 allocate(rho_rel(numpoint),stat=stat) 254 if (stat.ne.0) write(*,*)'ERROR: could not allocate rho_rel' 255 allocate(npart(numpoint),stat=stat) 256 if (stat.ne.0) write(*,*)'ERROR: could not allocate npart' 257 allocate(xmasssave(numpoint),stat=stat) 258 if (stat.ne.0) write(*,*)'ERROR: could not allocate xmasssave' 259 260 write (*,*) 'Releasepoints : ', numpoint 261 262 do i=1,numpoint 263 xmasssave(i)=0. 110 264 end do 111 112 numpoint=0113 100 numpoint=numpoint+1114 read(unitreleases,*,end=25)115 read(unitreleases,*,err=998,end=25) idum,idum116 if (old) call skplin(2,unitreleases)117 read(unitreleases,*,err=998) idum,idum118 if (old) call skplin(2,unitreleases)119 read(unitreleases,*,err=998) xdum120 if (old) call skplin(2,unitreleases)121 read(unitreleases,*,err=998) xdum122 if (old) call skplin(2,unitreleases)123 read(unitreleases,*,err=998) xdum124 if (old) call skplin(2,unitreleases)125 read(unitreleases,*,err=998) xdum126 if (old) call skplin(2,unitreleases)127 read(unitreleases,*,err=998) idum128 if (old) call skplin(2,unitreleases)129 read(unitreleases,*,err=998) xdum130 if (old) call skplin(2,unitreleases)131 read(unitreleases,*,err=998) xdum132 if (old) call skplin(2,unitreleases)133 read(unitreleases,*,err=998) idum134 if (old) call skplin(2,unitreleases)135 do i=1,nspec136 read(unitreleases,*,err=998) xdum137 if (old) call skplin(2,unitreleases)138 end do139 !save compoint only for the first 1000 release points140 read(unitreleases,'(a40)',err=998) compoint(1)(1:40)141 if (old) call skplin(1,unitreleases)142 143 goto 100144 145 25 numpoint=numpoint-1146 147 !allocate memory for numpoint releaspoint148 allocate(ireleasestart(numpoint) &149 ,stat=stat)150 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'151 allocate(ireleaseend(numpoint) &152 ,stat=stat)153 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'154 allocate(xpoint1(numpoint) &155 ,stat=stat)156 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'157 allocate(xpoint2(numpoint) &158 ,stat=stat)159 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'160 allocate(ypoint1(numpoint) &161 ,stat=stat)162 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'163 allocate(ypoint2(numpoint) &164 ,stat=stat)165 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'166 allocate(zpoint1(numpoint) &167 ,stat=stat)168 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'169 allocate(zpoint2(numpoint) &170 ,stat=stat)171 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'172 allocate(kindz(numpoint) &173 ,stat=stat)174 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'175 allocate(xmass(numpoint,maxspec) &176 ,stat=stat)177 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'178 allocate(rho_rel(numpoint) &179 ,stat=stat)180 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'181 allocate(npart(numpoint) &182 ,stat=stat)183 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'184 allocate(xmasssave(numpoint) &185 ,stat=stat)186 if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'187 188 write (*,*) ' Releasepoints allocated: ', numpoint189 190 do i=1,numpoint191 xmasssave(i)=0.192 end do193 265 194 266 !now save the information … … 201 273 end do 202 274 203 rewind(unitreleases) 204 205 206 ! Skip first 11 lines (file header) 207 !********************************** 208 209 call skplin(11,unitreleases) 210 211 212 ! Assign species-specific parameters needed for physical processes 213 !************************************************************************* 214 215 read(unitreleases,*,err=998) nspec 216 if (nspec.gt.maxspec) goto 994 217 if (old) call skplin(2,unitreleases) 275 if (readerror.ne.0) then 276 ! Skip first 11 lines (file header) 277 !********************************** 278 279 call skplin(11,unitreleases) 280 281 ! Assign species-specific parameters needed for physical processes 282 !************************************************************************* 283 284 read(unitreleases,*,err=998) nspec 285 if (nspec.gt.maxspec) goto 994 286 if (old) call skplin(2,unitreleases) 287 endif 288 289 ! namelist output 290 if (nmlout.eqv..true.) then 291 write(unitreleasesout,nml=releases_ctrl) 292 endif 293 218 294 do i=1,nspec 219 read(unitreleases,*,err=998) specnum_rel 220 if (old) call skplin(2,unitreleases) 221 call readspecies(specnum_rel,i) 222 223 ! For backward runs, only 1 species is allowed 224 !********************************************* 225 226 !if ((ldirect.lt.0).and.(nspec.gt.1)) then 227 !write(*,*) '#####################################################' 228 !write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES: ####' 229 !write(*,*) '#### FOR BACKWARD RUNS, ONLY 1 SPECIES IS ALLOWED####' 230 !write(*,*) '#####################################################' 231 ! stop 232 !endif 233 234 ! Molecular weight 235 !***************** 236 237 if (((iout.eq.2).or.(iout.eq.3)).and. & 238 (weightmolar(i).lt.0.)) then 295 if (readerror.ne.0) then 296 read(unitreleases,*,err=998) specnum_rel(i) 297 if (old) call skplin(2,unitreleases) 298 call readspecies(specnum_rel(i),i) 299 else 300 call readspecies(specnum_rel(i),i) 301 endif 302 303 ! For backward runs, only 1 species is allowed 304 !********************************************* 305 306 !if ((ldirect.lt.0).and.(nspec.gt.1)) then 307 !write(*,*) '#####################################################' 308 !write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES: ####' 309 !write(*,*) '#### FOR BACKWARD RUNS, ONLY 1 SPECIES IS ALLOWED####' 310 !write(*,*) '#####################################################' 311 ! stop 312 !endif 313 314 ! Molecular weight 315 !***************** 316 317 if (((iout.eq.2).or.(iout.eq.3)).and.(weightmolar(i).lt.0.)) then 239 318 write(*,*) 'For mixing ratio output, valid molar weight' 240 319 write(*,*) 'must be specified for all simulated species.' … … 244 323 endif 245 324 246 247 ! Radioactive decay 248 !****************** 325 ! Radioactive decay 326 !****************** 249 327 250 328 decay(i)=0.693147/decay(i) !conversion half life to decay constant 251 329 252 330 253 ! Dry deposition of gases 254 !************************ 255 256 if (reldiff(i).gt.0.) & 257 rm(i)=1./(henry(i)/3000.+100.*f0(i)) ! mesophyll resistance 258 259 ! Dry deposition of particles 260 !**************************** 331 ! Dry deposition of gases 332 !************************ 333 334 if (reldiff(i).gt.0.) rm(i)=1./(henry(i)/3000.+100.*f0(i)) ! mesophyll resistance 335 336 ! Dry deposition of particles 337 !**************************** 261 338 262 339 vsetaver(i)=0. 263 340 cunningham(i)=0. 264 341 dquer(i)=dquer(i)*1000000. ! Conversion m to um 265 if (density(i).gt.0.) then 266 call part0(dquer(i),dsigma(i),density(i),fracth,schmih,cun,vsh)342 if (density(i).gt.0.) then ! Additional parameters 343 call part0(dquer(i),dsigma(i),density(i),fracth,schmih,cun,vsh) 267 344 do j=1,ni 268 345 fract(i,j)=fracth(j) … … 272 349 vsetaver(i)=vsetaver(i)-vset(i,j)*fract(i,j) 273 350 end do 274 write(*,*) 'Average sett ing velocity: ',i,vsetaver(i)275 endif 276 277 ! Dry deposition for constant deposition velocity278 !************************************************351 write(*,*) 'Average settling velocity: ',i,vsetaver(i) 352 endif 353 354 ! Dry deposition for constant deposition velocity 355 !************************************************ 279 356 280 357 dryvel(i)=dryvel(i)*0.01 ! conversion to m/s 281 358 282 ! Check if wet deposition or OH reaction shall be calculated283 !***********************************************************359 ! Check if wet deposition or OH reaction shall be calculated 360 !*********************************************************** 284 361 if (weta(i).gt.0.) then 285 362 WETDEP=.true. 286 write (*,*) 'Wetdeposition switched on: ',weta(i),i 287 endif 363 write (*,*) 'Below-cloud scavenging: ON' 364 write (*,*) 'Below-cloud scavenging coefficients: ',weta(i),i 365 else 366 write (*,*) 'Below-cloud scavenging: OFF' 367 endif 368 369 ! NIK 31.01.2013 + 10.12.2013 370 if (weta_in(i).gt.0.) then 371 WETDEP=.true. 372 write (*,*) 'In-cloud scavenging: ON' 373 write (*,*) 'In-cloud scavenging coefficients: ',weta_in(i),wetb_in(i), wetc_in(i), wetd_in(i),i 374 else 375 write (*,*) 'In-cloud scavenging: OFF' 376 endif 377 288 378 if (ohreact(i).gt.0) then 289 379 OHREA=.true. 290 write (*,*) 'OHreaction switched on: ',ohreact(i),i 291 endif 292 293 294 if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or. & 295 (dryvel(i).gt.0.)) then 380 write (*,*) 'OHreaction: ON (',ohreact(i),i,')' 381 endif 382 383 if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or.(dryvel(i).gt.0.)) then 296 384 DRYDEP=.true. 297 385 DRYDEPSPEC(i)=.true. … … 300 388 end do 301 389 302 390 if (WETDEP.or.DRYDEP) DEP=.true. 303 391 304 392 ! Read specifications for each release point 305 393 !******************************************* 306 394 numpoints=numpoint 307 395 numpoint=0 308 396 numpartmax=0 309 397 releaserate=0. 310 1000 numpoint=numpoint+1 311 read(unitreleases,*,end=250) 312 read(unitreleases,*,err=998,end=250) id1,it1 313 if (old) call skplin(2,unitreleases) 314 read(unitreleases,*,err=998) id2,it2 315 if (old) call skplin(2,unitreleases) 316 read(unitreleases,*,err=998) xpoint1(numpoint) 317 if (old) call skplin(2,unitreleases) 318 read(unitreleases,*,err=998) ypoint1(numpoint) 319 if (old) call skplin(2,unitreleases) 320 read(unitreleases,*,err=998) xpoint2(numpoint) 321 if (old) call skplin(2,unitreleases) 322 read(unitreleases,*,err=998) ypoint2(numpoint) 323 if (old) call skplin(2,unitreleases) 324 read(unitreleases,*,err=998) kindz(numpoint) 325 if (old) call skplin(2,unitreleases) 326 read(unitreleases,*,err=998) zpoint1(numpoint) 327 if (old) call skplin(2,unitreleases) 328 read(unitreleases,*,err=998) zpoint2(numpoint) 329 if (old) call skplin(2,unitreleases) 330 read(unitreleases,*,err=998) npart(numpoint) 331 if (old) call skplin(2,unitreleases) 332 do i=1,nspec 333 read(unitreleases,*,err=998) xmass(numpoint,i) 334 if (old) call skplin(2,unitreleases) 335 end do 336 !save compoint only for the first 1000 release points 337 if (numpoint.le.1000) then 338 read(unitreleases,'(a40)',err=998) compoint(numpoint)(1:40) 398 101 numpoint=numpoint+1 399 400 if (readerror.lt.1) then ! reading namelist format 401 402 if (numpoint.gt.numpoints) goto 250 403 zkind = 1 404 mass = 0 405 parts = 0 406 comment = ' ' 407 read(unitreleases,release,iostat=readerror) 408 id1=idate1 409 it1=itime1 410 id2=idate2 411 it2=itime2 412 xpoint1(numpoint)=lon1 413 xpoint2(numpoint)=lon2 414 ypoint1(numpoint)=lat1 415 ypoint2(numpoint)=lat2 416 zpoint1(numpoint)=z1 417 zpoint2(numpoint)=z2 418 kindz(numpoint)=zkind 419 do i=1,nspec 420 xmass(numpoint,i)=mass(i) 421 end do 422 npart(numpoint)=parts 423 compoint(min(1001,numpoint))=comment 424 425 ! namelist output 426 if (nmlout.eqv..true.) then 427 write(unitreleasesout,nml=release) 428 endif 429 339 430 else 340 read(unitreleases,'(a40)',err=998) compoint(1001)(1:40) 341 endif 342 if (old) call skplin(1,unitreleases) 343 if (numpoint.le.1000) then 344 if((xpoint1(numpoint).eq.0.).and.(ypoint1(numpoint).eq.0.).and. & 345 (xpoint2(numpoint).eq.0.).and.(ypoint2(numpoint).eq.0.).and. & 346 (compoint(numpoint)(1:8).eq.' ')) goto 250 347 else 348 if((xpoint1(numpoint).eq.0.).and.(ypoint1(numpoint).eq.0.).and. & 349 (xpoint2(numpoint).eq.0.).and.(ypoint2(numpoint).eq.0.)) goto 250 350 endif 351 431 432 read(unitreleases,*,end=250) 433 read(unitreleases,*,err=998,end=250) id1,it1 434 if (old) call skplin(2,unitreleases) 435 read(unitreleases,*,err=998) id2,it2 436 if (old) call skplin(2,unitreleases) 437 read(unitreleases,*,err=998) xpoint1(numpoint) 438 if (old) call skplin(2,unitreleases) 439 read(unitreleases,*,err=998) ypoint1(numpoint) 440 if (old) call skplin(2,unitreleases) 441 read(unitreleases,*,err=998) xpoint2(numpoint) 442 if (old) call skplin(2,unitreleases) 443 read(unitreleases,*,err=998) ypoint2(numpoint) 444 if (old) call skplin(2,unitreleases) 445 read(unitreleases,*,err=998) kindz(numpoint) 446 if (old) call skplin(2,unitreleases) 447 read(unitreleases,*,err=998) zpoint1(numpoint) 448 if (old) call skplin(2,unitreleases) 449 read(unitreleases,*,err=998) zpoint2(numpoint) 450 if (old) call skplin(2,unitreleases) 451 read(unitreleases,*,err=998) npart(numpoint) 452 if (old) call skplin(2,unitreleases) 453 do i=1,nspec 454 read(unitreleases,*,err=998) xmass(numpoint,i) 455 if (old) call skplin(2,unitreleases) 456 mass(i)=xmass(numpoint,i) 457 end do 458 !save compoint only for the first 1000 release points 459 if (numpoint.le.1000) then 460 read(unitreleases,'(a40)',err=998) compoint(numpoint)(1:40) 461 comment=compoint(numpoint)(1:40) 462 else 463 read(unitreleases,'(a40)',err=998) compoint(1001)(1:40) 464 comment=compoint(1001)(1:40) 465 endif 466 if (old) call skplin(1,unitreleases) 467 468 ! namelist output 469 if (nmlout.eqv..true.) then 470 idate1=id1 471 itime1=it1 472 idate2=id2 473 itime2=it2 474 lon1=xpoint1(numpoint) 475 lon2=xpoint2(numpoint) 476 lat1=ypoint1(numpoint) 477 lat2=ypoint2(numpoint) 478 z1=zpoint1(numpoint) 479 z2=zpoint2(numpoint) 480 zkind=kindz(numpoint) 481 parts=npart(numpoint) 482 write(unitreleasesout,nml=release) 483 endif 484 485 if (numpoint.le.1000) then 486 if((xpoint1(numpoint).eq.0.).and.(ypoint1(numpoint).eq.0.).and. & 487 (xpoint2(numpoint).eq.0.).and.(ypoint2(numpoint).eq.0.).and. & 488 (compoint(numpoint)(1:8).eq.' ')) goto 250 489 else 490 if((xpoint1(numpoint).eq.0.).and.(ypoint1(numpoint).eq.0.).and. & 491 (xpoint2(numpoint).eq.0.).and.(ypoint2(numpoint).eq.0.)) goto 250 492 endif 493 494 endif ! if namelist format 352 495 353 496 ! If a release point contains no particles, stop and issue error message … … 420 563 endif 421 564 422 423 ! Check, whether the total number of particles may exceed totally allowed424 ! number of particles at some time during the simulation425 !************************************************************************426 427 565 ! Determine the release rate (particles per second) and total number 428 566 ! of particles released during the simulation … … 436 574 endif 437 575 numpartmax=numpartmax+npart(numpoint) 438 goto 1000 439 576 goto 101 440 577 441 578 250 close(unitreleases) 442 579 443 write (*,*) ' Particles allocated for this run: ',maxpart, ', released in simulation: ', numpartmax 580 if (nmlout.eqv..true.) then 581 close(unitreleasesout) 582 endif 583 584 write (*,*) 'Particles allocated (maxpart) : ',maxpart 585 write (*,*) 'Particles released (numpartmax): ',numpartmax 444 586 numpoint=numpoint-1 445 587 … … 449 591 maxpointspec_act=1 450 592 endif 593 594 ! Check, whether the total number of particles may exceed totally allowed 595 ! number of particles at some time during the simulation 596 !************************************************************************ 451 597 452 598 if (releaserate.gt. & … … 506 652 stop 507 653 654 1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RELEASES" #### ' 655 write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY #### ' 656 write(*,'(a)') path(2)(1:length(2)) 657 stop 658 508 659 end subroutine readreleases
Note: See TracChangeset
for help on using the changeset viewer.