Ignore:
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/src/readreleases.f90

    r20 r27  
    3333  !     Update: 29 January 2001                                                *
    3434  !     Release altitude can be either in magl or masl                         *
     35  !     HSO, 12 August 2013
     36  !     Added optional namelist input
    3537  !                                                                            *
    3638  !*****************************************************************************
     
    5557  ! xpoint2,ypoint2     geograf. coordinates of upper right corner of release  *
    5658  !                     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        *
    5862  ! zpoint1,zpoint2     height range, over which release takes place           *
    5963  ! num_min_discrete    if less, release cannot be randomized and happens at   *
     
    6973  implicit none
    7074
    71   integer :: numpartmax,i,j,id1,it1,id2,it2,specnum_rel,idum,stat
     75  integer :: numpartmax,i,j,id1,it1,id2,it2,idum,stat
    7276  integer,parameter :: num_min_discrete=100
    7377  real :: vsh(ni),fracth(ni),schmih(ni),releaserate,xdum,cun
     
    7680  logical :: old
    7781
     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
    78120  !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
     146901 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
     168100 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
     20025  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
    96217  rewind(unitreleases)
    97218
    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.
    110264  end do
    111 
    112   numpoint=0
    113 100   numpoint=numpoint+1
    114   read(unitreleases,*,end=25)
    115   read(unitreleases,*,err=998,end=25) idum,idum
    116   if (old) call skplin(2,unitreleases)
    117   read(unitreleases,*,err=998) idum,idum
    118   if (old) call skplin(2,unitreleases)
    119   read(unitreleases,*,err=998) xdum
    120   if (old) call skplin(2,unitreleases)
    121   read(unitreleases,*,err=998) xdum
    122   if (old) call skplin(2,unitreleases)
    123   read(unitreleases,*,err=998) xdum
    124   if (old) call skplin(2,unitreleases)
    125   read(unitreleases,*,err=998) xdum
    126   if (old) call skplin(2,unitreleases)
    127   read(unitreleases,*,err=998) idum
    128   if (old) call skplin(2,unitreleases)
    129   read(unitreleases,*,err=998) xdum
    130   if (old) call skplin(2,unitreleases)
    131   read(unitreleases,*,err=998) xdum
    132   if (old) call skplin(2,unitreleases)
    133   read(unitreleases,*,err=998) idum
    134   if (old) call skplin(2,unitreleases)
    135   do i=1,nspec
    136     read(unitreleases,*,err=998) xdum
    137     if (old) call skplin(2,unitreleases)
    138   end do
    139   !save compoint only for the first 1000 release points
    140   read(unitreleases,'(a40)',err=998) compoint(1)(1:40)
    141   if (old) call skplin(1,unitreleases)
    142 
    143   goto 100
    144 
    145 25   numpoint=numpoint-1
    146 
    147   !allocate memory for numpoint releaspoint
    148     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: ', numpoint
    189 
    190    do i=1,numpoint
    191      xmasssave(i)=0.
    192    end do
    193265
    194266  !now save the information
     
    201273  end do
    202274
    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
    218294  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
    239318      write(*,*) 'For mixing ratio output, valid molar weight'
    240319      write(*,*) 'must be specified for all simulated species.'
     
    244323    endif
    245324
    246 
    247   ! Radioactive decay
    248   !******************
     325    ! Radioactive decay
     326    !******************
    249327
    250328    decay(i)=0.693147/decay(i) !conversion half life to decay constant
    251329
    252330
    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    !****************************
    261338
    262339    vsetaver(i)=0.
    263340    cunningham(i)=0.
    264341    dquer(i)=dquer(i)*1000000.         ! Conversion m to um
    265     if (density(i).gt.0.) then                  ! Additional parameters
    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)
    267344      do j=1,ni
    268345        fract(i,j)=fracth(j)
     
    272349        vsetaver(i)=vsetaver(i)-vset(i,j)*fract(i,j)
    273350      end do
    274       write(*,*) 'Average setting velocity: ',i,vsetaver(i)
    275     endif
    276 
    277   ! Dry deposition for constant deposition velocity
    278   !************************************************
     351      write(*,*) 'Average settling velocity: ',i,vsetaver(i)
     352    endif
     353
     354    ! Dry deposition for constant deposition velocity
     355    !************************************************
    279356
    280357    dryvel(i)=dryvel(i)*0.01         ! conversion to m/s
    281358
    282   ! Check if wet deposition or OH reaction shall be calculated
    283   !***********************************************************
     359    ! Check if wet deposition or OH reaction shall be calculated
     360    !***********************************************************
    284361    if (weta(i).gt.0.)  then
    285362      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
    288378    if (ohreact(i).gt.0) then
    289379      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
    296384      DRYDEP=.true.
    297385      DRYDEPSPEC(i)=.true.
     
    300388  end do
    301389
    302     if (WETDEP.or.DRYDEP) DEP=.true.
     390  if (WETDEP.or.DRYDEP) DEP=.true.
    303391
    304392  ! Read specifications for each release point
    305393  !*******************************************
    306 
     394  numpoints=numpoint
    307395  numpoint=0
    308396  numpartmax=0
    309397  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)
     398101   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
    339430  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
    352495
    353496  ! If a release point contains no particles, stop and issue error message
     
    420563  endif
    421564
    422 
    423   ! Check, whether the total number of particles may exceed totally allowed
    424   ! number of particles at some time during the simulation
    425   !************************************************************************
    426 
    427565  ! Determine the release rate (particles per second) and total number
    428566  ! of particles released during the simulation
     
    436574  endif
    437575  numpartmax=numpartmax+npart(numpoint)
    438   goto 1000
    439 
     576  goto 101
    440577
    441578250   close(unitreleases)
    442579
    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
    444586  numpoint=numpoint-1
    445587
     
    449591    maxpointspec_act=1
    450592  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  !************************************************************************
    451597
    452598  if (releaserate.gt. &
     
    506652  stop
    507653
     6541000 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
    508659end subroutine readreleases
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG