source: trunk/src/readoutgrid.f90 @ 27

Last change on this file since 27 was 27, checked in by hasod, 10 years ago
  • Implemented optional namelist input for COMMAND, RELEASES, SPECIES, AGECLASSES,OUTGRID,OUTGRID_NEST,RECEPTORS
  • Implemented com_mod switch nmlout to write input files as namelist to the output directory (.true. by default)
  • Proposed updated startup and runtime output (may change back to previous info if desired)
File size: 8.8 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  !     HSO, 1 July 2014
32  !     Added optional namelist input
33  !                                                                            *
34  !*****************************************************************************
35  !                                                                            *
36  ! Variables:                                                                 *
37  ! dxout,dyout          grid distance                                         *
38  ! numxgrid,numygrid,numzgrid    grid dimensions                              *
39  ! outlon0,outlat0      lower left corner of grid                             *
40  ! outheight(maxzgrid)  height levels of output grid [m]                      *
41  !                                                                            *
42  ! Constants:                                                                 *
43  ! unitoutgrid          unit connected to file OUTGRID                        *
44  !                                                                            *
45  !*****************************************************************************
46
47  use outg_mod
48  use par_mod
49  use com_mod
50
51  implicit none
52
53  integer :: i,j,stat
54  real :: outhelp,xr,xr1,yr,yr1
55  real,parameter :: eps=1.e-4
56
57  ! namelist variables
58  integer, parameter :: maxoutlev=500
59  integer :: readerror
60  real,allocatable, dimension (:) :: outheights
61
62  ! declare namelist
63  namelist /outgrid/ &
64    outlon0,outlat0, &
65    numxgrid,numygrid, &
66    dxout,dyout, &
67    outheights
68
69  ! allocate large array for reading input
70  allocate(outheights(maxoutlev),stat=stat)
71  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheights'
72
73  ! helps identifying failed namelist input
74  dxout=-1.0
75  outheights=-1.0
76
77  ! Open the OUTGRID file and read output grid specifications
78  !**********************************************************
79
80  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old',form='formatted',err=999)
81
82  ! try namelist input
83  read(unitoutgrid,outgrid,iostat=readerror)
84  close(unitoutgrid)
85
86  if ((dxout.le.0).or.(readerror.ne.0)) then
87
88    readerror=1
89
90    open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old',err=999)
91
92    call skplin(5,unitoutgrid)
93
94    ! 1.  Read horizontal grid specifications
95    !****************************************
96
97    call skplin(3,unitoutgrid)
98    read(unitoutgrid,'(4x,f11.4)') outlon0
99    call skplin(3,unitoutgrid)
100    read(unitoutgrid,'(4x,f11.4)') outlat0
101    call skplin(3,unitoutgrid)
102    read(unitoutgrid,'(4x,i5)') numxgrid
103    call skplin(3,unitoutgrid)
104    read(unitoutgrid,'(4x,i5)') numygrid
105    call skplin(3,unitoutgrid)
106    read(unitoutgrid,'(4x,f12.5)') dxout
107    call skplin(3,unitoutgrid)
108    read(unitoutgrid,'(4x,f12.5)') dyout
109
110  endif
111
112  ! Check validity of output grid (shall be within model domain)
113  !*************************************************************
114
115  xr=outlon0+real(numxgrid)*dxout
116  yr=outlat0+real(numygrid)*dyout
117  xr1=xlon0+real(nxmin1)*dx
118  yr1=ylat0+real(nymin1)*dy
119  if ((outlon0+eps.lt.xlon0).or.(outlat0+eps.lt.ylat0) &
120       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
121    write(*,*) outlon0,outlat0
122    write(*,*) xr1,yr1,xlon0,ylat0,xr,yr,dxout,dyout
123    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
124    write(*,*) ' #### GRID IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
125    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
126    write(*,'(a)') path(1)(1:length(1))
127    stop
128  endif
129
130  ! 2. Count Vertical levels of output grid
131  !****************************************
132
133  if (readerror.ne.0) then
134    j=0
135100 j=j+1
136    do i=1,3
137      read(unitoutgrid,*,end=99)
138    end do
139    read(unitoutgrid,'(4x,f7.1)',end=99) outhelp
140    if (outhelp.eq.0.) goto 99
141    goto 100
14299  numzgrid=j-1
143  else
144    do i=1,maxoutlev
145      if (outheights(i).lt.0) exit
146    end do
147    numzgrid=i-1
148  end if
149
150  allocate(outheight(numzgrid),stat=stat)
151  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheight'
152  allocate(outheighthalf(numzgrid),stat=stat)
153  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheighthalf'
154
155  ! 2. Vertical levels of output grid
156  !**********************************
157
158  if (readerror.ne.0) then
159
160    rewind(unitoutgrid)
161    call skplin(29,unitoutgrid)
162
163    do j=1,numzgrid
164      do i=1,3
165        read(unitoutgrid,*)
166      end do
167      read(unitoutgrid,'(4x,f7.1)') outhelp
168      outheight(j)=outhelp
169      outheights(j)=outhelp
170    end do
171    close(unitoutgrid)
172
173  else
174
175    do j=1,numzgrid
176      outheight(j)=outheights(j)
177    end do
178
179  endif
180
181  ! write outgrid file in namelist format to output directory if requested
182  if (nmlout.eqv..true.) then
183    ! reallocate outheights with actually required dimension for namelist writing
184    deallocate(outheights)
185    allocate(outheights(numzgrid),stat=stat)
186    if (stat.ne.0) write(*,*)'ERROR: could not allocate outheights'
187
188    do j=1,numzgrid
189      outheights(j)=outheight(j)
190    end do
191
192    open(unitoutgrid,file=path(2)(1:length(2))//'OUTGRID.namelist',err=1000)
193    write(unitoutgrid,nml=outgrid)
194    close(unitoutgrid)
195  endif
196
197  ! Check whether vertical levels are specified in ascending order
198  !***************************************************************
199
200  do j=2,numzgrid
201    if (outheight(j).le.outheight(j-1)) then
202    write(*,*) ' #### FLEXPART MODEL ERROR! YOUR SPECIFICATION#### '
203    write(*,*) ' #### OF OUTPUT LEVELS IS CORRUPT AT LEVEL    #### '
204    write(*,*) ' #### ',j,'                              #### '
205    write(*,*) ' #### PLEASE MAKE CHANGES IN FILE OUTGRID.    #### '
206    endif
207  end do
208
209  ! Determine the half levels, i.e. middle levels of the output grid
210  !*****************************************************************
211
212  outheighthalf(1)=outheight(1)/2.
213  do j=2,numzgrid
214    outheighthalf(j)=(outheight(j-1)+outheight(j))/2.
215  end do
216
217  xoutshift=xlon0-outlon0
218  youtshift=ylat0-outlat0
219
220  allocate(oroout(0:numxgrid-1,0:numygrid-1),stat=stat)
221  if (stat.ne.0) write(*,*)'ERROR: could not allocate oroout'
222  allocate(area(0:numxgrid-1,0:numygrid-1),stat=stat)
223  if (stat.ne.0) write(*,*)'ERROR: could not allocate area'
224  allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
225  if (stat.ne.0) write(*,*)'ERROR: could not allocate volume'
226  allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
227  if (stat.ne.0) write(*,*)'ERROR: could not allocate areaeast'
228  allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
229  if (stat.ne.0) write(*,*)'ERROR: could not allocate areanorth'
230  return
231
232
233999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
234  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
235  write(*,'(a)') path(1)(1:length(1))
236  stop
237
2381000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
239  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
240  write(*,'(a)') path(2)(1:length(2))
241  stop
242
243end subroutine readoutgrid
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG