Ignore:
Timestamp:
Aug 15, 2013, 3:23:48 PM (11 years ago)
Author:
hasod
Message:

ADD: namelist input implemented for all common input files

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/flexpart91_hasod/src_parallel/readreceptors.f90

    r8 r10  
    2727  !                                                                            *
    2828  !     Author: A. Stohl                                                       *
    29   !                                                                            *
    3029  !     1 August 1996                                                          *
     30  !     HSO, 14 August 2013
     31  !     Added optional namelist input
    3132  !                                                                            *
    3233  !*****************************************************************************
     
    5152  character(len=16) :: receptor
    5253
     54  integer :: readerror
     55  real :: lon,lat   ! for namelist input, lon/lat are used instead of x,y
     56
     57  ! declare namelist
     58  namelist /receptors/ &
     59    receptor, lon, lat
     60
     61  lon=-999.9
    5362
    5463  ! For backward runs, do not allow receptor output. Thus, set number of receptors to zero
     
    6776       status='old',err=999)
    6877
    69   call skplin(5,unitreceptor)
     78  ! try namelist input
     79  read(unitreceptor,receptors,iostat=readerror)
    7080
     81  rewind(unitreceptor)
     82  if ((lon.lt.-900).or.(readerror.ne.0)) then
    7183
    72   ! Read the names and coordinates of the receptors
    73   !************************************************
     84    call skplin(5,unitreceptor)
    7485
    75   j=0
    76 100   j=j+1
     86    ! Read the names and coordinates of the receptors
     87    !************************************************
     88
     89    j=0
     90100 j=j+1
    7791    read(unitreceptor,*,end=99)
    7892    read(unitreceptor,*,end=99)
     
    89103    endif
    90104    if (j.gt.maxreceptor) then
    91     write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
    92     write(*,*) ' #### POINTS ARE GIVEN.                       #### '
    93     write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
    94     write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
     105      write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
     106      write(*,*) ' #### POINTS ARE GIVEN.                       #### '
     107      write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
     108      write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
    95109    endif
    96110    receptorname(j)=receptor
     
    102116    goto 100
    103117
    104 99   numreceptor=j-1
     11899  numreceptor=j-1
     119
     120  else ! continue with namelist input
     121
     122    j=0
     123    do while (readerror.eq.0)
     124      j=j+1
     125      lon=-999.9
     126      read(unitreceptor,receptors,iostat=readerror)
     127      if ((lon.lt.-900).or.(readerror.ne.0)) then
     128        readerror=1
     129      else
     130        if (j.gt.maxreceptor) then
     131          write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
     132          write(*,*) ' #### POINTS ARE GIVEN.                       #### '
     133          write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
     134          write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
     135        endif
     136        receptorname(j)=receptor
     137        xreceptor(j)=(lon-xlon0)/dx       ! transform to grid coordinates
     138        yreceptor(j)=(lat-ylat0)/dy
     139        xm=r_earth*cos(lat*pi/180.)*dx/180.*pi
     140        ym=r_earth*dy/180.*pi
     141        receptorarea(j)=xm*ym
     142      endif
     143    end do
     144    numreceptor=j-1
     145
     146  endif
     147
     148
    105149  close(unitreceptor)
    106150  return
    107151
    108152
    109 999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS"  #### '
     153999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS"  #### '
    110154  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
    111155  write(*,'(a)') path(1)(1:length(1))
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG