source: branches/flexpart91_hasod/src_parallel/readoutgrid.f90

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

ADD: namelist input implemented for all common input files

File size: 7.7 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 readoutgrid
23
24  !*****************************************************************************
25  !                                                                            *
26  !     This routine reads the user specifications for the output grid.        *
27  !                                                                            *
28  !     Author: A. Stohl                                                       *
29  !                                                                            *
30  !     4 June 1996                                                            *
31  !                                                                            *
32  !*****************************************************************************
33  !                                                                            *
34  ! Variables:                                                                 *
35  ! dxout,dyout          grid distance                                         *
36  ! numxgrid,numygrid,numzgrid    grid dimensions                              *
37  ! outlon0,outlat0      lower left corner of grid                             *
38  ! outheight(maxzgrid)  height levels of output grid [m]                      *
39  !                                                                            *
40  ! Constants:                                                                 *
41  ! unitoutgrid          unit connected to file OUTGRID                        *
42  !                                                                            *
43  !*****************************************************************************
44
45  use outg_mod
46  use par_mod
47  use com_mod
48
49  implicit none
50
51  integer :: i,j,stat
52  real :: outhelp,xr,xr1,yr,yr1
53  real,parameter :: eps=1.e-4
54
55  ! namelist variables
56  integer, parameter :: maxoutlev=500
57  real :: outheights(maxoutlev)
58  integer :: readerror
59
60  ! declare namelist
61  namelist /outgrid/ &
62    outlon0,outlat0, &
63    numxgrid,numygrid, &
64    dxout,dyout, &
65    outheights
66
67  ! helps identifying failed namelist input
68  dxout=-1.0
69  outheights=-1.0
70
71  ! Open the OUTGRID file and read output grid specifications
72  !**********************************************************
73
74  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old', &
75       err=999)
76
77  ! try namelist input
78  read(unitoutgrid,outgrid,iostat=readerror)
79
80
81  if ((dxout.le.0).or.(readerror.ne.0)) then
82
83    readerror=1
84
85    rewind(unitoutgrid)
86    call skplin(5,unitoutgrid)
87
88    ! 1.  Read horizontal grid specifications
89    !****************************************
90
91    call skplin(3,unitoutgrid)
92    read(unitoutgrid,'(4x,f11.4)') outlon0
93    call skplin(3,unitoutgrid)
94    read(unitoutgrid,'(4x,f11.4)') outlat0
95    call skplin(3,unitoutgrid)
96    read(unitoutgrid,'(4x,i5)') numxgrid
97    call skplin(3,unitoutgrid)
98    read(unitoutgrid,'(4x,i5)') numygrid
99    call skplin(3,unitoutgrid)
100    read(unitoutgrid,'(4x,f12.5)') dxout
101    call skplin(3,unitoutgrid)
102    read(unitoutgrid,'(4x,f12.5)') dyout
103
104  endif
105
106  ! Check validity of output grid (shall be within model domain)
107  !*************************************************************
108
109  xr=outlon0+real(numxgrid)*dxout
110  yr=outlat0+real(numygrid)*dyout
111  xr1=xlon0+real(nxmin1)*dx
112  yr1=ylat0+real(nymin1)*dy
113  if ((outlon0+eps.lt.xlon0).or.(outlat0+eps.lt.ylat0) &
114       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
115    write(*,*) outlon0,outlat0
116    write(*,*) xr1,yr1,xlon0,ylat0,xr,yr,dxout,dyout
117    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
118    write(*,*) ' #### GRID IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
119    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
120    write(*,'(a)') path(1)(1:length(1))
121    stop
122  endif
123
124  ! 2. Count Vertical levels of output grid
125  !****************************************
126
127  if (readerror.ne.0) then
128    j=0
129100 j=j+1
130    do i=1,3
131      read(unitoutgrid,*,end=99)
132    end do
133    read(unitoutgrid,'(4x,f7.1)',end=99) outhelp
134    if (outhelp.eq.0.) goto 99
135    goto 100
13699  numzgrid=j-1
137  else
138    do i=1,maxoutlev
139      if (outheights(i).lt.0) exit
140    end do
141    numzgrid=i-1
142  end if
143
144  allocate(outheight(numzgrid),stat=stat)
145  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheight'
146  allocate(outheighthalf(numzgrid),stat=stat)
147  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheighthalf'
148
149  ! 2. Vertical levels of output grid
150  !**********************************
151
152  if (readerror.ne.0) then
153
154    rewind(unitoutgrid)
155    call skplin(29,unitoutgrid)
156
157    do j=1,numzgrid
158      do i=1,3
159        read(unitoutgrid,*)
160      end do
161      read(unitoutgrid,'(4x,f7.1)') outhelp
162      outheight(j)=outhelp
163    end do
164
165  else
166
167    do j=1,numzgrid
168      outheight(j)=outheights(j)
169    end do
170
171  endif
172
173  close(unitoutgrid)
174
175  ! Check whether vertical levels are specified in ascending order
176  !***************************************************************
177
178  do j=2,numzgrid
179    if (outheight(j).le.outheight(j-1)) then
180    write(*,*) ' #### FLEXPART MODEL ERROR! YOUR SPECIFICATION#### '
181    write(*,*) ' #### OF OUTPUT LEVELS IS CORRUPT AT LEVEL    #### '
182    write(*,*) ' #### ',j,'                              #### '
183    write(*,*) ' #### PLEASE MAKE CHANGES IN FILE OUTGRID.    #### '
184    endif
185  end do
186
187  ! Determine the half levels, i.e. middle levels of the output grid
188  !*****************************************************************
189
190  outheighthalf(1)=outheight(1)/2.
191  do j=2,numzgrid
192    outheighthalf(j)=(outheight(j-1)+outheight(j))/2.
193  end do
194
195  xoutshift=xlon0-outlon0
196  youtshift=ylat0-outlat0
197
198  allocate(oroout(0:numxgrid-1,0:numygrid-1),stat=stat)
199  if (stat.ne.0) write(*,*)'ERROR: could not allocate oroout'
200  allocate(area(0:numxgrid-1,0:numygrid-1),stat=stat)
201  if (stat.ne.0) write(*,*)'ERROR: could not allocate area'
202  allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
203  if (stat.ne.0) write(*,*)'ERROR: could not allocate volume'
204  allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
205  if (stat.ne.0) write(*,*)'ERROR: could not allocate areaeast'
206  allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
207  if (stat.ne.0) write(*,*)'ERROR: could not allocate areanorth'
208  return
209
210
211999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
212  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
213  write(*,*) ' #### xxx/flexpart/options                    #### '
214  stop
215
216end subroutine readoutgrid
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG