Context Navigation

readavailable.f90 @ b398fb6

FPv9.3.1FPv9.3.1b_testingFPv9.3.2fp9.3.1-20161214-nc4grib2nc4_repair

Last change on this file since b398fb6 was 496c607, checked in by Don Morton <Don.Morton@…>, 8 years ago

Initial commit of FPv9.3.1

Currently, this is a clone of snapshot FPv9.3.0

Property mode set to 100644

File size: 11.2 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
22	subroutine 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	real(kind=dp) :: juldate,jul,beg,end
66	character(len=255) :: fname,spec,wfname1(maxwf),wfspec1(maxwf)
67	character(len=255) :: wfname1n(maxnests,maxwf)
68	character(len=40) :: wfspec1n(maxnests,maxwf)
69
70
71	! Windfields are only used, if they are within the modelling period.
72	! However, 1 additional day at the beginning and at the end is used for
73	! interpolation. -> Compute beginning and ending date for the windfields.
74	!************************************************************************
75	if (ideltas.gt.0) then ! forward trajectories
76	beg=bdate-1._dp
77	end=bdate+real(ideltas,kind=dp)/86400._dp+real(idiffmax,kind=dp)/ &
78	86400._dp
79	else ! backward trajectories
80	beg=bdate+real(ideltas,kind=dp)/86400._dp-real(idiffmax,kind=dp)/ &
81	86400._dp
82	end=bdate+1._dp
83	endif
84
85	! Open the wind field availability file and read available wind fields
86	! within the modelling period.
87	!*********************************************************************
88
89	open(unitavailab,file=path(4)(1:length(4)),status='old', &
90	err=999)
91
92	do i=1,3
93	read(unitavailab,*)
94	end do
95
96	numbwf=0
97	100 read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=99) &
98	ldat,ltim,fname,spec
99	jul=juldate(ldat,ltim)
100	if ((jul.ge.beg).and.(jul.le.end)) then
101	numbwf=numbwf+1
102	if (numbwf.gt.maxwf) then ! check exceedance of dimension
103	write(,) 'Number of wind fields needed is too great.'
104	write(,) 'Reduce modelling period (file "COMMAND") or'
105	write(,) 'reduce number of wind fields (file "AVAILABLE").'
106	stop
107	endif
108
109	wfname1(numbwf)=fname(1:index(fname,' '))
110	wfspec1(numbwf)=spec
111	wftime1(numbwf)=nint((jul-bdate)*86400._dp)
112	endif
113	goto 100 ! next wind field
114
115	99 continue
116
117	close(unitavailab)
118
119	! Open the wind field availability file and read available wind fields
120	! within the modelling period (nested grids)
121	!*********************************************************************
122
123	do k=1,numbnests
124	open(unitavailab,file=path(numpath+2*(k-1)+2) &
125	(1:length(numpath+2*(k-1)+2)),status='old',err=998)
126
127	do i=1,3
128	read(unitavailab,*)
129	end do
130
131	numbwfn(k)=0
132	700 read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=699) ldat, &
133	ltim,fname,spec
134	jul=juldate(ldat,ltim)
135	if ((jul.ge.beg).and.(jul.le.end)) then
136	numbwfn(k)=numbwfn(k)+1
137	if (numbwfn(k).gt.maxwf) then ! check exceedance of dimension
138	write(,) 'Number of nested wind fields is too great.'
139	write(,) 'Reduce modelling period (file "COMMAND") or'
140	write(,) 'reduce number of wind fields (file "AVAILABLE").'
141	stop
142	endif
143
144	wfname1n(k,numbwfn(k))=fname
145	wfspec1n(k,numbwfn(k))=spec
146	wftime1n(k,numbwfn(k))=nint((jul-bdate)*86400._dp)
147	endif
148	goto 700 ! next wind field
149
150	699 continue
151
152	close(unitavailab)
153	end do
154
155
156	! Check wind field times of file AVAILABLE (expected to be in temporal order)
157	!****************************************************************************
158
159	if (numbwf.eq.0) then
160	write(,) ' #### FLEXPART MODEL ERROR! NO WIND FIELDS #### '
161	write(,) ' #### AVAILABLE FOR SELECTED TIME PERIOD. #### '
162	stop
163	endif
164
165	do i=2,numbwf
166	if (wftime1(i).le.wftime1(i-1)) then
167	write(,) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT.'
168	write(,) 'THE WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
169	write(,) 'PLEASE CHECK FIELD ',wfname1(i)
170	stop
171	endif
172	end do
173
174	! Check wind field times of file AVAILABLE for the nested fields
175	! (expected to be in temporal order)
176	!***************************************************************
177
178	do k=1,numbnests
179	if (numbwfn(k).eq.0) then
180	write(,) '#### FLEXPART MODEL ERROR! NO WIND FIELDS ####'
181	write(,) '#### AVAILABLE FOR SELECTED TIME PERIOD. ####'
182	stop
183	endif
184
185	do i=2,numbwfn(k)
186	if (wftime1n(k,i).le.wftime1n(k,i-1)) then
187	write(,) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT. '
188	write(,) 'THE NESTED WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
189	write(,) 'PLEASE CHECK FIELD ',wfname1n(k,i)
190	write(,) 'AT NESTING LEVEL ',k
191	stop
192	endif
193	end do
194
195	end do
196
197
198	! For backward trajectories, reverse the order of the windfields
199	!***************************************************************
200
201	if (ideltas.ge.0) then
202	do i=1,numbwf
203	wfname(i)=wfname1(i)
204	wfspec(i)=wfspec1(i)
205	wftime(i)=wftime1(i)
206	end do
207	do k=1,numbnests
208	do i=1,numbwfn(k)
209	wfnamen(k,i)=wfname1n(k,i)
210	wfspecn(k,i)=wfspec1n(k,i)
211	wftimen(k,i)=wftime1n(k,i)
212	end do
213	end do
214	else
215	do i=1,numbwf
216	wfname(numbwf-i+1)=wfname1(i)
217	wfspec(numbwf-i+1)=wfspec1(i)
218	wftime(numbwf-i+1)=wftime1(i)
219	end do
220	do k=1,numbnests
221	do i=1,numbwfn(k)
222	wfnamen(k,numbwfn(k)-i+1)=wfname1n(k,i)
223	wfspecn(k,numbwfn(k)-i+1)=wfspec1n(k,i)
224	wftimen(k,numbwfn(k)-i+1)=wftime1n(k,i)
225	end do
226	end do
227	endif
228
229	! Check the time difference between the wind fields. If it is big,
230	! write a warning message. If it is too big, terminate the trajectory.
231	!*********************************************************************
232
233	do i=2,numbwf
234	idiff=abs(wftime(i)-wftime(i-1))
235	if (idiff.gt.idiffmax) then
236	write(,) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
237	write(,) 'WIND FIELDS IS TOO BIG FOR TRANSPORT CALCULATION.&
238	&'
239	write(,) 'THEREFORE, TRAJECTORIES HAVE TO BE SKIPPED.'
240	else if (idiff.gt.idiffnorm) then
241	write(,) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
242	write(,) 'WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION'
243	write(,) 'OF SIMULATION QUALITY.'
244	endif
245	end do
246
247	do k=1,numbnests
248	if (numbwfn(k).ne.numbwf) then
249	write(,) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
250	write(,) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
251	write(,) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN. '
252	write(,) 'ERROR AT NEST LEVEL: ',k
253	stop
254	endif
255	do i=1,numbwf
256	if (wftimen(k,i).ne.wftime(i)) then
257	write(,) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
258	write(,) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
259	write(,) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN. '
260	write(,) 'ERROR AT NEST LEVEL: ',k
261	stop
262	endif
263	end do
264	end do
265
266	! Reset the times of the wind fields that are kept in memory to no time
267	!**********************************************************************
268
269	do i=1,2
270	memind(i)=i
271	memtime(i)=999999999
272	end do
273
274	return
275
276	998 write(,) ' #### FLEXPART MODEL ERROR! FILE #### '
277	write(,'(a)') ' '//path(numpath+2(k-1)+2) &
278	(1:length(numpath+2*(k-1)+2))
279	write(,) ' #### CANNOT BE OPENED #### '
280	stop
281
282	999 write(,) ' #### FLEXPART MODEL ERROR! FILE #### '
283	write(*,'(a)') ' '//path(4)(1:length(4))
284	write(,) ' #### CANNOT BE OPENED #### '
285	stop
286
287	end subroutine readavailable

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format