54 use vrbls3d,
only: zmid, zint, dbz, dbzr, dbzi, dbzc, uh, vh, pmid, t, q, ref_10cm
55 use vrbls2d,
only: refd_max, up_heli_max, up_heli_max16, grpl_max, &
56 up_heli_min, up_heli_min16, up_heli_max02, &
57 up_heli_min02, up_heli_max03, up_heli_min03, &
58 rel_vort_max, rel_vort_max01, hail_max2d, hail_maxk1,&
59 hail_maxhailcast,refdm10c_max, rel_vort_maxhy1, &
60 ltg1_max, ltg2_max, ltg3_max, up_heli, up_heli16, &
61 nci_ltg, nca_ltg, nci_wq, nca_wq, nci_refd, nca_refd,&
63 use masks,
only: lmh, lmv
64 use params_mod,
only: dbzmin, small, eps, rd
65 use ctlblk_mod,
only: spval, lm, modelname, grib, cfld, fld_info, datapd,&
66 ifhr, global, jsta_m, jend_m, mpi_comm_comp, &
67 jsta_2l, jend_2u, im, jm, jsta, jend, imp_physics, &
68 ista, iend, ista_2l, iend_2u, ista_m, iend_m
69 use rqstfld_mod,
only: iget, lvls, iavblfld, lvlsxml, id
70 use gridspec_mod,
only: gridtype
79 integer,
PARAMETER :: LAGL=2,lagl2=1
84 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: grid1
85 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: UAGL, VAGL, tagl, pagl, qagl
87 INTEGER,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: NL1X
88 integer,
dimension(jm) :: IHE, IHW
89 INTEGER LXXX,IERR, maxll, minll
90 INTEGER ISTART,ISTOP,JSTART,JSTOP
107 REAL,
dimension(ista:iend,jsta:jend) :: DBZ1, DBZR1, DBZI1, DBZC1, dbz1log
108 real,
dimension(lagl) :: ZAGL
109 real,
dimension(lagl2) :: ZAGL2, ZAGL3
110 real PAGLU,PAGLL,TAGLU,TAGLL,QAGLU,QAGLL, pv, rho
112 integer I,J,L,II,JJ,LP,LL,LLMH,ie,iw,jn,js,iget1,iget2,iget3,iget4
113 real UAGLL,UAGLU,VAGLL,VAGLU,FACT,ZDUM
138 IF (iget(253)>0 .OR. iget(279)>0 .OR. iget(280)>0 .OR. &
148 iget1 = -1 ; iget2 = -1 ; iget3 = -1 ; iget4 = -1
149 if (iget(253) > 0) iget1 = lvls(lp,iget(253))
150 if (iget(279) > 0) iget2 = lvls(lp,iget(279))
151 if (iget(280) > 0) iget3 = lvls(lp,iget(280))
152 if (iget(281) > 0) iget4 = lvls(lp,iget(281))
153 IF (iget1 > 0 .or. iget2 > 0 .or. iget3 > 0 .or. iget4 > 0)
then
155 jj=float(jsta+jend)/2.0
156 ii=float(ista+iend)/3.0
168 llmh = nint(lmh(i,j))
171 zdum = zmid(i,j,l)-zint(i,j,llmh+1)
172 IF(zdum >= zagl(lp))
THEN
183 IF(nl1x(i,j) == (llmh+1) .AND. zagl(lp) > 0.)
THEN
210 llmh = nint(lmh(i,j))
211 IF(nl1x(i,j)<=llmh)
THEN
212 IF(zmid(i,j,ll)<spval.and.zmid(i,j,ll-1)<spval)
THEN
224 zdum=zagl(lp)+zint(i,j,nint(lmh(i,j))+1)
225 fact=(zdum-zmid(i,j,ll))/(zmid(i,j,ll)-zmid(i,j,ll-1))
228 if (imp_physics==8)
then
229 dbz1(i,j)=ref_10cm(i,j,ll)+(ref_10cm(i,j,ll)-ref_10cm(i,j,ll-1))*fact
231 dbz1(i,j)=dbz(i,j,ll)+(dbz(i,j,ll)-dbz(i,j,ll-1))*fact
234 dbzr1(i,j) = dbzr(i,j,ll) + (dbzr(i,j,ll)-dbzr(i,j,ll-1))*fact
235 dbzi1(i,j) = dbzi(i,j,ll) + (dbzi(i,j,ll)-dbzi(i,j,ll-1))*fact
236 dbzc1(i,j) = dbzc(i,j,ll) + (dbzc(i,j,ll)-dbzc(i,j,ll-1))*fact
237 if(modelname==
'RAPR')
then
238 if(dbz1(i,j)>0.)
then
239 dbz1log(i,j)= 10.*log10(dbz1(i,j))
251 if(modelname==
'RAPR')
then
252 dbz1log(i,j)=max(dbz1log(i,j),dbzmin)
254 dbz1(i,j)=max(dbz1(i,j),dbzmin)
256 dbzr1(i,j) = max(dbzr1(i,j),dbzmin)
257 dbzi1(i,j) = max(dbzi1(i,j),dbzmin)
258 dbzc1(i,j) = max(dbzc1(i,j),dbzmin)
266 dbz1log(i,j) = dbzmin
285 IF((iget(253)>0) )
THEN
286 if(modelname==
'RAPR')
then
289 grid1(i,j)=dbz1log(i,j)
299 if(grib==
'grib2')
then
301 fld_info(cfld)%ifld=iavblfld(iget(253))
302 fld_info(cfld)%lvl=lvlsxml(lp,iget(253))
303 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
307 IF((iget(279)>0) )
THEN
310 grid1(i,j)=dbzr1(i,j)
313 if(grib==
'grib2')
then
315 fld_info(cfld)%ifld=iavblfld(iget(279))
316 fld_info(cfld)%lvl=lvlsxml(lp,iget(279))
317 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
321 IF((iget(280)>0) )
THEN
324 grid1(i,j)=dbzi1(i,j)
327 if(grib==
'grib2')
then
329 fld_info(cfld)%ifld=iavblfld(iget(280))
330 fld_info(cfld)%lvl=lvlsxml(lp,iget(280))
331 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
335 IF((iget(281)>0) )
THEN
338 grid1(i,j)=dbzc1(i,j)
341 if(grib==
'grib2')
then
343 fld_info(cfld)%ifld=iavblfld(iget(281))
344 fld_info(cfld)%lvl=lvlsxml(lp,iget(281))
345 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
360 IF((iget(421)>0) )
THEN
363 grid1(i,j)=refd_max(i,j)
366 if(grib==
'grib2')
then
368 fld_info(cfld)%ifld=iavblfld(iget(421))
369 fld_info(cfld)%lvl=lvlsxml(lp,iget(421))
370 fld_info(cfld)%tinvstat=1
372 fld_info(cfld)%tinvstat=1
374 fld_info(cfld)%tinvstat=0
376 fld_info(cfld)%ntrange=1
377 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
382 IF((iget(785)>0) )
THEN
385 grid1(i,j)=refdm10c_max(i,j)
388 if(grib==
'grib2')
then
390 fld_info(cfld)%ifld=iavblfld(iget(785))
391 fld_info(cfld)%lvl=lvlsxml(lp,iget(785))
393 fld_info(cfld)%tinvstat=1
395 fld_info(cfld)%tinvstat=0
397 fld_info(cfld)%ntrange=1
398 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
403 IF((iget(420)>0) )
THEN
406 grid1(i,j)=up_heli_max(i,j)
409 if(grib==
'grib2')
then
411 fld_info(cfld)%ifld=iavblfld(iget(420))
412 fld_info(cfld)%lvl=lvlsxml(lp,iget(420))
414 fld_info(cfld)%tinvstat = 1
416 fld_info(cfld)%tinvstat = 0
418 fld_info(cfld)%ntrange = 1
419 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
424 IF((iget(700)>0) )
THEN
427 grid1(i,j)=up_heli_max16(i,j)
430 if(grib==
'grib2')
then
432 fld_info(cfld)%ifld=iavblfld(iget(700))
433 fld_info(cfld)%lvl=lvlsxml(lp,iget(700))
435 fld_info(cfld)%tinvstat = 0
437 fld_info(cfld)%tinvstat = 1
439 fld_info(cfld)%ntrange = 1
440 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
445 IF((iget(786)>0) )
THEN
448 grid1(i,j)=up_heli_min(i,j)
451 if(grib==
'grib2')
then
453 fld_info(cfld)%ifld=iavblfld(iget(786))
454 fld_info(cfld)%lvl=lvlsxml(lp,iget(786))
456 fld_info(cfld)%tinvstat = 1
458 fld_info(cfld)%tinvstat = 0
460 fld_info(cfld)%ntrange = 1
461 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
466 IF((iget(787)>0) )
THEN
469 grid1(i,j)=up_heli_min16(i,j)
472 if(grib==
'grib2')
then
474 fld_info(cfld)%ifld=iavblfld(iget(787))
475 fld_info(cfld)%lvl=lvlsxml(lp,iget(787))
477 fld_info(cfld)%tinvstat = 0
479 fld_info(cfld)%tinvstat = 1
481 fld_info(cfld)%ntrange = 1
482 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
487 IF((iget(788)>0) )
THEN
490 grid1(i,j)=up_heli_max02(i,j)
493 if(grib==
'grib2')
then
495 fld_info(cfld)%ifld=iavblfld(iget(788))
496 fld_info(cfld)%lvl=lvlsxml(lp,iget(788))
498 fld_info(cfld)%tinvstat = 1
500 fld_info(cfld)%tinvstat = 0
502 fld_info(cfld)%ntrange = 1
503 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
507 IF((iget(789)>0) )
THEN
510 grid1(i,j)=up_heli_min02(i,j)
513 if(grib==
'grib2')
then
515 fld_info(cfld)%ifld=iavblfld(iget(789))
516 fld_info(cfld)%lvl=lvlsxml(lp,iget(789))
518 fld_info(cfld)%tinvstat = 0
520 fld_info(cfld)%tinvstat = 1
522 fld_info(cfld)%ntrange = 1
523 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
528 IF((iget(790)>0) )
THEN
531 grid1(i,j)=up_heli_max03(i,j)
534 if(grib==
'grib2')
then
536 fld_info(cfld)%ifld=iavblfld(iget(790))
537 fld_info(cfld)%lvl=lvlsxml(lp,iget(790))
539 fld_info(cfld)%tinvstat = 1
541 fld_info(cfld)%tinvstat = 0
543 fld_info(cfld)%ntrange = 1
544 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
549 IF((iget(791)>0) )
THEN
552 grid1(i,j)=up_heli_min03(i,j)
555 if(grib==
'grib2')
then
557 fld_info(cfld)%ifld=iavblfld(iget(791))
558 fld_info(cfld)%lvl=lvlsxml(lp,iget(791))
560 fld_info(cfld)%tinvstat = 0
562 fld_info(cfld)%tinvstat = 1
564 fld_info(cfld)%ntrange = 1
565 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
570 IF((iget(792)>0) )
THEN
573 grid1(i,j)=rel_vort_max(i,j)
576 if(grib==
'grib2')
then
578 fld_info(cfld)%ifld=iavblfld(iget(792))
579 fld_info(cfld)%lvl=lvlsxml(lp,iget(792))
581 fld_info(cfld)%tinvstat = 1
583 fld_info(cfld)%tinvstat = 0
585 fld_info(cfld)%ntrange = 1
586 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
591 IF((iget(793)>0) )
THEN
594 grid1(i,j)=rel_vort_max01(i,j)
597 if(grib==
'grib2')
then
599 fld_info(cfld)%ifld=iavblfld(iget(793))
600 fld_info(cfld)%lvl=lvlsxml(lp,iget(793))
602 fld_info(cfld)%tinvstat = 1
604 fld_info(cfld)%tinvstat = 0
606 fld_info(cfld)%ntrange = 1
607 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
611 IF((iget(890)>0) )
THEN
614 grid1(i,j)=rel_vort_maxhy1(i,j)
617 if(grib==
'grib2')
then
619 fld_info(cfld)%ifld=iavblfld(iget(890))
620 fld_info(cfld)%lvl=lvlsxml(lp,iget(890))
622 fld_info(cfld)%tinvstat = 1
624 fld_info(cfld)%tinvstat = 0
626 fld_info(cfld)%ntrange = 1
627 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
632 IF((iget(794)>0) )
THEN
635 grid1(i,j)=hail_max2d(i,j)
638 if(grib==
'grib2')
then
640 fld_info(cfld)%ifld=iavblfld(iget(794))
641 fld_info(cfld)%lvl=lvlsxml(lp,iget(794))
643 fld_info(cfld)%tinvstat = 0
645 fld_info(cfld)%tinvstat = 1
647 fld_info(cfld)%ntrange = 1
648 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
653 IF((iget(795)>0) )
THEN
656 grid1(i,j)=hail_maxk1(i,j)
659 if(grib==
'grib2')
then
661 fld_info(cfld)%ifld=iavblfld(iget(795))
662 fld_info(cfld)%lvl=lvlsxml(lp,iget(795))
664 fld_info(cfld)%tinvstat = 0
666 fld_info(cfld)%tinvstat = 1
668 fld_info(cfld)%ntrange = 1
669 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
674 IF((iget(728)>0) )
THEN
677 grid1(i,j)=hail_maxhailcast(i,j)/1000.0
680 if(grib==
'grib2')
then
682 fld_info(cfld)%ifld=iavblfld(iget(728))
683 fld_info(cfld)%lvl=lvlsxml(lp,iget(728))
685 fld_info(cfld)%tinvstat = 0
687 fld_info(cfld)%tinvstat = 1
689 fld_info(cfld)%ntrange = 1
690 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
695 IF((iget(429)>0) )
THEN
698 grid1(i,j)=grpl_max(i,j)
701 if(grib==
'grib2')
then
703 fld_info(cfld)%ifld=iavblfld(iget(429))
704 fld_info(cfld)%lvl=lvlsxml(lp,iget(429))
706 fld_info(cfld)%tinvstat = 0
708 fld_info(cfld)%tinvstat = 1
710 fld_info(cfld)%ntrange = 1
711 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
716 IF((iget(702)>0) )
THEN
719 grid1(i,j)=ltg1_max(i,j)
722 if(grib==
'grib2')
then
724 fld_info(cfld)%ifld=iavblfld(iget(702))
725 fld_info(cfld)%lvl=lvlsxml(lp,iget(702))
727 fld_info(cfld)%tinvstat = 0
729 fld_info(cfld)%tinvstat = 1
731 fld_info(cfld)%ntrange = 1
732 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
737 IF((iget(703)>0) )
THEN
740 grid1(i,j)=ltg2_max(i,j)
743 if(grib==
'grib2')
then
745 fld_info(cfld)%ifld=iavblfld(iget(703))
746 fld_info(cfld)%lvl=lvlsxml(lp,iget(703))
748 fld_info(cfld)%tinvstat = 0
750 fld_info(cfld)%tinvstat = 1
752 fld_info(cfld)%ntrange = 1
753 datapd(1:iend-ista+1,1:jend-jsta+1,cfld) = grid1(ista:iend,jsta:jend)
758 IF((iget(704)>0) )
THEN
761 grid1(i,j)=ltg3_max(i,j)
764 if(grib==
'grib2')
then
766 fld_info(cfld)%ifld=iavblfld(iget(704))
767 fld_info(cfld)%lvl=lvlsxml(lp,iget(704))
769 fld_info(cfld)%tinvstat = 0
771 fld_info(cfld)%tinvstat = 1
773 fld_info(cfld)%ntrange = 1
778 datapd(i,j,cfld) = grid1(ii,jj)
786 IF((iget(727)>0) )
THEN
789 grid1(i,j)=up_heli(i,j)
792 if(grib==
'grib2')
then
794 fld_info(cfld)%ifld=iavblfld(iget(727))
795 fld_info(cfld)%lvl=lvlsxml(lp,iget(727))
796 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
801 IF((iget(701)>0) )
THEN
804 grid1(i,j)=up_heli16(i,j)
807 if(grib==
'grib2')
then
809 fld_info(cfld)%ifld=iavblfld(iget(701))
810 fld_info(cfld)%lvl=lvlsxml(lp,iget(701))
811 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
816 IF((iget(705)>0) )
THEN
819 grid1(i,j)=nci_ltg(i,j)/60.0
822 if(grib==
'grib2')
then
824 fld_info(cfld)%ifld=iavblfld(iget(705))
825 fld_info(cfld)%lvl=lvlsxml(lp,iget(705))
827 fld_info(cfld)%tinvstat = 0
829 fld_info(cfld)%tinvstat = 1
831 fld_info(cfld)%ntrange = 1
832 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
837 IF((iget(706)>0) )
THEN
840 grid1(i,j)=nca_ltg(i,j)/60.0
843 if(grib==
'grib2')
then
845 fld_info(cfld)%ifld=iavblfld(iget(706))
846 fld_info(cfld)%lvl=lvlsxml(lp,iget(706))
848 fld_info(cfld)%tinvstat = 0
850 fld_info(cfld)%tinvstat = 1
852 fld_info(cfld)%ntrange = 1
853 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
858 IF((iget(707)>0) )
THEN
861 grid1(i,j)=nci_wq(i,j)/60.0
864 if(grib==
'grib2')
then
866 fld_info(cfld)%ifld=iavblfld(iget(707))
867 fld_info(cfld)%lvl=lvlsxml(lp,iget(707))
869 fld_info(cfld)%tinvstat = 0
871 fld_info(cfld)%tinvstat = 1
873 fld_info(cfld)%ntrange = 1
874 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
879 IF((iget(708)>0) )
THEN
882 grid1(i,j)=nca_wq(i,j)/60.0
885 if(grib==
'grib2')
then
887 fld_info(cfld)%ifld=iavblfld(iget(708))
888 fld_info(cfld)%lvl=lvlsxml(lp,iget(708))
890 fld_info(cfld)%tinvstat = 0
892 fld_info(cfld)%tinvstat = 1
894 fld_info(cfld)%ntrange = 1
895 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
900 IF((iget(709)>0) )
THEN
903 grid1(i,j)=nci_refd(i,j)/60.0
906 if(grib==
'grib2')
then
908 fld_info(cfld)%ifld=iavblfld(iget(709))
909 fld_info(cfld)%lvl=lvlsxml(lp,iget(709))
911 fld_info(cfld)%tinvstat = 0
913 fld_info(cfld)%tinvstat = 1
915 fld_info(cfld)%ntrange = 1
916 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
921 IF((iget(710)>0) )
THEN
924 grid1(i,j)=nca_refd(i,j)/60.0
927 if(grib==
'grib2')
then
929 fld_info(cfld)%ifld=iavblfld(iget(710))
930 fld_info(cfld)%lvl=lvlsxml(lp,iget(710))
932 fld_info(cfld)%tinvstat = 0
934 fld_info(cfld)%tinvstat = 1
936 fld_info(cfld)%ntrange = 1
937 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
944 IF((iget(259)>0) )
THEN
953 if (iget(253) > 0 ) iget2 = iavblfld(iget(253))
957 if (iget(259) > 0 ) iget1 = lvls(lp,iget(259))
958 IF(iget1 > 0 .or. iget2 > 0)
THEN
973 zdum=zmid(i,j,l)-zint(i,j,llmh+1)
974 IF(zdum >= zagl2(lp))
THEN
985 IF(nl1x(i,j) == (llmh+1) .AND. zagl2(lp) > 0.)
THEN
1003 IF(gridtype==
'A')
THEN
1006 ELSE IF(gridtype==
'E')
THEN
1022 IF(gridtype/=
'A')
THEN
1026 CALL mpi_allreduce(minll,lxxx,1,mpi_integer,mpi_min,mpi_comm_comp,ierr)
1030 call exch(uh(ista_2l:iend_2u,jsta_2l:jend_2u,ll))
1031 call exch(vh(ista_2l:iend_2u,jsta_2l:jend_2u,ll))
1034 DO 230 j=jstart,jstop
1035 DO 230 i=istart,istop
1043 llmh = nint(lmh(i,j))
1044 IF(nl1x(i,j)<=llmh)
THEN
1055 zdum=zagl2(lp)+zint(i,j,nint(lmh(i,j))+1)
1056 fact=(zdum-zmid(i,j,ll))/(zmid(i,j,ll)-zmid(i,j,ll-1))
1058 IF(gridtype==
'A')
THEN
1064 ELSE IF(gridtype==
'E')
THEN
1065 uaglu=(uh(i+ihe(j),j,ll-1)+uh(i+ihw(j),j,ll-1)+ &
1066 & uh(i,j-1,ll-1)+uh(i,j+1,ll-1))/4.0
1067 uagll=(uh(i+ihe(j),j,ll)+uh(i+ihw(j),j,ll)+ &
1068 & uh(i,j-1,ll)+uh(i,j+1,ll))/4.0
1070 vaglu=(vh(i+ihe(j),j,ll-1)+vh(i+ihw(j),j,ll-1)+ &
1071 & vh(i,j-1,ll-1)+vh(i,j+1,ll-1))/4.0
1072 vagll=(vh(i+ihe(j),j,ll)+vh(i+ihw(j),j,ll)+ &
1073 & vh(i,j-1,ll)+vh(i,j+1,ll))/4.0
1074 ELSE IF(gridtype==
'B')
THEN
1079 uaglu=(uh(ie,j,ll-1)+uh(iw,j,ll-1)+ &
1080 & uh(ie,js,ll-1)+uh(iw,js,ll-1))/4.0
1081 uagll=(uh(ie,j,ll)+uh(iw,j,ll)+ &
1082 & uh(ie,js,ll)+uh(iw,js,ll))/4.0
1084 vaglu=(vh(ie,j,ll-1)+vh(iw,j,ll-1)+ &
1085 & vh(ie,js,ll-1)+vh(iw,js,ll-1))/4.0
1086 vagll=(vh(ie,j,ll)+vh(iw,j,ll)+ &
1087 & vh(ie,js,ll)+vh(iw,js,ll))/4.0
1089 uagl(i,j)=uagll+(uagll-uaglu)*fact
1090 vagl(i,j)=vagll+(vagll-vaglu)*fact
1091 IF(i==ii.AND.j==jj)print*, &
1092 &
'DEBUG LLWS: I,J,NL1X,UU,UL,VU,VL,ZSFC,ZMIDU,ZMIDL,U,V= ' &
1093 &, i,j,ll,uaglu,uagll,vaglu,vagll,zint(i,j,nint(lmh(i,j))+1)&
1094 &, zmid(i,j,ll-1),zmid(i,j,ll),uagl(i,j),vagl(i,j) &
1095 &, u10(i,j),v10(i,j)
1102 IF(gridtype==
'A')
THEN
1103 uagl(i,j)=uh(i,j,nint(lmv(i,j)))
1104 vagl(i,j)=vh(i,j,nint(lmv(i,j)))
1105 ELSE IF(gridtype==
'E')
THEN
1106 uagl(i,j)=(uh(i+ihe(j),j,nint(lmv(i+ihe(j),j))) &
1107 & +uh(i+ihw(j),j,nint(lmv(i+ihw(j),j)))+ &
1108 & uh(i,j-1,nint(lmv(i,j-1)))+uh(i,j+1,nint(lmv(i,j+1))))/4.0
1109 vagl(i,j)=(vh(i+ihe(j),j,nint(lmv(i+ihe(j),j))) &
1110 & +vh(i+ihw(j),j,nint(lmv(i+ihw(j),j)))+ &
1111 & vh(i,j-1,nint(lmv(i,j-1)))+vh(i,j+1,nint(lmv(i,j+1))))/4.0
1112 ELSE IF(gridtype==
'B')
THEN
1117 uagl(i,j)=(uh(ie,j,nint(lmv(ie,j))) &
1118 & +uh(iw,j,nint(lmv(iw,j)))+ &
1119 & uh(ie,js,nint(lmv(ie,js)))+uh(iw,js,nint(lmv(iw,js))))/4.0
1120 vagl(i,j)=(vh(ie,j,nint(lmv(ie,j))) &
1121 & +vh(iw,j,nint(lmv(iw,j)))+ &
1122 & vh(ie,js,nint(lmv(ie,js)))+vh(iw,js,nint(lmv(iw,js))))/4.0
1141 IF(abs(uagl(i,j)-spval)>small .AND. &
1142 abs(vagl(i,j)-spval)>small)
THEN
1143 IF(gridtype==
'B' .OR. gridtype==
'E')
THEN
1144 grid1(i,j)=sqrt((uagl(i,j)-u10h(i,j))**2+ &
1145 (vagl(i,j)-v10h(i,j))**2)*1.943*zagl2(lp)/ &
1148 grid1(i,j)=sqrt((uagl(i,j)-u10(i,j))**2+ &
1149 (vagl(i,j)-v10(i,j))**2)*1.943*zagl2(lp)/ &
1157 if(grib==
"grib2" )
then
1159 fld_info(cfld)%ifld=iavblfld(iget(259))
1160 fld_info(cfld)%lvl=lvlsxml(lp,iget(259))
1161 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1173 IF (iget(411)>0 .OR. iget(412)>0 .OR. iget(413)>0)
THEN
1182 iget1 = -1 ; iget2 = -1 ; iget3 = -1
1183 if (iget(411) > 0) iget1 = lvls(lp,iget(411))
1184 if (iget(412) > 0) iget2 = lvls(lp,iget(412))
1185 if (iget(413) > 0) iget3 = lvls(lp,iget(413))
1186 IF (iget1 > 0 .or. iget2 > 0 .or. iget3 > 0)
then
1189 jj = float(jsta+jend)/2.0
1190 ii = float(ista+iend)/3.0
1191 DO j=jsta_2l,jend_2u
1192 DO i=ista_2l,iend_2u
1203 llmh = nint(lmh(i,j))
1206 zdum = zmid(i,j,l)-zint(i,j,llmh+1)
1207 IF(zdum >= zagl3(lp))
THEN
1218 IF(nl1x(i,j)==(llmh+1) .AND. zagl3(lp)>0.)
THEN
1235 DO 240 j=jsta_2l,jend_2u
1236 DO 240 i=ista_2l,iend_2u
1244 llmh = nint(lmh(i,j))
1245 IF(nl1x(i,j)<=llmh)
THEN
1256 zdum=zagl3(lp)+zint(i,j,nint(lmh(i,j))+1)
1257 fact = (zdum-zmid(i,j,ll)) &
1258 / (zmid(i,j,ll)-zmid(i,j,ll-1))
1260 paglu = log(pmid(i,j,ll-1))
1261 pagll = log(pmid(i,j,ll))
1269 uaglu = uh(i,j,ll-1)
1272 vaglu = vh(i,j,ll-1)
1275 pagl(i,j) = exp(pagll+(pagll-paglu)*fact)
1276 tagl(i,j) = tagll+(tagll-taglu)*fact
1277 qagl(i,j) = qagll+(qagll-qaglu)*fact
1278 uagl(i,j) = uagll+(uagll-uaglu)*fact
1279 vagl(i,j) = vagll+(vagll-vaglu)*fact
1286 pagl(i,j) = pmid(i,j,nint(lmv(i,j)))
1287 tagl(i,j) = t(i,j,nint(lmv(i,j)))
1288 qagl(i,j) = q(i,j,nint(lmv(i,j)))
1289 uagl(i,j) = uh(i,j,nint(lmv(i,j)))
1290 vagl(i,j) = vh(i,j,nint(lmv(i,j)))
1305 IF((iget(411)>0) )
THEN
1308 IF(qagl(i,j)<spval.and.pagl(i,j)<spval.and.tagl(i,j)<spval.and.&
1309 uagl(i,j)<spval.and.vagl(i,j)<spval)
THEN
1310 qagl(i,j)=qagl(i,j)/1000.0
1311 pv=qagl(i,j)*pagl(i,j)/(eps*(1-qagl(i,j)) + qagl(i,j))
1312 rho=(1/tagl(i,j))*(((pagl(i,j)-pv)/rd) + pv/461.495)
1313 grid1(i,j)=0.5*rho*(sqrt(uagl(i,j)**2+vagl(i,j)**2))**3
1319 if(grib==
"grib2" )
then
1321 fld_info(cfld)%ifld=iavblfld(iget(411))
1322 fld_info(cfld)%lvl=lvlsxml(lp,iget(411))
1323 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1327 IF((iget(412)>0) )
THEN
1330 grid1(i,j)=uagl(i,j)
1333 if(grib==
"grib2" )
then
1335 fld_info(cfld)%ifld=iavblfld(iget(412))
1336 fld_info(cfld)%lvl=lvlsxml(lp,iget(412))
1337 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
1341 IF((iget(413)>0) )
THEN
1344 grid1(i,j)=vagl(i,j)
1347 if(grib==
"grib2" )
then
1349 fld_info(cfld)%ifld=iavblfld(iget(413))
1350 fld_info(cfld)%lvl=lvlsxml(lp,iget(413))
1351 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)