85 real(kind=4) :: xaux1,xaux2,yaux1,yaux2
86 real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
87 integer :: gribver,parcat,parnum,typsurf,valsurf,discipl
92 integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
93 real :: sizesouth,sizenorth,xauxa,pint
103 integer :: isec1(56),isec2(22+nxmax+nymax)
104 real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
106 real(kind=4) :: conversion_factor
108 character(len=1) :: opt
111 character(len=24) :: griberrormsg =
'Error reading grib file'
112 character(len=20) :: gribfunction =
'gridcheck'
121 character(LEN=255),
parameter :: vtable_ecmwf_grib1_path = &
122 "Vtable_ecmwf_grib1", &
123 vtable_ecmwf_grib2_path = &
124 "Vtable_ecmwf_grib2", &
125 vtable_ecmwf_grib1_2_path = &
126 "Vtable_ecmwf_grib1_2"
128 integer :: gribfile_type
129 integer :: current_grib_level
130 character(len=255) :: gribfile_name
131 character(len=255) :: vtable_path
132 character(len=15) :: fpname
146 if(ideltas.gt.0)
then
156 gribfile_name = path(3)(1:length(3))//trim(wfname(ifn))
157 print *,
'gribfile_name: ', gribfile_name
161 print *,
'gribfile_type: ', gribfile_type
163 if (gribfile_type .eq. vtable_gribfile_type_ecmwf_grib1)
then
164 vtable_path = vtable_ecmwf_grib1_path
165 else if (gribfile_type .eq. vtable_gribfile_type_ecmwf_grib2)
then
166 vtable_path = vtable_ecmwf_grib2_path
167 else if (gribfile_type .eq. vtable_gribfile_type_ecmwf_grib1_2)
then
168 vtable_path = vtable_ecmwf_grib1_2_path
170 print *,
'Unsupported gribfile_type: ', gribfile_type
176 print *,
'Loading Vtable: ', vtable_path
178 print *,
'Vtable Initialized: ', my_vtable%initialized
179 print *,
'Vtable num_entries: ', my_vtable%num_entries
189 5 call grib_open_file(ifile,path(3)(1:length(3)) &
190 //trim(wfname(ifn)),
'r',iret)
191 if (iret.ne.grib_success)
then
204 call grib_new_from_file(ifile,igrib,iret)
205 if (iret.eq.grib_end_of_file )
then
207 elseif (iret.ne.grib_success)
then
225 conversion_factor=1.0
229 call grib_get_int(igrib,
'editionNumber',gribver,iret)
230 call grib_check(iret,gribfunction,griberrormsg)
233 if (gribver.eq.1)
then
237 call grib_get_int(igrib,
'level', current_grib_level, iret)
238 call grib_check(iret,gribfunction,griberrormsg)
243 call
grib2check(igrib, fpname, conversion_factor)
246 call grib_get_int(igrib,
'level', current_grib_level, iret)
247 call grib_check(iret,gribfunction,griberrormsg)
252 if (trim(fpname) .ne.
'None')
then
253 call grib_get_real4_array(igrib,
'values',zsec4,iret)
255 zsec4=zsec4/conversion_factor
257 call grib_check(iret,gribfunction,griberrormsg)
260 if (ifield.eq.1)
then
263 call grib_get_int(igrib,
'numberOfPointsAlongAParallel', &
265 call grib_check(iret,gribfunction,griberrormsg)
266 call grib_get_int(igrib,
'numberOfPointsAlongAMeridian', &
268 call grib_check(iret,gribfunction,griberrormsg)
269 call grib_get_real8(igrib,
'longitudeOfFirstGridPointInDegrees', &
271 call grib_check(iret,gribfunction,griberrormsg)
272 call grib_get_int(igrib,
'numberOfVerticalCoordinateValues', &
274 call grib_check(iret,gribfunction,griberrormsg)
277 call grib_get_real4_array(igrib,
'pv',zsec2,iret)
278 call grib_check(iret,gribfunction,griberrormsg)
282 nlev_ec=isec2(12)/2-1
287 if (gotgrid.eq.0)
then
292 if (gotgrid.eq.0)
then
294 call grib_get_real8(igrib,
'longitudeOfLastGridPointInDegrees', &
296 call grib_check(iret,gribfunction,griberrormsg)
297 call grib_get_real8(igrib,
'latitudeOfLastGridPointInDegrees', &
299 call grib_check(iret,gribfunction,griberrormsg)
300 call grib_get_real8(igrib,
'latitudeOfFirstGridPointInDegrees', &
302 call grib_check(iret,gribfunction,griberrormsg)
308 if (xaux1.ge.180.) xaux1=xaux1-360.0
310 if (xaux1.gt.180.) xaux1=xaux1-360.0
312 if (xaux2.gt.180.) xaux2=xaux2-360.0
313 if (xaux1.lt.-180.) xaux1=xaux1+360.0
314 if (xaux2.lt.-180.) xaux2=xaux2+360.0
315 if (xaux2.lt.xaux1) xaux2=xaux2+360.0
318 dx=(xaux2-xaux1)/
real(nxfield-1)
319 dy=(yaux2-yaux1)/
real(ny-1)
320 dxconst=180./(dx*r_earth*pi)
321 dyconst=180./(dy*r_earth*pi)
329 xauxa=abs(xaux2+dx-360.-xaux1)
330 if (xauxa.lt.0.001)
then
333 if (abs(nxshift).ge.nx) &
334 stop
'nxshift in file par_mod is too large'
335 xlon0=xlon0+
real(nxshift)*dx
340 stop
'nxshift (par_mod) must be zero for non-global domain'
344 if (xlon0.gt.180.) xlon0=xlon0-360.
346 if (xglobal.and.xauxa.lt.0.001)
then
350 sizesouth=6.*(switchsouth+90.)/dy
351 call
stlmbr(southpolemap,-90.,0.)
352 call
stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
353 sizesouth,switchsouth,180.)
354 switchsouthg=(switchsouth-ylat0)/dy
360 if (xglobal.and.xauxa.lt.0.001)
then
364 sizenorth=6.*(90.-switchnorth)/dy
365 call
stlmbr(northpolemap,90.,0.)
366 call
stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
367 sizenorth,switchnorth,180.)
368 switchnorthg=(switchnorth-ylat0)/dy
374 stop
'nxshift (par_mod) must not be negative'
375 if (nxshift.ge.nxfield) stop
'nxshift (par_mod) too large'
379 if(trim(fpname) .eq.
'UU') iumax=max(iumax,nlev_ec-k+1)
380 if(trim(fpname) .eq.
'ETADOT') iwmax=max(iwmax,nlev_ec-k+1)
382 if(trim(fpname) .eq.
'ORO')
then
385 oro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)/ga
389 if(trim(fpname) .eq.
'LSM')
then
392 lsm(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
396 if(trim(fpname) .eq.
'EXCESSORO')
then
399 excessoro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
404 call grib_release(igrib)
410 30 call grib_close_file(ifile)
414 if (gotgrid.eq.0)
then
415 print*,
'***gridcheck() ERROR: no fields found with correct first longitude'// &
422 if(nuvz.eq.nlev_ec) nwz=nlev_ec+1
424 if (nx.gt.nxmax)
then
425 write(*,*)
'FLEXPART error: Too many grid points in x direction.'
426 write(*,*)
'Reduce resolution of wind fields.'
427 write(*,*)
'Or change parameter settings in file par_mod.'
432 if (ny.gt.nymax)
then
433 write(*,*)
'FLEXPART error: Too many grid points in y direction.'
434 write(*,*)
'Reduce resolution of wind fields.'
435 write(*,*)
'Or change parameter settings in file par_mod.'
440 if (nuvz+1.gt.nuvzmax)
then
441 write(*,*)
'FLEXPART error: Too many u,v grid points in z '// &
443 write(*,*)
'Reduce resolution of wind fields.'
444 write(*,*)
'Or change parameter settings in file par_mod.'
445 write(*,*) nuvz+1,nuvzmax
449 if (nwz.gt.nwzmax)
then
450 write(*,*)
'FLEXPART error: Too many w grid points in z '// &
452 write(*,*)
'Reduce resolution of wind fields.'
453 write(*,*)
'Or change parameter settings in file par_mod.'
454 write(*,*) nwz,nwzmax
472 write(*,
'(a,2i7)')
'# of vertical levels in ECMWF data: ', &
475 write(*,
'(a)')
'Mother domain:'
476 write(*,
'(a,f10.2,a1,f10.2,a,f10.2)')
' Longitude range: ', &
477 xlon0,
' to ',xlon0+(nx-1)*dx,
' Grid distance: ',dx
478 write(*,
'(a,f10.2,a1,f10.2,a,f10.2)')
' Latitude range: ', &
479 ylat0,
' to ',ylat0+(ny-1)*dy,
' Grid distance: ',dy
498 k=nlev_ec+1+numskip+i
499 akm(nwz-i+1)=zsec2(j)
501 bkm(nwz-i+1)=zsec2(k)
516 akz(i+1)=0.5*(akm(i+1)+akm(i))
517 bkz(i+1)=0.5*(bkm(i+1)+bkm(i))
530 if (nz.gt.nzmax) stop
'nzmax too small'
554 pint=akz(i)+bkz(i)*101325.
555 if (pint.lt.5000.) goto 96
558 if (nconvlev.gt.nconvlevmax-1)
then
559 nconvlev=nconvlevmax-1
560 write(*,*)
'Attention, convection only calculated up to ', &
561 akz(nconvlev)+bkz(nconvlev)*1013.25,
' hPa'
567 write(*,*)
' ###########################################'// &
569 write(*,*)
' TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
570 write(*,*)
' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
571 write(*,*)
' ###########################################'// &
574 write(*,
'(a)')
'!!! PLEASE INSERT A NEW CD-ROM AND !!!'
575 write(*,
'(a)')
'!!! PRESS ANY KEY TO CONTINUE... !!!'
576 write(*,
'(a)')
'!!! ...OR TERMINATE FLEXPART PRESSING!!!'
577 write(*,
'(a)')
'!!! THE "X" KEY... !!!'
subroutine, public stcm2p(strcmp, x1, y1, xlat1, xlong1, x2, y2, xlat2, xlong2)
character(len=15) function, public vtable_get_fpname(igrib, vtable_object)
subroutine gridcheck_ecmwf
subroutine grib2check(igrib, fpname, conversion_factor)
subroutine, public stlmbr(strcmp, tnglat, xlong)
subroutine, public vtable_load_by_name(vtable_name, the_vtable_data)
subroutine shift_field_0(field, nxf, nyf)
integer function, public vtable_detect_gribfile_type(gribfilename)