source: flexpart.git/src/readavailable.f90 @ 02095e3

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie
Last change on this file since 02095e3 was b5127f9, checked in by Espen Sollum ATMOS <eso@…>, 7 years ago

Fixed an inconsistency (serial vs parallel) with domain-filling option

  • Property mode set to 100644
File size: 11.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 readavailable
23
24  !*****************************************************************************
25  !                                                                            *
26  !   This routine reads the dates and times for which windfields are          *
27  !   available.                                                               *
28  !                                                                            *
29  !     Authors: A. Stohl                                                      *
30  !                                                                            *
31  !     6 February 1994                                                        *
32  !     8 February 1999, Use of nested fields, A. Stohl                        *
33  !                                                                            *
34  !*****************************************************************************
35  !                                                                            *
36  ! Variables:                                                                 *
37  ! bdate                beginning date as Julian date                         *
38  ! beg                  beginning date for windfields                         *
39  ! end                  ending date for windfields                            *
40  ! fname                filename of wind field, help variable                 *
41  ! ideltas [s]          duration of modelling period                          *
42  ! idiff                time difference between 2 wind fields                 *
43  ! idiffnorm            normal time difference between 2 wind fields          *
44  ! idiffmax [s]         maximum allowable time between 2 wind fields          *
45  ! jul                  julian date, help variable                            *
46  ! numbwf               actual number of wind fields                          *
47  ! wfname(maxwf)        file names of needed wind fields                      *
48  ! wfspec(maxwf)        file specifications of wind fields (e.g., if on disc) *
49  ! wftime(maxwf) [s]times of wind fields relative to beginning time           *
50  ! wfname1,wfspec1,wftime1 = same as above, but only local (help variables)   *
51  !                                                                            *
52  ! Constants:                                                                 *
53  ! maxwf                maximum number of wind fields                         *
54  ! unitavailab          unit connected to file AVAILABLE                      *
55  !                                                                            *
56  !*****************************************************************************
57
58  use par_mod
59  use com_mod
60
61  implicit none
62
63  integer :: i,idiff,ldat,ltim,wftime1(maxwf),numbwfn(maxnests),k
64  integer :: wftime1n(maxnests,maxwf),wftimen(maxnests,maxwf)
65  logical :: lwarntd=.true.
66  real(kind=dp) :: juldate,jul,beg,end
67  character(len=255) :: fname,spec,wfname1(maxwf),wfspec1(maxwf)
68  character(len=255) :: wfname1n(maxnests,maxwf)
69  character(len=40) :: wfspec1n(maxnests,maxwf)
70
71
72  ! Windfields are only used, if they are within the modelling period.
73  ! However, 1 additional day at the beginning and at the end is used for
74  ! interpolation. -> Compute beginning and ending date for the windfields.
75  !************************************************************************
76
77  if (ideltas.gt.0) then         ! forward trajectories
78    beg=bdate-1._dp
79    end=bdate+real(ideltas,kind=dp)/86400._dp+real(idiffmax,kind=dp)/ &
80         86400._dp
81  else                           ! backward trajectories
82    beg=bdate+real(ideltas,kind=dp)/86400._dp-real(idiffmax,kind=dp)/ &
83         86400._dp
84    end=bdate+1._dp
85  endif
86
87  ! Open the wind field availability file and read available wind fields
88  ! within the modelling period.
89  !*********************************************************************
90
91  open(unitavailab,file=path(4)(1:length(4)),status='old', &
92       err=999)
93
94  do i=1,3
95    read(unitavailab,*)
96  end do
97
98  numbwf=0
99100   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=99) &
100           ldat,ltim,fname,spec
101    jul=juldate(ldat,ltim)
102    if ((jul.ge.beg).and.(jul.le.end)) then
103      numbwf=numbwf+1
104      if (numbwf.gt.maxwf) then      ! check exceedance of dimension
105       write(*,*) 'Number of wind fields needed is too great.'
106       write(*,*) 'Reduce modelling period (file "COMMAND") or'
107       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
108       stop
109      endif
110
111      wfname1(numbwf)=fname(1:index(fname,' '))
112      wfspec1(numbwf)=spec
113      wftime1(numbwf)=nint((jul-bdate)*86400._dp)
114    endif
115    goto 100       ! next wind field
116
11799   continue
118
119  close(unitavailab)
120
121  ! Open the wind field availability file and read available wind fields
122  ! within the modelling period (nested grids)
123  !*********************************************************************
124
125  do k=1,numbnests
126  !print*,length(numpath+2*(k-1)+1),length(numpath+2*(k-1)+2),length(4),length(3)
127  !print*,path(numpath+2*(k-1)+2)(1:length(numpath+2*(k-1)+2))
128    open(unitavailab,file=path(numpath+2*(k-1)+2) &
129         (1:length(numpath+2*(k-1)+2)),status='old',err=998)
130
131    do i=1,3
132      read(unitavailab,*)
133    end do
134
135    numbwfn(k)=0
136700   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=699) ldat, &
137           ltim,fname,spec
138      jul=juldate(ldat,ltim)
139      if ((jul.ge.beg).and.(jul.le.end)) then
140        numbwfn(k)=numbwfn(k)+1
141        if (numbwfn(k).gt.maxwf) then      ! check exceedance of dimension
142       write(*,*) 'Number of nested wind fields is too great.'
143       write(*,*) 'Reduce modelling period (file "COMMAND") or'
144       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
145          stop
146        endif
147
148        wfname1n(k,numbwfn(k))=fname
149        wfspec1n(k,numbwfn(k))=spec
150        wftime1n(k,numbwfn(k))=nint((jul-bdate)*86400._dp)
151      endif
152      goto 700       ! next wind field
153
154699   continue
155
156    close(unitavailab)
157  end do
158
159
160  ! Check wind field times of file AVAILABLE (expected to be in temporal order)
161  !****************************************************************************
162
163  if (numbwf.eq.0) then
164    write(*,*) ' #### FLEXPART MODEL ERROR! NO WIND FIELDS    #### '
165    write(*,*) ' #### AVAILABLE FOR SELECTED TIME PERIOD.     #### '
166    stop
167  endif
168
169  do i=2,numbwf
170    if (wftime1(i).le.wftime1(i-1)) then
171      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT.'
172      write(*,*) 'THE WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
173      write(*,*) 'PLEASE CHECK FIELD ',wfname1(i)
174      stop
175    endif
176  end do
177
178  ! Check wind field times of file AVAILABLE for the nested fields
179  ! (expected to be in temporal order)
180  !***************************************************************
181
182  do k=1,numbnests
183    if (numbwfn(k).eq.0) then
184      write(*,*) '#### FLEXPART MODEL ERROR! NO WIND FIELDS  ####'
185      write(*,*) '#### AVAILABLE FOR SELECTED TIME PERIOD.   ####'
186      stop
187    endif
188
189    do i=2,numbwfn(k)
190      if (wftime1n(k,i).le.wftime1n(k,i-1)) then
191      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT. '
192      write(*,*) 'THE NESTED WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
193      write(*,*) 'PLEASE CHECK FIELD ',wfname1n(k,i)
194      write(*,*) 'AT NESTING LEVEL ',k
195      stop
196      endif
197    end do
198
199  end do
200
201
202  ! For backward trajectories, reverse the order of the windfields
203  !***************************************************************
204
205  if (ideltas.ge.0) then
206    do i=1,numbwf
207      wfname(i)=wfname1(i)
208      wfspec(i)=wfspec1(i)
209      wftime(i)=wftime1(i)
210    end do
211    do k=1,numbnests
212      do i=1,numbwfn(k)
213        wfnamen(k,i)=wfname1n(k,i)
214        wfspecn(k,i)=wfspec1n(k,i)
215        wftimen(k,i)=wftime1n(k,i)
216      end do
217    end do
218  else
219    do i=1,numbwf
220      wfname(numbwf-i+1)=wfname1(i)
221      wfspec(numbwf-i+1)=wfspec1(i)
222      wftime(numbwf-i+1)=wftime1(i)
223    end do
224    do k=1,numbnests
225      do i=1,numbwfn(k)
226        wfnamen(k,numbwfn(k)-i+1)=wfname1n(k,i)
227        wfspecn(k,numbwfn(k)-i+1)=wfspec1n(k,i)
228        wftimen(k,numbwfn(k)-i+1)=wftime1n(k,i)
229      end do
230    end do
231  endif
232
233  ! Check the time difference between the wind fields. If it is big,
234  ! write a warning message. If it is too big, terminate the trajectory.
235  !*********************************************************************
236
237  do i=2,numbwf
238    idiff=abs(wftime(i)-wftime(i-1))
239    if (idiff.gt.idiffmax.and.lroot) then
240      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
241      write(*,*) 'WIND FIELDS IS TOO BIG FOR TRANSPORT CALCULATION.&
242           &'
243      write(*,*) 'THEREFORE, TRAJECTORIES HAVE TO BE SKIPPED.'
244    else if (idiff.gt.idiffnorm.and.lroot.and.lwarntd) then
245      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
246      write(*,*) 'WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION'
247      write(*,*) 'OF SIMULATION QUALITY.'
248      lwarntd=.false. ! only issue this warning once
249    endif
250  end do
251
252  do k=1,numbnests
253    if (numbwfn(k).ne.numbwf) then
254      write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
255      write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
256      write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
257      write(*,*) 'ERROR AT NEST LEVEL: ',k
258      stop
259    endif
260    do i=1,numbwf
261      if (wftimen(k,i).ne.wftime(i)) then
262        write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
263        write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
264        write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
265        write(*,*) 'ERROR AT NEST LEVEL: ',k
266        stop
267      endif
268    end do
269  end do
270
271  ! Reset the times of the wind fields that are kept in memory to no time
272  !**********************************************************************
273
274  do i=1,2
275    memind(i)=i
276    memtime(i)=999999999
277  end do
278
279  return
280
281998   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE FILE   #### '
282  write(*,'(a)') '     '//path(numpath+2*(k-1)+2) &
283       (1:length(numpath+2*(k-1)+2))
284  write(*,*) ' #### CANNOT BE OPENED             #### '
285  stop
286
287999   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE FILE #### '
288  write(*,'(a)') '     '//path(4)(1:length(4))
289  write(*,*) ' #### CANNOT BE OPENED           #### '
290  stop
291
292end subroutine readavailable
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG