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)
75 if (ideltas.gt.0)
then
77 end=bdate+
real(ideltas,kind=dp)/86400._dp+
real(idiffmax,kind=dp)/ &
80 beg=bdate+
real(ideltas,kind=dp)/86400._dp-
real(idiffmax,kind=dp)/ &
89 open(unitavailab,file=path(4)(1:length(4)),status=
'old', &
97 100
read(unitavailab,
'(i8,1x,i6,2(6x,a255))',end=99) &
100 if ((jul.ge.beg).and.(jul.le.end))
then
102 if (numbwf.gt.maxwf)
then
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").'
109 wfname1(numbwf)=fname(1:index(fname,
' '))
111 wftime1(numbwf)=nint((jul-bdate)*86400._dp)
124 open(unitavailab,file=path(numpath+2*(k-1)+2) &
125 (1:length(numpath+2*(k-1)+2)),status=
'old',err=998)
132 700
read(unitavailab,
'(i8,1x,i6,2(6x,a255))',end=699) ldat, &
135 if ((jul.ge.beg).and.(jul.le.end))
then
136 numbwfn(k)=numbwfn(k)+1
137 if (numbwfn(k).gt.maxwf)
then
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").'
144 wfname1n(k,numbwfn(k))=fname
145 wfspec1n(k,numbwfn(k))=spec
146 wftime1n(k,numbwfn(k))=nint((jul-bdate)*86400._dp)
159 if (numbwf.eq.0)
then
160 write(*,*)
' #### FLEXPART MODEL ERROR! NO WIND FIELDS #### '
161 write(*,*)
' #### AVAILABLE FOR SELECTED TIME PERIOD. #### '
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)
179 if (numbwfn(k).eq.0)
then
180 write(*,*)
'#### FLEXPART MODEL ERROR! NO WIND FIELDS ####'
181 write(*,*)
'#### AVAILABLE FOR SELECTED TIME PERIOD. ####'
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
201 if (ideltas.ge.0)
then
209 wfnamen(k,i)=wfname1n(k,i)
210 wfspecn(k,i)=wfspec1n(k,i)
211 wftimen(k,i)=wftime1n(k,i)
216 wfname(numbwf-i+1)=wfname1(i)
217 wfspec(numbwf-i+1)=wfspec1(i)
218 wftime(numbwf-i+1)=wftime1(i)
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)
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.&
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.'
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
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
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 #### '
282 999
write(*,*)
' #### FLEXPART MODEL ERROR! FILE #### '
283 write(*,
'(a)')
' '//path(4)(1:length(4))
284 write(*,*)
' #### CANNOT BE OPENED #### '
real(kind=dp) function juldate(yyyymmdd, hhmiss)