source: flexpart.git/src/readoutgrid.f90 @ d7935de

univie
Last change on this file since d7935de was d7935de, checked in by pesei <petra seibert at univie ac at>, 6 years ago

modify most input read subroutines

changed some variable names (mostly for I-N reasons)
includes two names appearing also in timemanager, com_mod
corrected a few mistakes
simplified some parts of code
changed options/RELEASES which is in nml fmt correspondingly
  • Property mode set to 100644
File size: 8.4 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: Add optional namelist input                          *
32  !     PS, 6/2015-9/2018: read regular input with free format                 *
33  !       simplify code and rename some variables                              *
34  !                                                                            *
35  !*****************************************************************************
36  !                                                                            *
37  ! Variables:                                                                 *
38  ! dxout,dyout          grid distance                                         *
39  ! numxgrid,numygrid,numzgrid    grid dimensions                              *
40  ! outlon0,outlat0      lower left corner of grid                             *
41  ! outheight(maxzgrid)  height levels of output grid [m]                      *
42  !                                                                            *
43  ! Constants:                                                                 *
44  ! unitoutgrid          unit connected to file OUTGRID                        *
45  !                                                                            *
46  !*****************************************************************************
47
48  use outg_mod
49  use par_mod
50  use com_mod
51
52  implicit none
53
54  integer :: i,kz,istat
55  real :: xr,xr1,yr,yr1
56  real,parameter :: eps=1.e-4
57
58  ! namelist variables
59  integer, parameter :: maxoutlev=500
60  integer :: ios
61  real,allocatable, dimension (:) :: outheights,outaux
62  logical :: lnml
63
64  ! declare namelist
65  namelist /nml_outgrid/ &
66    outlon0,outlat0, &
67    numxgrid,numygrid, &
68    dxout,dyout, &
69    outheight
70
71! allocate outheights for nml read with max dimension
72  allocate(outheights(maxoutlev),outaux(maxoutlev),stat=istat)
73  if (istat .ne. 0) write(*,*)'ERROR: could not allocate outheights'
74
75  ! Open the OUTGRID file and read output grid specifications
76  !**********************************************************
77
78  outheight(:) = -999. ! initialise for later finding #valid levels
79  open(unitoutgrid,file=trim(path(1))//'OUTGRID',status='old',&
80    form='formatted',err=999)
81
82  ! try namelist input
83  read(unitoutgrid,nml_outgrid,iostat=ios)
84  close(unitoutgrid)
85
86  if (ios .eq. 0) then ! namelist works
87
88    lnml = .true.
89
90  else ! read as regular text
91
92    lnml = .false.
93
94    open(unitoutgrid,file=trim(path(1))//'OUTGRID',status='old',err=999)
95    call skplin(5,unitoutgrid)
96
97   ! Read horizontal grid specifications
98    !****************************************
99
100    call skplin(3,unitoutgrid)
101    read(unitoutgrid,*) outlon0
102    call skplin(3,unitoutgrid)
103    read(unitoutgrid,*) outlat0
104    call skplin(3,unitoutgrid)
105    read(unitoutgrid,*) numxgrid
106    call skplin(3,unitoutgrid)
107    read(unitoutgrid,*) numygrid
108    call skplin(3,unitoutgrid)
109    read(unitoutgrid,*) dxout
110    call skplin(3,unitoutgrid)
111    read(unitoutgrid,*) dyout
112
113  endif ! read OUTGRID file
114
115  ! Check validity of output grid (shall be within model domain)
116  !*************************************************************
117
118  xr=outlon0+real(numxgrid)*dxout
119  yr=outlat0+real(numygrid)*dyout
120  xr1=xlon0+real(nxmin1)*dx
121  yr1=ylat0+real(nymin1)*dy
122  if ((outlon0+eps.lt.xlon0).or.(outlat0+eps.lt.ylat0) &
123       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
124    write(*,*) outlon0,outlat0
125    write(*,*) xr1,yr1,xlon0,ylat0,xr,yr,dxout,dyout
126    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
127    write(*,*) ' #### GRID IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
128    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
129    write(*,'(a)') trim(path(1))
130    stop
131  endif
132
133! Read (if .not. lmnl) and count vertical levels of output grid
134!**************************************************************
135
136  do kz = 1,maxoutlev
137    if (lnml) then ! we have read them already
138      if (outheight(kz) .lt. 0.) exit ! 1st nondefined level
139    else
140      call skplin(3,unitoutgrid)
141      read(unitoutgrid,*,end=10) outheight(kz)
142    endif
143  end do
14410 continue 
145
146  numzgrid = kz - 1 ! number of outgrid levels
147
148! allocate the required length only, shuffle data 
149  outaux = outheight ! shuffle
150
151  deallocate(outheights)
152  allocate(outheight(numzgrid),outheighthalf(numzgrid),stat=istat)
153  if (istat .ne. 0) then
154    write(*,*) 'ERROR: could not allocate outheight and outheighthalf'
155    stop 'readoutgrid error'
156  endif
157
158  outheight=outaux(1:numzgrid) ! shuffle back
159  deallocate (outaux)
160
161! write outgrid file in namelist format to output directory if requested
162  if (nmlout) then
163    open(unitoutgrid,file=trim(path(2))//'OUTGRID.namelist',err=1000)
164    write(unitoutgrid,nml=nml_outgrid)
165    close(unitoutgrid)
166  endif
167
168  ! Check whether vertical levels are specified in ascending order
169  !***************************************************************
170
171  do kz=2,numzgrid
172    if (outheight(kz) .le. outheight(kz-1)) goto 998
173  end do
174
175  ! Determine the half levels, i.e. middle levels of the output grid
176  !*****************************************************************
177
178  outheighthalf(1) = 0.5*outheight(1)
179  do kz = 2,numzgrid
180    outheighthalf(kz) = 0.5*(outheight(kz-1)+outheight(kz))
181  end do
182
183  xoutshift=xlon0-outlon0
184  youtshift=ylat0-outlat0
185
186  allocate(oroout(0:numxgrid-1,0:numygrid-1),stat=istat)
187  if (istat .ne. 0) write(*,*)'ERROR: could not allocate oroout'
188  allocate(area(0:numxgrid-1,0:numygrid-1),stat=istat)
189  if (istat .ne. 0) write(*,*)'ERROR: could not allocate area'
190  allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid),stat=istat)
191  if (istat .ne. 0) write(*,*)'ERROR: could not allocate volume'
192  allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid),stat=istat)
193  if (istat .ne. 0) write(*,*)'ERROR: could not allocate areaeast'
194  allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid),stat=istat)
195  if (istat .ne. 0) write(*,*)'ERROR: could not allocate areanorth'
196 
197  return
198
199998 continue
200  write(*,*) ' #### FLEXPART MODEL ERROR! YOUR SPECIFICATION#### '
201  write(*,*) ' #### OF OUTPUT LEVELS NOT INCREASING AT LEVEL#### '
202  write(*,*) ' #### ',kz,'                                  #### '
203  write(*,*) ' #### PLEASE MAKE CHANGES IN FILE OUTGRID.    #### '
204  STOP 'readoutgrid error'
205
206999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
207  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
208  write(*,'(a)') trim(path(1))
209  stop
210
2111000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
212  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
213  write(*,'(a)') trim(path(2))
214  stop
215
216end subroutine readoutgrid
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG