60 real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
61 real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
62 real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
85 integer :: gribver,parcat,parnum,typsurf,valsurf,discipl
95 character(LEN=255),
parameter :: vtable_ecmwf_grib1_path = &
96 "Vtable_ecmwf_grib1", &
97 vtable_ecmwf_grib2_path = &
98 "Vtable_ecmwf_grib2", &
99 vtable_ecmwf_grib1_2_path = &
100 "Vtable_ecmwf_grib1_2"
102 integer :: gribfile_type
103 integer :: current_grib_level
104 character(len=255) :: gribfile_name
105 character(len=255) :: vtable_path
106 character(len=15) :: fpname
145 integer :: isec1(56),isec2(22+nxmaxn+nymaxn)
146 real(kind=4) :: zsec4(jpunp)
147 real(kind=8) :: xauxin,yauxin
148 real(kind=4) :: xaux,yaux,xaux0,yaux0
149 real :: ewss(0:nxmaxn-1,0:nymaxn-1),nsss(0:nxmaxn-1,0:nymaxn-1)
150 real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
151 logical :: hflswitch,strswitch
160 integer ::i,j,k,levdiff2,ifield,iumax,iwmax,l
166 character(len=24) :: griberrormsg =
'Error reading grib file'
167 character(len=20) :: gribfunction =
'readwind_nests'
205 levdiff2=nlev_ec-nwz+1
212 gribfile_name = path(3)(1:length(3))//trim(wfname(indj))
213 print *,
'gribfile_name: ', gribfile_name
217 print *,
'gribfile_type: ', gribfile_type
219 if (gribfile_type .eq. vtable_gribfile_type_ecmwf_grib1)
then
220 vtable_path = vtable_ecmwf_grib1_path
221 else if (gribfile_type .eq. vtable_gribfile_type_ecmwf_grib2)
then
222 vtable_path = vtable_ecmwf_grib2_path
223 else if (gribfile_type .eq. vtable_gribfile_type_ecmwf_grib1_2)
then
224 vtable_path = vtable_ecmwf_grib1_2_path
226 print *,
'Unsupported gribfile_type: ', gribfile_type
232 print *,
'readwind_nests(): Loading Vtable: ', vtable_path
234 print *,
'readwind_nests(): Vtable Initialized: ', my_vtable%initialized
235 print *,
'readwind_nests(): Vtable num_entries: ', my_vtable%num_entries
251 5 call grib_open_file(ifile,path(numpath+2*(l-1)+1) &
252 (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,indj)),
'r')
253 if (iret.ne.grib_success)
then
265 call grib_new_from_file(ifile,igrib,iret)
266 if (iret.eq.grib_end_of_file)
then
268 elseif (iret.ne.grib_success)
then
277 print *,
'readwind_nests(): fpname: ', trim(fpname)
289 call grib_get_int(igrib,
'editionNumber',gribver,iret)
290 call grib_check(iret,gribfunction,griberrormsg)
296 call grib_get_int(igrib,
'level', current_grib_level,iret)
297 call grib_check(iret,gribfunction,griberrormsg)
304 if (isec1(6).ne.-1)
then
305 call grib_get_real4_array(igrib,
'values',zsec4,iret)
306 call grib_check(iret,gribfunction,griberrormsg)
314 call grib_get_int(igrib,
'numberOfPointsAlongAParallel', &
316 call grib_check(iret,gribfunction,griberrormsg)
317 call grib_get_int(igrib,
'numberOfPointsAlongAMeridian', &
319 call grib_check(iret,gribfunction,griberrormsg)
320 call grib_get_int(igrib,
'numberOfVerticalCoordinateValues', &
322 call grib_check(iret,gribfunction,griberrormsg)
324 if(isec2(2).ne.nxn(l)) stop &
325 'READWIND: NX NOT CONSISTENT FOR A NESTING LEVEL'
326 if(isec2(3).ne.nyn(l)) stop &
327 'READWIND: NY NOT CONSISTENT FOR A NESTING LEVEL'
328 if(isec2(12)/2-1.ne.nlev_ec) stop
'READWIND: VERTICAL DISCRET&
329 &IZATION NOT CONSISTENT FOR A NESTING LEVEL'
337 if (gotgrid.eq.0)
then
338 call grib_get_real8(igrib,
'longitudeOfFirstGridPointInDegrees', &
340 call grib_check(iret,gribfunction,griberrormsg)
341 call grib_get_real8(igrib,
'latitudeOfLastGridPointInDegrees', &
343 call grib_check(iret,gribfunction,griberrormsg)
348 if(xaux.lt.0.) xaux=xaux+360.
349 if(yaux.lt.0.) yaux=yaux+360.
350 if(xaux0.lt.0.) xaux0=xaux0+360.
351 if(yaux0.lt.0.) yaux0=yaux0+360.
353 stop
'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NES&
356 stop
'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NEST&
361 k = current_grib_level
364 if(trim(fpname) .eq.
'TT')
then
367 tthn(i,j,nlev_ec-k+2,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
373 if(trim(fpname) .eq.
'UU')
then
374 iumax=max(iumax,nlev_ec-k+1)
377 uuhn(i,j,nlev_ec-k+2,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
383 if(trim(fpname) .eq.
'VV')
then
386 vvhn(i,j,nlev_ec-k+2,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
392 if(trim(fpname) .eq.
'ETADOT')
then
393 iwmax=max(iwmax,nlev_ec-k+1)
396 wwhn(i,j,nlev_ec-k+1,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
402 if(trim(fpname) .eq.
'QV')
then
405 qvhn(i,j,nlev_ec-k+2,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
406 if (qvhn(i,j,nlev_ec-k+2,n,l) .lt. 0.) &
407 qvhn(i,j,nlev_ec-k+2,n,l) = 0.
416 if(trim(fpname) .eq.
'PS')
then
419 psn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
425 if(trim(fpname) .eq.
'SD')
then
428 sdn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
434 if(trim(fpname) .eq.
'MSL')
then
437 msln(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
443 if(trim(fpname) .eq.
'TCC')
then
446 tccn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
452 if(trim(fpname) .eq.
'U10')
then
455 u10n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
461 if(trim(fpname) .eq.
'V10')
then
464 v10n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
470 if(trim(fpname) .eq.
'T2')
then
473 tt2n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
479 if(trim(fpname) .eq.
'TD2')
then
482 td2n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
488 if(trim(fpname) .eq.
'LSPREC')
then
491 lsprecn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
492 if (lsprecn(i,j,1,n,l).lt.0.) lsprecn(i,j,1,n,l)=0.
498 if(trim(fpname) .eq.
'CONVPREC')
then
501 convprecn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
502 if (convprecn(i,j,1,n,l).lt.0.) convprecn(i,j,1,n,l)=0.
508 if(trim(fpname) .eq.
'SHF')
then
511 sshfn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
512 if (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.) hflswitch=.true.
518 if(trim(fpname) .eq.
'SR')
then
521 ssrn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
522 if (ssrn(i,j,1,n,l).lt.0.) ssrn(i,j,1,n,l)=0.
528 if(trim(fpname) .eq.
'EWSS')
then
531 ewss(i,j) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
532 if (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.) strswitch=.true.
538 if(trim(fpname) .eq.
'NSSS')
then
541 nsss(i,j) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
542 if (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.) strswitch=.true.
548 if(trim(fpname) .eq.
'ORO')
then
551 oron(i,j,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
557 if(trim(fpname) .eq.
'EXCESSORO')
then
560 excessoron(i,j,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
566 if(trim(fpname) .eq.
'LSM')
then
569 lsmn(i,j,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
575 call grib_release(igrib)
580 50 call grib_close_file(ifile)
583 if (gotgrid.eq.0)
then
584 print*,
'***ERROR: input file needs to contain GRiB1 formatted'// &
589 if(levdiff2.eq.0)
then
593 wwhn(i,j,nlev_ec+1,l)=0.
600 surfstrn(i,j,1,n,l)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
604 if ((.not.hflswitch).or.(.not.strswitch))
then
605 write(*,*)
'WARNING: No flux data contained in GRIB file ', &
616 plev1=akz(3)+bkz(3)*psn(i,j,1,n,l)
617 pmean=0.5*(psn(i,j,1,n,l)+plev1)
618 tv=tthn(i,j,3,n,l)*(1.+0.61*qvhn(i,j,3,n,l))
619 fu=-r_air*tv/ga/pmean
620 hlev1=fu*(plev1-psn(i,j,1,n,l))
621 ff10m= sqrt(u10n(i,j,1,n,l)**2+v10n(i,j,1,n,l)**2)
622 fflev1=sqrt(uuhn(i,j,3,l)**2+vvhn(i,j,3,l)**2)
623 call
pbl_profile(psn(i,j,1,n,l),td2n(i,j,1,n,l),hlev1, &
624 tt2n(i,j,1,n,l),tthn(i,j,3,n,l),ff10m,fflev1, &
625 surfstrn(i,j,1,n,l),sshfn(i,j,1,n,l))
626 if(sshfn(i,j,1,n,l).gt.200.) sshfn(i,j,1,n,l)=200.
627 if(sshfn(i,j,1,n,l).lt.-400.) sshfn(i,j,1,n,l)=-400.
641 uuhn(i,j,1,l)=u10n(i,j,1,n,l)
642 vvhn(i,j,1,l)=v10n(i,j,1,n,l)
643 qvhn(i,j,1,n,l)=qvhn(i,j,2,n,l)
644 tthn(i,j,1,n,l)=tt2n(i,j,1,n,l)
648 if(iumax.ne.nuvz-1) stop &
649 'READWIND: NUVZ NOT CONSISTENT FOR A NESTING LEVEL'
650 if(iwmax.ne.nwz) stop &
651 'READWIND: NWZ NOT CONSISTENT FOR A NESTING LEVEL'
656 888
write(*,*)
' #### FLEXPART MODEL ERROR! WINDFIELD #### '
657 write(*,*)
' #### ',wfnamen(l,indj),
' FOR NESTING LEVEL #### '
658 write(*,*)
' #### ',l,
' IS NOT GRIB FORMAT !!! #### '
659 stop
'Execution terminated'
662 999
write(*,*)
' #### FLEXPART MODEL ERROR! WINDFIELD #### '
663 write(*,*)
' #### ',wfnamen(l,indj),
' #### '
664 write(*,*)
' #### CANNOT BE OPENED FOR NESTING LEVEL ',l,
'####'
subroutine readwind_nests(indj, n, uuhn, vvhn, wwhn)
character(len=15) function, public vtable_get_fpname(igrib, vtable_object)
subroutine pbl_profile(ps, td2m, zml1, t2m, tml1, u10m, uml1, stress, hf)
subroutine, public vtable_load_by_name(vtable_name, the_vtable_data)
integer function, public vtable_detect_gribfile_type(gribfilename)