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'
338 if ((gribver.eq.1).and.(gotgrid.eq.0))
then
339 call grib_get_real8(igrib,
'longitudeOfFirstGridPointInDegrees', &
341 call grib_check(iret,gribfunction,griberrormsg)
342 call grib_get_real8(igrib,
'latitudeOfLastGridPointInDegrees', &
344 call grib_check(iret,gribfunction,griberrormsg)
349 if(xaux.lt.0.) xaux=xaux+360.
350 if(yaux.lt.0.) yaux=yaux+360.
351 if(xaux0.lt.0.) xaux0=xaux0+360.
352 if(yaux0.lt.0.) yaux0=yaux0+360.
354 stop
'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NES&
357 stop
'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NEST&
362 k = current_grib_level
365 if(trim(fpname) .eq.
'TT')
then
368 tthn(i,j,nlev_ec-k+2,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
374 if(trim(fpname) .eq.
'UU')
then
375 iumax=max(iumax,nlev_ec-k+1)
378 uuhn(i,j,nlev_ec-k+2,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
384 if(trim(fpname) .eq.
'VV')
then
387 vvhn(i,j,nlev_ec-k+2,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
393 if(trim(fpname) .eq.
'ETADOT')
then
394 iwmax=max(iwmax,nlev_ec-k+1)
397 wwhn(i,j,nlev_ec-k+1,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
403 if(trim(fpname) .eq.
'QV')
then
406 qvhn(i,j,nlev_ec-k+2,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
407 if (qvhn(i,j,nlev_ec-k+2,n,l) .lt. 0.) &
408 qvhn(i,j,nlev_ec-k+2,n,l) = 0.
417 if(trim(fpname) .eq.
'PS')
then
420 psn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
426 if(trim(fpname) .eq.
'SD')
then
429 sdn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
435 if(trim(fpname) .eq.
'MSL')
then
438 msln(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
444 if(trim(fpname) .eq.
'TCC')
then
447 tccn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
453 if(trim(fpname) .eq.
'U10')
then
456 u10n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
462 if(trim(fpname) .eq.
'V10')
then
465 v10n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
471 if(trim(fpname) .eq.
'T2')
then
474 tt2n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
480 if(trim(fpname) .eq.
'TD2')
then
483 td2n(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
489 if(trim(fpname) .eq.
'LSPREC')
then
492 lsprecn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
493 if (lsprecn(i,j,1,n,l).lt.0.) lsprecn(i,j,1,n,l)=0.
499 if(trim(fpname) .eq.
'CONVPREC')
then
502 convprecn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
503 if (convprecn(i,j,1,n,l).lt.0.) convprecn(i,j,1,n,l)=0.
509 if(trim(fpname) .eq.
'SHF')
then
512 sshfn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
513 if (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.) hflswitch=.true.
519 if(trim(fpname) .eq.
'SR')
then
522 ssrn(i,j,1,n,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
523 if (ssrn(i,j,1,n,l).lt.0.) ssrn(i,j,1,n,l)=0.
529 if(trim(fpname) .eq.
'EWSS')
then
532 ewss(i,j) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
533 if (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.) strswitch=.true.
539 if(trim(fpname) .eq.
'NSSS')
then
542 nsss(i,j) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
543 if (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.) strswitch=.true.
549 if(trim(fpname) .eq.
'ORO')
then
552 oron(i,j,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
558 if(trim(fpname) .eq.
'EXCESSORO')
then
561 excessoron(i,j,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
567 if(trim(fpname) .eq.
'LSM')
then
570 lsmn(i,j,l) = zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
576 call grib_release(igrib)
581 50 call grib_close_file(ifile)
584 if (gotgrid.eq.0)
then
585 print*,
'***ERROR: input file needs to contain GRiB1 formatted'// &
590 if(levdiff2.eq.0)
then
594 wwhn(i,j,nlev_ec+1,l)=0.
601 surfstrn(i,j,1,n,l)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
605 if ((.not.hflswitch).or.(.not.strswitch))
then
606 write(*,*)
'WARNING: No flux data contained in GRIB file ', &
617 plev1=akz(3)+bkz(3)*psn(i,j,1,n,l)
618 pmean=0.5*(psn(i,j,1,n,l)+plev1)
619 tv=tthn(i,j,3,n,l)*(1.+0.61*qvhn(i,j,3,n,l))
620 fu=-r_air*tv/ga/pmean
621 hlev1=fu*(plev1-psn(i,j,1,n,l))
622 ff10m= sqrt(u10n(i,j,1,n,l)**2+v10n(i,j,1,n,l)**2)
623 fflev1=sqrt(uuhn(i,j,3,l)**2+vvhn(i,j,3,l)**2)
624 call
pbl_profile(psn(i,j,1,n,l),td2n(i,j,1,n,l),hlev1, &
625 tt2n(i,j,1,n,l),tthn(i,j,3,n,l),ff10m,fflev1, &
626 surfstrn(i,j,1,n,l),sshfn(i,j,1,n,l))
627 if(sshfn(i,j,1,n,l).gt.200.) sshfn(i,j,1,n,l)=200.
628 if(sshfn(i,j,1,n,l).lt.-400.) sshfn(i,j,1,n,l)=-400.
642 uuhn(i,j,1,l)=u10n(i,j,1,n,l)
643 vvhn(i,j,1,l)=v10n(i,j,1,n,l)
644 qvhn(i,j,1,n,l)=qvhn(i,j,2,n,l)
645 tthn(i,j,1,n,l)=tt2n(i,j,1,n,l)
649 if(iumax.ne.nuvz-1) stop &
650 'READWIND: NUVZ NOT CONSISTENT FOR A NESTING LEVEL'
651 if(iwmax.ne.nwz) stop &
652 'READWIND: NWZ NOT CONSISTENT FOR A NESTING LEVEL'
657 888
write(*,*)
' #### FLEXPART MODEL ERROR! WINDFIELD #### '
658 write(*,*)
' #### ',wfnamen(l,indj),
' FOR NESTING LEVEL #### '
659 write(*,*)
' #### ',l,
' IS NOT GRIB FORMAT !!! #### '
660 stop
'Execution terminated'
663 999
write(*,*)
' #### FLEXPART MODEL ERROR! WINDFIELD #### '
664 write(*,*)
' #### ',wfnamen(l,indj),
' #### '
665 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)