source: branches/petra/src/readreceptors.f90

Last change on this file was 36, checked in by pesei, 9 years ago

Implement switch for incremental deposition, see ticket:113 and many small changes, see changelog.txt

File size: 7.0 KB
Line 
1!**********************************************************************
2! Copyright 1998-2015                                                 *
3! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
4! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
5!                                                                     *
6! This file is part of FLEXPART.                                      *
7!                                                                     *
8! FLEXPART is free software: you can redistribute it and/or modify    *
9! it under the terms of the GNU General Public License as published by*
10! the Free Software Foundation, either version 3 of the License, or   *
11! (at your option) any later version.                                 *
12!                                                                     *
13! FLEXPART is distributed in the hope that it will be useful,         *
14! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
15! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
16! GNU General Public License for more details.                        *
17!                                                                     *
18! You should have received a copy of the GNU General Public License   *
19! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
20!**********************************************************************
21
22subroutine readreceptors
23
24  !*****************************************************************************
25  !                                                                            *
26  !     This routine reads the user specifications for the receptor points.    *
27  !                                                                            *
28  !     Author: A. Stohl                                                       *
29  !     1 August 1996       
30  !                                                  *
31  !     HSO, 14 August 2013: Added optional namelist input
32  !     PS, 2/2015: access= -> position=
33  !                                                                            *
34  !*****************************************************************************
35  !                                                                            *
36  ! Variables:                                                                 *
37  ! receptorarea(maxreceptor)  area of dx*dy at location of receptor           *
38  ! receptorname(maxreceptor)  names of receptors                              *
39  ! xreceptor,yreceptor  coordinates of receptor points                        *
40  !                                                                            *
41  ! Constants:                                                                 *
42  ! unitreceptor         unit connected to file RECEPTORS                      *
43  !                                                                            *
44  !*****************************************************************************
45
46  use par_mod
47  use com_mod
48
49  implicit none
50
51  integer :: j
52  real :: x,y,xm,ym
53  character(len=16) :: receptor
54
55  integer :: readerror
56  real :: lon,lat   ! for namelist input, lon/lat are used instead of x,y
57  integer,parameter :: unitreceptorout=2
58
59  ! declare namelist
60  namelist /receptors/ &
61    receptor, lon, lat
62
63  lon=-999.9
64
65  ! For backward runs, do not allow receptor output. Thus, set number of receptors to zero
66  !*****************************************************************************
67
68  if (ldirect.lt.0) then
69    numreceptor=0
70    return
71  endif
72
73
74  ! Open the RECEPTORS file and read output grid specifications
75  !************************************************************
76
77  open(unitreceptor,file=path(1)(1:length(1))//'RECEPTORS',form='formatted',status='old',err=999)
78
79  ! try namelist input
80  read(unitreceptor,receptors,iostat=readerror)
81
82  ! prepare namelist output if requested
83  if (nmlout.eqv..true.) then
84    open(unitreceptorout,file=path(2)(1:length(2))//'RECEPTORS.namelist',position='append',status='new',err=1000)
85  endif
86
87  if ((lon.lt.-900).or.(readerror.ne.0)) then
88
89    close(unitreceptor)
90    open(unitreceptor,file=path(1)(1:length(1))//'RECEPTORS',status='old',err=999)
91    call skplin(5,unitreceptor)
92
93    ! Read the names and coordinates of the receptors
94    !************************************************
95
96    j=0
97100 j=j+1
98    read(unitreceptor,*,end=99)
99    read(unitreceptor,*,end=99)
100    read(unitreceptor,*,end=99)
101    read(unitreceptor,'(4x,a16)',end=99) receptor
102    call skplin(3,unitreceptor)
103    read(unitreceptor,'(4x,f11.4)',end=99) x
104    call skplin(3,unitreceptor)
105    read(unitreceptor,'(4x,f11.4)',end=99) y
106    if ((x.eq.0.).and.(y.eq.0.).and. &
107         (receptor.eq.'                ')) then
108      j=j-1
109      goto 100
110    endif
111    if (j.gt.maxreceptor) then
112      write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
113      write(*,*) ' #### POINTS ARE GIVEN.                       #### '
114      write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
115      write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
116    endif
117    receptorname(j)=receptor
118    xreceptor(j)=(x-xlon0)/dx       ! transform to grid coordinates
119    yreceptor(j)=(y-ylat0)/dy
120    xm=r_earth*cos(y*pi/180.)*dx/180.*pi
121    ym=r_earth*dy/180.*pi
122    receptorarea(j)=xm*ym
123
124    ! write receptors file in namelist format to output directory if requested
125    if (nmlout.eqv..true.) then
126      lon=x
127      lat=y
128      write(unitreceptorout,nml=receptors)
129    endif
130
131    goto 100
132
13399  numreceptor=j-1
134
135  else ! continue with namelist input
136
137    j=0
138    do while (readerror.eq.0)
139      j=j+1
140      lon=-999.9
141      read(unitreceptor,receptors,iostat=readerror)
142      if ((lon.lt.-900).or.(readerror.ne.0)) then
143        readerror=1
144      else
145        if (j.gt.maxreceptor) then
146          write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
147          write(*,*) ' #### POINTS ARE GIVEN.                       #### '
148          write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
149          write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
150        endif
151        receptorname(j)=receptor
152        xreceptor(j)=(lon-xlon0)/dx       ! transform to grid coordinates
153        yreceptor(j)=(lat-ylat0)/dy
154        xm=r_earth*cos(lat*pi/180.)*dx/180.*pi
155        ym=r_earth*dy/180.*pi
156        receptorarea(j)=xm*ym
157      endif
158
159      ! write receptors file in namelist format to output directory if requested
160      if (nmlout.eqv..true.) then
161        write(unitreceptorout,nml=receptors)
162      endif
163
164    end do
165    numreceptor=j-1
166    close(unitreceptor)
167
168  endif
169
170  if (nmlout.eqv..true.) then
171    close(unitreceptorout)
172  endif
173
174  return
175
176
177999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS"  #### '
178  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
179  write(*,'(a)') path(1)(1:length(1))
180  stop
181
1821000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS"    #### '
183  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
184  write(*,'(a)') path(2)(1:length(2))
185  stop
186
187end subroutine readreceptors
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG