source: branches/flexpart91_hasod/src/readreceptors.f90 @ 7

Last change on this file since 7 was 7, checked in by hasod, 11 years ago

Initial import

  • namelist input for COMMAND
  • pathnames optionally as command line argument
  • conversion utility from COMMAND to COMMAND namelist
File size: 4.9 KB
Line 
1!**********************************************************************
2! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
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  !                                                                            *
30  !     1 August 1996                                                          *
31  !                                                                            *
32  !*****************************************************************************
33  !                                                                            *
34  ! Variables:                                                                 *
35  ! receptorarea(maxreceptor)  area of dx*dy at location of receptor           *
36  ! receptorname(maxreceptor)  names of receptors                              *
37  ! xreceptor,yreceptor  coordinates of receptor points                        *
38  !                                                                            *
39  ! Constants:                                                                 *
40  ! unitreceptor         unit connected to file RECEPTORS                      *
41  !                                                                            *
42  !*****************************************************************************
43
44  use par_mod
45  use com_mod
46
47  implicit none
48
49  integer :: j
50  real :: x,y,xm,ym
51  character(len=16) :: receptor
52
53
54  ! For backward runs, do not allow receptor output. Thus, set number of receptors to zero
55  !*****************************************************************************
56
57  if (ldirect.lt.0) then
58    numreceptor=0
59    return
60  endif
61
62
63  ! Open the RECEPTORS file and read output grid specifications
64  !************************************************************
65
66  open(unitreceptor,file=path(1)(1:length(1))//'RECEPTORS', &
67       status='old',err=999)
68
69  call skplin(5,unitreceptor)
70
71
72  ! Read the names and coordinates of the receptors
73  !************************************************
74
75  j=0
76100   j=j+1
77    read(unitreceptor,*,end=99)
78    read(unitreceptor,*,end=99)
79    read(unitreceptor,*,end=99)
80    read(unitreceptor,'(4x,a16)',end=99) receptor
81    call skplin(3,unitreceptor)
82    read(unitreceptor,'(4x,f11.4)',end=99) x
83    call skplin(3,unitreceptor)
84    read(unitreceptor,'(4x,f11.4)',end=99) y
85    if ((x.eq.0.).and.(y.eq.0.).and. &
86         (receptor.eq.'                ')) then
87      j=j-1
88      goto 100
89    endif
90    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   #### '
95    endif
96    receptorname(j)=receptor
97    xreceptor(j)=(x-xlon0)/dx       ! transform to grid coordinates
98    yreceptor(j)=(y-ylat0)/dy
99    xm=r_earth*cos(y*pi/180.)*dx/180.*pi
100    ym=r_earth*dy/180.*pi
101    receptorarea(j)=xm*ym
102    goto 100
103
10499   numreceptor=j-1
105  close(unitreceptor)
106  return
107
108
109999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS"  #### '
110  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
111  write(*,'(a)') path(1)(1:length(1))
112  stop
113
114end subroutine readreceptors
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG