Context Navigation

readavailable.f90 @ 4

Last change on this file since 4 was 4, checked in by mlanger, 12 years ago

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

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

Download in other formats:

Original Format