SUBROUTINE MISCLN
!
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . .
! SUBPROGRAM: MISCLN POSTS MISCELLANEOUS FIELDS
! PRGRMMR: TREADON ORG: W/NP2 DATE: 92-12-20
!
! ABSTRACT:
! THIS ROUTINE HAS BECOME THE CATCH-ALL FOR MISCELLANEOUS
! OUTPUT FIELDS POSTED BY THE ETA POST PROCESSOR.
! CURRENTLY THIS ROUTINE POSTS THE FOLLOWING FIELDS:
! (1) TROPOPAUSE LEVEL Z,P, T, U, V, AND VERTICAL WIND SHEAR,
! (2) MAX WIND LEVEL Z, P, U, AND V,
! (3) FD LEVEL T, Q, U, AND V,
! (4) FREEZING LEVEL Z AND RH,
! (5) CONSTANT MASS (BOUNDARY) FIELDS,
! (6) LFM LOOK-ALIKE FIELDS, AND
! (7) NGM LOOK-ALIKE FIELDS.
!
! .
!
! PROGRAM HISTORY LOG:
! 92-12-20 RUSS TREADON
! 93-06-19 RUSS TREADON - ADDED TYPE 2 CAPE POSTING.
! 94-11-07 MIKE BALDWIN - ADDED HELICITY POSTING.
! 96-03-26 MIKE BALDWIN - CHANGE ETA BOUNDARY LAYER LABELS FOR GRIB
! 96-11-19 MIKE BALDWIN - BACK OUT PREVIOUS CHANGE
! 97-04-25 MIKE BALDWIN - CHANGE ETA BOUNDARY LAYER LABELS FOR GRIB
! 97-04-29 GEOFF MANIKIN - ADDED TROPOPAUSE HEIGHT AND
! MAX WIND LEVEL FIELDS
! 98-06-15 T BLACK - CONVERSION FROM 1-D TO 2-D
! 98-07-17 MIKE BALDWIN - REMOVED LABL84
! 00-01-04 JIM TUCCILLO - MPI VERSION
! 02-04-23 MIKE BALDWIN - WRF VERSION
! 11-02-06 JUN WANG - ADD GRIB2 OPTION
! 11-10-16 SARAH LU - ADD FD LEVEL DUST/ASH
! 12-04-03 Jun Wang - FIXED LVLSXML for fields at FD height (spec_hgt_lvl_above_grnd)
!
! USAGE: CALL MISCLN
! INPUT ARGUMENT LIST:
!
! OUTPUT ARGUMENT LIST:
! NONE
!
! SUBPROGRAMS CALLED:
! UTILITIES:
! TRPAUS - COMPUTE TROPOPAUSE LEVEL FIELDS.
! CALMXW - COMPUTE MAX WIND LEVEL FIELDS.
! SCLFLD - SCALE ARRAY ELEMENTS BY CONSTANT.
! GRIBIT - OUTPUT FIELD TO GRIB FILE.
! CALPOT - CALCULATE POTENTIAL TEMPERATURE.
! FDLVL - COMPUTE FD LEVEL DATA (AGL OR MSL).
! FRZLVL - COMPUTE FREEZING LEVEL DATA.
! BOUND - BOUND ARRAY ELEMENTS BETWEEN MINIMUM AND MAXIMUM VALUES.
! BNDLYR - COMPUTE BOUNDARY LAYER FIELDS.
! CALDWP - CALCULATE DEWPOINT TEMPERATURE.
! OTLFT - COMPUTE LIFTED INDEX AT 500MB.
! CALLCL - COMPUTE LCL DATA.
! LFMFLD - COMPUTE LFM LOOK-ALIKE FIELDS.
! NGMFLD - COMPUTE NGM LOOK-ALIKE FIELDS.
! CALTHTE - COMPUTE THETA-E.
! CALHEL - COMPUTE HELICITY AND STORM MOTION.
!
! LIBRARY:
! COMMON - RQSTFLD
! CTLBLK
!
! ATTRIBUTES:
! LANGUAGE: FORTRAN
! MACHINE : CRAY C-90
!$$$
!
use vrbls3d, only: pmid, uh, vh, t, zmid, pint, alpint, q, omga
use vrbls2d, only: pblh, cprate
use masks, only: lmh
use params_mod, only: d00, h99999, h100, h1, h1m12, pq0, a2, a3,&
a4, rhmin, rgamog
use ctlblk_mod, only: grib, cfld, fld_info, datapd, im, jsta, &
jend, jm, nbnd, nbin_du, lm, htfd, spval, pthresh, nfd,petabnd
use rqstfld_mod, only: iget, lvls, id, iavblfld, lvlsxml
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
! SET LOCAL PARAMETERS. MAKE SURE NFD AND NBND AGREE
! WITH THE VALUES SET IN SUBROUTINES FDLVL AND BNDLYR,
! RESPECTIVELY.
real,PARAMETER :: C2K=273.15
real,parameter:: con_rd =2.8705e+2 ! gas constant air (J/kg/K)
real,parameter:: con_rv =4.6150e+2 ! gas constant H2O
real,parameter:: con_eps =con_rd/con_rv
real,parameter:: con_epsm1 =con_rd/con_rv-1
real,parameter:: cpthresh =0.000004
!
! DECLARE VARIABLES.
!
LOGICAL NORTH
LOGICAL FIELD1,FIELD2
LOGICAL DONE(IM,JSTA:JEND),DONE1(IM,JSTA:JEND)
INTEGER LVLBND(IM,JM,NBND),LB2(IM,JM),LPBL(IM,JM)
REAL P1D(IM,JM),T1D(IM,JM),Q1D(IM,JM),U1D(IM,JM),V1D(IM,JM)
REAL SHR1D(IM,JM),Z1D(IM,JM),RH1D(IM,JM)
REAL OMGBND(IM,JM,NBND),PWTBND(IM,JM,NBND)
REAL QCNVBND(IM,JM,NBND)
REAL PBND(IM,JM,NBND),TBND(IM,JM,NBND),QBND(IM,JM,NBND)
REAL UBND(IM,JM,NBND),VBND(IM,JM,NBND),RHBND(IM,JM,NBND)
REAL WBND(IM,JM,NBND)
REAL T78483(IM,JM),T89671(IM,JM),P78483(IM,JM),P89671(IM,JM)
REAL PKU1
REAL QM8510(IM,JM),RH4710(IM,JM),RH8498(IM,JM)
REAL RH4796(IM,JM),RH1847(IM,JM),UST(IM,JM),VST(IM,JM)
REAL RH3310(IM,JM),RH6610(IM,JM),RH3366(IM,JM),PW3310(IM,JM)
REAL RH4410(IM,JM),RH7294(IM,JM),RH4472(IM,JM)
! REAL T7D(IM,JSTA:JEND,NFD),Q7D(IM,JSTA:JEND,NFD),U7D(IM,JSTA:JEND,NFD),V6D(IM,JSTA:JEND,NFD) &
! ,P7D(IM,JSTA:JEND,NFD),ICINGFD(IM,JSTA:JEND,NFD),AERFD(IM,JSTA:JEND,NFD,NBIN_DU)
REAL,ALLOCATABLE :: T7D(:,:,:),Q7D(:,:,:),U7D(:,:,:),V6D(:,:,:) &
,P7D(:,:,:),ICINGFD(:,:,:),AERFD(:,:,:,:)
REAL HELI(IM,JM,2)
REAL EGRID1(IM,JM),EGRID2(IM,JM),EGRID3(IM,JM)
REAL EGRID4(IM,JM),EGRID5(IM,JM)
REAL GRID1(IM,JM),GRID2(IM,JM)
REAL P_THETAEMAX(IM,JM)
REAL USHR1(IM,JM),VSHR1(IM,JM),USHR6(IM,JM),VSHR6(IM,JM)
REAL MAXWP(IM,JM),MAXWZ(IM,JM),MAXWU(IM,JM), MAXWV(IM,JM) &
& ,MAXWT(IM,JM)
REAL RHPW(IM,JM)
!
integer I,J,L,ITYPE,ISVALUE,LBND,ILVL,IFD,ITYPEFDLVL(NFD)
real DPBND,PKL1,FAC1,FAC2,PL,TL,QL,QSAT,RHL,TVRL,TVRBLO, &
ES1,ES2,QS1,QS2,RH1,RH2,ZSF,DEPTH(2)
real,external :: fpvsnew
!
!
!****************************************************************************
! START MISCLN HERE.
!
! HELICITY AND STORM MOTION.
IF (IGET(162).GT.0.OR.IGET(163).GT.0.OR.IGET(164).GT.0) THEN
DEPTH(1)=3000.0
DEPTH(2)=1000.0
IF(LVLS(1,IGET(162)).GT.0) then
CALL CALHEL(DEPTH,UST,VST,HELI,USHR1,VSHR1,USHR6,VSHR6)
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=HELI(I,J,1)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 30
ID(11) = 0
CALL GRIBIT(IGET(162),LVLS(1,IGET(162)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(162))
fld_info(cfld)%lvl=LVLSXML(1,IGET(162))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF(LVLS(2,IGET(162)).GT.0) then
CALL CALHEL(DEPTH,UST,VST,HELI,USHR1,VSHR1,USHR6,VSHR6)
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=HELI(I,J,2)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 10
ID(11) = 0
CALL GRIBIT(IGET(162),LVLS(1,IGET(162)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(162))
fld_info(cfld)%lvl=LVLSXML(2,IGET(162))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF (IGET(163).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=UST(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 60
ID(11) = 0
CALL GRIBIT(IGET(163),LVLS(1,IGET(163)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(163))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF (IGET(164).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=VST(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 60
ID(11) = 0
CALL GRIBIT(IGET(164),LVLS(1,IGET(164)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(164))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
! UPDRAFT HELICITY
if (IGET(427).GT.0) THEN
CALL CALUPDHEL(EGRID1)
if(grib=='grib1') then
ID(1:25) = 0
ID(02) = 129
ID(09) = 106
ID(10) = 50
ID(11) = 20
CALL GRIBIT(IGET(427),LVLS(1,IGET(427)),EGRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(427))
datapd(1:im,1:jend-jsta+1,cfld)=EGRID1(1:im,jsta:jend)
endif
ENDIF
! CRA 0-1 KM AND 0-6 KM SHEAR
IF(IGET(430).GT.0.OR.IGET(431).GT.0.OR.IGET(432).GT.0 &
.OR.IGET(303).GT.0) THEN
DEPTH=6000.0
CALL CALHEL(DEPTH,UST,VST,HELI,USHR1,VSHR1,USHR6,VSHR6)
IF(IGET(430).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=USHR1(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 10
ID(11) = 0
CALL GRIBIT(IGET(430),LVLS(1,IGET(430)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(430))
datapd(1:im,1:jend-jsta+1,cfld)=EGRID1(1:im,jsta:jend)
endif
ENDIF
IF(IGET(431).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=VSHR1(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 10
ID(11) = 0
CALL GRIBIT(IGET(431),LVLS(1,IGET(431)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(431))
datapd(1:im,1:jend-jsta+1,cfld)=EGRID1(1:im,jsta:jend)
endif
ENDIF
IF(IGET(432).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=USHR6(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 60
ID(11) = 0
CALL GRIBIT(IGET(432),LVLS(1,IGET(432)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(432))
datapd(1:im,1:jend-jsta+1,cfld)=EGRID1(1:im,jsta:jend)
endif
ENDIF
IF(IGET(433).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=VSHR6(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
ID(10) = 60
ID(11) = 0
CALL GRIBIT(IGET(433),LVLS(1,IGET(433)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(433))
datapd(1:im,1:jend-jsta+1,cfld)=EGRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
! CRA
!
!
!
! ***BLOCK 1: TROPOPAUSE P, Z, T, U, V, AND WIND SHEAR.
!
IF ( (IGET(054).GT.0).OR.(IGET(055).GT.0).OR. &
(IGET(056).GT.0).OR.(IGET(057).GT.0).OR. &
(IGET(177).GT.0).OR. &
(IGET(058).GT.0).OR.(IGET(108).GT.0) ) THEN
! Chuang: Use GFS algorithm per Iredell's and DiMego's decision on unification
DO J=JSTA,JEND
DO I=1,IM
! INPUT
CALL TPAUSE(LM,PMID(I,J,1:LM),UH(I,J,1:LM) &
! INPUT
,VH(I,J,1:LM),T(I,J,1:LM),ZMID(I,J,1:LM) &
! OUTPUT
,P1D(I,J),U1D(I,J),V1D(I,J),T1D(I,J) &
! OUTPUT
,Z1D(I,J),SHR1D(I,J)) ! OUTPUT
END DO
END DO
!
! TROPOPAUSE PRESSURE.
IF (IGET(054).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=P1D(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(054),LVLS(1,IGET(054)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(054))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! ICAO HEIGHT OF TROPOPAUSE
IF (IGET(399).GT.0) THEN
CALL ICAOHEIGHT(P1D, & !input
GRID1) ! output
! print*,'sample TROPOPAUSE ICAO HEIGHTS',GRID1(im/2,(jsta+jend)/2)
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(399),LVLS(1,IGET(399)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(399))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! TROPOPAUSE HEIGHT.
IF (IGET(177).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=Z1D(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(177),LVLS(1,IGET(177)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(177))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! TROPOPAUSE TEMPERATURE.
IF (IGET(055).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=T1D(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(055),LVLS(1,IGET(055)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(055))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! TROPOPAUSE POTENTIAL TEMPERATURE.
IF (IGET(108).GT.0) THEN
CALL CALPOT(P1D,T1D,EGRID1)
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(108),LVLS(1,IGET(108)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(108))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! TROPOPAUSE U WIND AND/OR V WIND.
IF ((IGET(056).GT.0).OR.(IGET(057).GT.0)) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=U1D(I,J)
GRID2(I,J)=V1D(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
IF (IGET(056).GT.0) CALL GRIBIT(IGET(056), &
LVLS(1,IGET(056)),GRID1,IM,JM)
ID(1:25) = 0
IF (IGET(057).GT.0) CALL GRIBIT(IGET(057), &
LVLS(1,IGET(057)),GRID2,IM,JM)
elseif(grib=='grib2') then
if(IGET(056).GT.0) then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(056))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
if(IGET(057).GT.0) then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(057))
datapd(1:im,1:jend-jsta+1,cfld)=GRID2(1:im,jsta:jend)
endif
endif
ENDIF
!
! TROPOPAUSE WIND SHEAR.
IF (IGET(058).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=SHR1D(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(058),LVLS(1,IGET(058)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(058))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
!
!
! ***BLOCK 2: MAX WIND LEVEL P, Z, U, AND V
!
! MAX WIND LEVEL CALCULATIONS
IF ((IGET(173).GT.0) .OR. (IGET(174).GT.0) .OR. &
(IGET(175).GT.0) .OR. (IGET(176).GT.0)) THEN
! CALL CALMXW(MAXWP,MAXWZ,MAXWU,MAXWV,MAXWT)
! Chuang: Use GFS algorithm per Iredell's and DiMego's decision on unification
DO J=JSTA,JEND
DO I=1,IM
! INPUT
CALL MXWIND(LM,PMID(I,J,1:LM),UH(I,J,1:LM) &
! INPUT
,VH(I,J,1:LM),T(I,J,1:LM),ZMID(I,J,1:LM) &
! OUTPUT
,MAXWP(I,J),MAXWU(I,J),MAXWV(I,J) &
! OUTPUT
,MAXWT(I,J),MAXWZ(I,J))
END DO
END DO
ENDIF
! PRESSURE OF MAX WIND LEVEL
IF (IGET(173).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=MAXWP(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(173),LVLS(1,IGET(173)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(173))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! ICAO HEIGHT OF MAX WIND LEVEL
IF (IGET(398).GT.0) THEN
CALL ICAOHEIGHT(MAXWP, & !input
GRID1) ! output
! print*,'sample MAX WIND ICAO HEIGHTS',GRID1(im/2,(jsta+jend)/2)
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(398),LVLS(1,IGET(398)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(398))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! HEIGHT OF MAX WIND LEVEL
IF (IGET(174).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=MAXWZ(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(174),LVLS(1,IGET(174)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(174))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! MAX WIND LEVEL U WIND AND/OR V WIND.
IF ((IGET(175).GT.0).OR.(IGET(176).GT.0)) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=MAXWU(I,J)
GRID2(I,J)=MAXWV(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
IF (IGET(175).GT.0) CALL GRIBIT(IGET(175), &
LVLS(1,IGET(175)),GRID1,IM,JM)
ID(1:25) = 0
IF (IGET(176).GT.0) CALL GRIBIT(IGET(176), &
LVLS(1,IGET(176)),GRID2,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(175))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(176))
datapd(1:im,1:jend-jsta+1,cfld)=GRID2(1:im,jsta:jend)
endif
ENDIF
! TEMPERATURE OF MAX WIND LEVEL
IF (IGET(314).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=MAXWT(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(314),LVLS(1,IGET(314)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(314))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
!
!
! ***BLOCK 3: FD LEVEL T, Q, U, AND V.
!
IF ( (IGET(059).GT.0.or.IGET(586)>0).OR. &
(IGET(060).GT.0.or.IGET(576)>0).OR. &
(IGET(061).GT.0.or.IGET(577)>0).OR. &
(IGET(601).GT.0.or.IGET(602)>0.or.IGET(603)>0).OR. &
(IGET(604).GT.0.or.IGET(605)>0).OR. &
(IGET(451).GT.0.or.IGET(578)>0).OR.IGET(580).GT.0 ) THEN
ALLOCATE(T7D(IM,JSTA:JEND,NFD),Q7D(IM,JSTA:JEND,NFD),&
U7D(IM,JSTA:JEND,NFD),V6D(IM,JSTA:JEND,NFD),&
P7D(IM,JSTA:JEND,NFD),ICINGFD(IM,JSTA:JEND,NFD) &
,AERFD(IM,JSTA:JEND,NFD,NBIN_DU))
!
! DETERMINE WHETHER TO DO MSL OR AGL FD LEVELS
!
ITYPEFDLVL=1
DO IFD = 1,NFD
IF (IGET(059).GT.0) THEN
IF (LVLS(IFD,IGET(059)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
!for grib2, spec hgt only
IF (IGET(586).GT.0) THEN
IF(LVLS(IFD,IGET(586))>0) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(060).GT.0) THEN
IF (LVLS(IFD,IGET(060)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(576).GT.0) THEN
IF(LVLS(IFD,IGET(576))>0) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(061).GT.0) THEN
IF (LVLS(IFD,IGET(061)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(577).GT.0) then
if(LVLS(IFD,IGET(577))>0) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(451).GT.0) THEN
IF (LVLS(IFD,IGET(451)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(578).GT.0) then
if(LVLS(IFD,IGET(578))>0) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(580).GT.0) then
if(LVLS(IFD,IGET(580))>1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(587).GT.0) then
if(LVLS(IFD,IGET(587))>0) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(601).GT.0) THEN
IF (LVLS(IFD,IGET(601)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(602).GT.0) THEN
IF (LVLS(IFD,IGET(602)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(603).GT.0) THEN
IF (LVLS(IFD,IGET(603)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(604).GT.0) THEN
IF (LVLS(IFD,IGET(604)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
IF (IGET(605).GT.0) THEN
IF (LVLS(IFD,IGET(605)).GT.1) ITYPEFDLVL(IFD)=2
ENDIF
ENDDO
! print *,'call FDLVL with ITYPEFDLVL: ', ITYPEFDLVL,'for tmp,lvls=',LVLS(1:15,iget(59)), &
! 'grib2tmp lvs=',LVLS(1:15,iget(586))
CALL FDLVL(ITYPEFDLVL,T7D,Q7D,U7D,V6D,P7D,ICINGFD,AERFD)
!
DO 10 IFD = 1,NFD
ID(1:25) = 0
ISVALUE = NINT(HTFD(IFD))
ID(11) = ISVALUE
if(ITYPEFDLVL(IFD)==2)ID(9)=105
!
! FD LEVEL TEMPERATURE.
IF (IGET(059).GT.0.or.IGET(586)>0) THEN
IF (LVLS(IFD,IGET(059)).GT.0.or.LVLS(IFD,IGET(586))>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=T7D(I,J,IFD)
ENDDO
ENDDO
IF(LVLS(IFD,IGET(059)).GT.0) then
if(grib=='grib1') then
CALL GRIBIT(IGET(059),LVLS(IFD,IGET(059)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(059))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(059))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF (LVLS(IFD,IGET(586))>0) THEN
if(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(586))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(586))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
ENDIF
!
! FD LEVEL SPEC HUMIDITY.
IF (IGET(451).GT.0.or.iget(578)>0) THEN
IF (LVLS(IFD,IGET(451)).GT.0.or.LVLS(IFD,IGET(578))>0)THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=Q7D(I,J,IFD)
ENDDO
ENDDO
if(LVLS(IFD,IGET(451))>0) then
if(grib=='grib1') then
CALL GRIBIT(IGET(451),LVLS(IFD,IGET(451)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(451))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(451))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
if(LVLS(IFD,IGET(578))>0) then
if(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(578))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(578))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
!
! FD LEVEL PRESSURE
IF (IGET(482).GT.0.or.IGET(579)>0) THEN
IF (LVLS(IFD,IGET(482)).GT.0.or.LVLS(IFD,IGET(579))>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=P7D(I,J,IFD)
ENDDO
ENDDO
if(LVLS(IFD,IGET(482))>0) then
if(grib=='grib1') then
CALL GRIBIT(IGET(482),LVLS(IFD,IGET(482)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(482))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(482))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
if(LVLS(IFD,IGET(579))>0) then
if(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(579))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(579))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
!
! FD LEVEL ICING
IF (IGET(580).GT.0..or.IGET(587)>0) THEN
IF (LVLS(IFD,IGET(580)).GT.0.or.LVLS(IFD,IGET(587))>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=ICINGFD(I,J,IFD)
ENDDO
ENDDO
if(iget(580)>0) then
if(grib=='grib1') then
CALL GRIBIT(IGET(580),LVLS(IFD,IGET(580)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(580))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(580))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
if(LVLS(IFD,IGET(587))>0) then
if(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(587))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(587))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
!
! ADD FD LEVEL DUST/ASH (GOCART)
IF (IGET(601).GT.0) THEN ! DUST 1
IF (LVLS(IFD,IGET(601)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=AERFD(I,J,IFD,1)
ENDDO
ENDDO
if(iget(601)>0) then
if(grib=='grib1') then
ID(02)=141 ! Parameter Table 141
CALL GRIBIT(IGET(601),LVLS(IFD,IGET(601)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(601))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(601))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
IF (IGET(602).GT.0) THEN ! DUST 2
IF (LVLS(IFD,IGET(602)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=AERFD(I,J,IFD,2)
ENDDO
ENDDO
if(iget(602)>0) then
if(grib=='grib1') then
ID(02)=141 ! Parameter Table 141
CALL GRIBIT(IGET(602),LVLS(IFD,IGET(602)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(602))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(602))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
IF (IGET(603).GT.0) THEN ! DUST 3
IF (LVLS(IFD,IGET(603)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=AERFD(I,J,IFD,3)
ENDDO
ENDDO
if(iget(603)>0) then
if(grib=='grib1') then
ID(02)=141 ! Parameter Table 141
CALL GRIBIT(IGET(603),LVLS(IFD,IGET(603)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(603))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(603))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
IF (IGET(604).GT.0) THEN ! DUST 4
IF (LVLS(IFD,IGET(604)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=AERFD(I,J,IFD,4)
ENDDO
ENDDO
if(iget(604)>0) then
if(grib=='grib1') then
ID(02)=141 ! Parameter Table 141
CALL GRIBIT(IGET(604),LVLS(IFD,IGET(604)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(604))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(604))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
IF (IGET(605).GT.0) THEN ! DUST 5
IF (LVLS(IFD,IGET(605)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=AERFD(I,J,IFD,5)
ENDDO
ENDDO
if(iget(605)>0) then
if(grib=='grib1') then
ID(02)=141 ! Parameter Table 141
CALL GRIBIT(IGET(605),LVLS(IFD,IGET(605)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(605))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(605))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
endif
ENDIF
ENDIF
!
!
! FD LEVEL U WIND AND/OR V WIND.
IF ((IGET(060).GT.0).OR.(IGET(061).GT.0)) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=U7D(I,J,IFD)
GRID2(I,J)=V6D(I,J,IFD)
ENDDO
ENDDO
IF (IGET(060).GT.0) THEN
IF (LVLS(IFD,IGET(060)).GT.0) then
if(grib=='grib1') then
CALL GRIBIT( &
IGET(060),LVLS(IFD,IGET(060)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(060))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(060))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
IF (IGET(061).GT.0) THEN
IF (LVLS(IFD,IGET(061)).GT.0) THEN
if(grib=='grib1') then
CALL GRIBIT( &
IGET(061),LVLS(IFD,IGET(061)),GRID2,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(061))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(061))
datapd(1:im,1:jend-jsta+1,cfld)=GRID2(1:im,jsta:jend)
endif
ENDIF
ENDIF
ENDIF
!
! FD LEVEL U WIND AND/OR V WIND.
IF ((IGET(576).GT.0).OR.(IGET(577).GT.0)) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=U7D(I,J,IFD)
GRID2(I,J)=V6D(I,J,IFD)
ENDDO
ENDDO
IF (IGET(576).GT.0) THEN
IF (LVLS(IFD,IGET(576)).GT.0) then
if(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(576))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(576))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
IF (IGET(577).GT.0) THEN
IF (LVLS(IFD,IGET(577)).GT.0) THEN
if(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(577))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(577))
datapd(1:im,1:jend-jsta+1,cfld)=GRID2(1:im,jsta:jend)
endif
ENDIF
ENDIF
ENDIF
10 CONTINUE
DEALLOCATE(T7D,Q7D,U7D,V6D,P7D,ICINGFD,AERFD)
ENDIF
!
!
!
! ***BLOCK 4: FREEZING LEVEL Z, RH AND P.
!
IF ( (IGET(062).GT.0).OR.(IGET(063).GT.0) ) THEN
CALL FRZLVL(Z1D,RH1D,P1D)
!
! FREEZING LEVEL HEIGHT.
IF (IGET(062).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=Z1D(I,J)
ENDDO
ENDDO
CALL BOUND (GRID1,D00,H99999)
ID(1:25) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(062),LVLS(1,IGET(062)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(062))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! FREEZING LEVEL RELATIVE HUMIDITY.
IF (IGET(063).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH1D(I,J)
ENDDO
ENDDO
ID(1:25) = 0
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(063),LVLS(1,IGET(063)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(063))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! FREEZING LEVEL PRESSURE
IF (IGET(753).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=P1D(I,J)
ENDDO
ENDDO
ID(1:25) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(753),LVLS(1,IGET(753)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(753))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
IF (IGET(165).GT.0 .OR. IGET(350).GT.0.OR. IGET(756).GT.0) THEN
CALL FRZLVL2(Z1D,RH1D,P1D)
!
! HIGHEST FREEZING LEVEL HEIGHT.
IF (IGET(165).GT.0)THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=Z1D(I,J)
ENDDO
ENDDO
ID(1:25) = 0
CALL BOUND (GRID1,D00,H99999)
if(grib=='grib1') then
CALL GRIBIT(IGET(165),LVLS(1,IGET(165)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(165))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
END IF
! HIGHEST FREEZING LEVEL RELATIVE HUMIDITY
IF (IGET(350).GT.0)THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH1D(I,J)*100.
ENDDO
ENDDO
ID(1:25) = 0
CALL BOUND (GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(350),LVLS(1,IGET(350)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(350))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
END IF
! HIGHEST FREEZING LEVEL PRESSURE
IF (IGET(756).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=P1D(I,J)
ENDDO
ENDDO
ID(1:25) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(756),LVLS(1,IGET(756)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(756))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
!
!
! ***BLOCK 5: BOUNDARY LAYER FIELDS.
!
IF ( (IGET(067).GT.0).OR.(IGET(068).GT.0).OR. &
(IGET(069).GT.0).OR.(IGET(070).GT.0).OR. &
(IGET(071).GT.0).OR.(IGET(072).GT.0).OR. &
(IGET(073).GT.0).OR.(IGET(074).GT.0).OR. &
(IGET(088).GT.0).OR.(IGET(089).GT.0).OR. &
(IGET(090).GT.0).OR.(IGET(075).GT.0).OR. &
(IGET(109).GT.0).OR.(IGET(110).GT.0).OR. &
(IGET(031).GT.0).OR.(IGET(032).GT.0).OR. &
(IGET(573).GT.0).OR. &
(IGET(107).GT.0).OR.(IGET(091).GT.0).OR. &
(IGET(092).GT.0).OR.(IGET(093).GT.0).OR. &
(IGET(094).GT.0).OR.(IGET(095).GT.0).OR. &
(IGET(096).GT.0).OR.(IGET(097).GT.0).OR. &
(IGET(098).GT.0).OR.(IGET(221).GT.0) ) THEN
!
! COMPUTE ETA BOUNDARY LAYER FIELDS.
CALL BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
WBND,OMGBND,PWTBND,QCNVBND,LVLBND)
EGRID2=SPVAL
!
! LOOP OVER NBND BOUNDARY LAYERS.
DO 20 LBND = 1,NBND
ID(1:25) = 0
ID(10) = NINT(PETABND(LBND)+15.)
ID(11) = NINT(PETABND(LBND)-15.)
!
! BOUNDARY LAYER PRESSURE.
IF (IGET(067).GT.0) THEN
IF (LVLS(LBND,IGET(067)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=PBND(I,J,LBND)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(067),LVLS(LBND,IGET(067)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(067))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(067))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER TEMPERATURE.
IF (IGET(068).GT.0) THEN
IF (LVLS(LBND,IGET(068)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=TBND(I,J,LBND)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(068),LVLS(LBND,IGET(068)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(068))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(068))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER POTENTIAL TEMPERATURE.
IF (IGET(069).GT.0) THEN
IF (LVLS(LBND,IGET(069)).GT.0) THEN
CALL CALPOT(PBND(1,1,LBND),TBND(1,1,LBND),EGRID1)
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(069),LVLS(LBND,IGET(069)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(069))
fld_info(cfld)%lvl=LVLSXML(IFD,IGET(069))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER RELATIVE HUMIDITY.
IF (IGET(072).GT.0) THEN
IF (LVLS(LBND,IGET(072)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RHBND(I,J,LBND)
ENDDO
ENDDO
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(072),LVLS(LBND,IGET(072)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(072))
fld_info(cfld)%ifld=IAVBLFLD(IGET(072))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER DEWPOINT TEMPERATURE.
IF (IGET(070).GT.0) THEN
IF (LVLS(LBND,IGET(070)).GT.0) THEN
CALL CALDWP(PBND(1,1,LBND),QBND(1,1,LBND),EGRID1, &
TBND(1,1,LBND))
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(070),LVLS(LBND,IGET(070)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(070))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(070))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER SPECIFIC HUMIDITY.
IF (IGET(071).GT.0) THEN
IF (LVLS(LBND,IGET(071)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=QBND(I,J,LBND)
ENDDO
ENDDO
CALL BOUND(GRID1,H1M12,H99999)
if(grib=='grib1') then
CALL GRIBIT(IGET(071),LVLS(LBND,IGET(071)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(071))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(071))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER MOISTURE CONVERGENCE.
IF (IGET(088).GT.0) THEN
IF (LVLS(LBND,IGET(088)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=QCNVBND(I,J,LBND)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(088),LVLS(LBND,IGET(088)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(088))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(088))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER U WIND AND/OR V WIND.
!
FIELD1=.FALSE.
FIELD2=.FALSE.
!
IF(IGET(073).GT.0)THEN
IF(LVLS(LBND,IGET(073)).GT.0)FIELD1=.TRUE.
ENDIF
IF(IGET(074).GT.0)THEN
IF(LVLS(LBND,IGET(074)).GT.0)FIELD2=.TRUE.
ENDIF
!
IF(FIELD1.OR.FIELD2)THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=UBND(I,J,LBND)
GRID2(I,J)=VBND(I,J,LBND)
ENDDO
ENDDO
!
IF (IGET(073).GT.0) THEN
IF (LVLS(LBND,IGET(073)).GT.0) then
if(grib=='grib1') then
CALL GRIBIT(IGET(073), &
LVLS(LBND,IGET(073)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(073))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(073))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
IF (IGET(074).GT.0) THEN
IF (LVLS(LBND,IGET(074)).GT.0) THEN
if(grib=='grib1') then
CALL GRIBIT(IGET(074), &
LVLS(LBND,IGET(074)),GRID2,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(074))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(074))
datapd(1:im,1:jend-jsta+1,cfld)=GRID2(1:im,jsta:jend)
endif
ENDIF
ENDIF
ENDIF
!
! BOUNDARY LAYER OMEGA.
IF (IGET(090).GT.0) THEN
IF (LVLS(LBND,IGET(090)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=OMGBND(I,J,LBND)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(090),LVLS(LBND,IGET(090)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(090))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(090))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endiF
ENDIF
ENDIF
!
! BOUNDARY LAYER PRECIPITBLE WATER.
IF (IGET(089).GT.0) THEN
IF (LVLS(LBND,IGET(089)).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=PWTBND(I,J,LBND)
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H99999)
if(grib=='grib1') then
CALL GRIBIT(IGET(089),LVLS(LBND,IGET(089)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(089))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(089))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! BOUNDARY LAYER LIFTED INDEX.
IF (IGET(075).GT.0 .OR. IGET(031)>0) THEN
CALL OTLFT(PBND(1,1,LBND),TBND(1,1,LBND), &
QBND(1,1,LBND),EGRID1)
IF(IGET(075)>0)THEN
IF (LVLS(LBND,IGET(075)).GT.0) THEN
! CALL OTLFT(PBND(1,1,LBND),TBND(1,1,LBND), &
! QBND(1,1,LBND),EGRID1)
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(075),LVLS(LBND,IGET(075)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(075))
fld_info(cfld)%lvl=LVLSXML(LBND,IGET(075))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
END IF
IF(IGET(031)>0)THEN
DO J=JSTA,JEND
DO I=1,IM
EGRID2(I,J)=AMIN1(EGRID2(I,J),EGRID1(I,J))
END DO
END DO
END IF
ENDIF
!
! END OF ETA BOUNDARY LAYER LOOP.
20 CONTINUE
!
! BEST LIFTED INDEX FROM BOUNDARY LAYER FIELDS.
!
IF (IGET(031)>0) THEN
! DO J=JSTA,JEND
! DO I=1,IM
! EGRID1(I,J) = H99999
! EGRID2(I,J) = H99999
! ENDDO
! ENDDO
!
! DO 50 LBND = 1,NBND
! CALL OTLFT(PBND(1,1,LBND),TBND(1,1,LBND), &
! QBND(1,1,LBND),EGRID2)
! DO J=JSTA,JEND
! DO I=1,IM
! EGRID1(I,J)=AMIN1(EGRID1(I,J),EGRID2(I,J))
! ENDDO
! ENDDO
! 50 CONTINUE
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID2(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = PETABND(NBND)+15.
ID(11) = PETABND(1)-15.
print*,'writting out best lifted index'
if(grib=='grib1') then
CALL GRIBIT(IGET(031),LVLS(1,IGET(031)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(031))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
END IF
IF(IGET(573)> 0 ) THEN
if(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(573))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! BEST BOUNDARY LAYER CAPE AND CINS.
!
FIELD1=.FALSE.
FIELD2=.FALSE.
!
IF(IGET(032).GT.0)THEN
IF(LVLS(2,IGET(032)).GT.0)FIELD1=.TRUE.
ENDIF
IF(IGET(107).GT.0)THEN
IF(LVLS(2,IGET(107)).GT.0)FIELD2=.TRUE.
ENDIF
!
IF(IGET(566).GT.0)THEN
FIELD1=.TRUE.
ENDIF
IF(IGET(567).GT.0)THEN
FIELD2=.TRUE.
ENDIF
!
!if(grib=="grib2") print *,'in MISCLN.f,iget(566)=', &
! iget(566), 'iget(567)=',iget(567),'LVLSXML(1,IGET(566)=', &
! LVLSXML(1,IGET(566)),'LVLSXML(1,IGET(567)=', &
! LVLSXML(1,IGET(567)),'field1=',field1,'field2=',field2
!
IF(FIELD1.OR.FIELD2)THEN
ITYPE = 2
!
DO J=JSTA,JEND
DO I=1,IM
EGRID1(I,J) = -H99999
EGRID2(I,J) = -H99999
ENDDO
ENDDO
!
DO 80 LBND = 1,NBND
CALL CALTHTE(PBND(1,1,LBND),TBND(1,1,LBND), &
QBND(1,1,LBND),EGRID1)
DO J=JSTA,JEND
DO I=1,IM
IF (EGRID1(I,J).GT.EGRID2(I,J)) THEN
EGRID2(I,J) = EGRID1(I,J)
LB2(I,J) = LVLBND(I,J,LBND)
P1D(I,J) = PBND(I,J,LBND)
T1D(I,J) = TBND(I,J,LBND)
Q1D(I,J) = QBND(I,J,LBND)
ENDIF
ENDDO
ENDDO
80 CONTINUE
!
DPBND=0.
CALL CALCAPE(ITYPE,DPBND,P1D,T1D,Q1D,LB2,EGRID1, &
EGRID2,EGRID3,EGRID4,EGRID5)
!
IF (IGET(032).GT.0.or.IGET(566)>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H99999)
ID(1:25) = 0
ID(09) = 116
ID(10) = PETABND(NBND)+15.
ID(11) = PETABND(1)-15.
if(grib=='grib1') then
CALL GRIBIT(IGET(032),LVLS(1,IGET(032)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(566))
fld_info(cfld)%lvl=LVLSXML(1,IGET(566))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
IF (IGET(107).GT.0.or.IGET(567)>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID2(I,J)
ENDDO
ENDDO
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J) = -1.*GRID1(I,J)
ENDDO
ENDDO
!
CALL BOUND(GRID1,D00,H99999)
!
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J) = -1.*GRID1(I,J)
ENDDO
ENDDO
!
ID(1:25) = 0
ID(09) = 116
ID(10) = PETABND(NBND)+15.
ID(11) = PETABND(1)-15.
if(grib=='grib1') then
CALL GRIBIT(IGET(107),LVLS(1,IGET(107)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(567))
fld_info(cfld)%lvl=LVLSXML(1,IGET(567))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:iM,jsta:jend)
endif
ENDIF
ENDIF
!
! PBL HEIGHT
IF(IGET(221).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=PBLH(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
ID(1:25) = 0
CALL GRIBIT(IGET(221),LVLS(1,IGET(221)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(221))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
END IF
! BOUNDARY LAYER LIFTING CONDENSATION PRESSURE AND HEIGHT.
! EGRID1 IS LCL PRESSURE. EGRID2 IS LCL HEIGHT.
!
IF ( (IGET(109).GT.0).OR.(IGET(110).GT.0) ) THEN
CALL CALLCL(PBND(1,1,1),TBND(1,1,1), &
QBND(1,1,1),EGRID1,EGRID2)
IF (IGET(109).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID2(I,J)
ENDDO
ENDDO
ID(1:25) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(109),ILVL, GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(109))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF (IGET(110).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
ID(1:25) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(110),ILVL, GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(110))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! NGM BOUNDARY LAYER FIELDS.
!
IF ( (IGET(091).GT.0).OR.(IGET(092).GT.0).OR. &
(IGET(093).GT.0).OR.(IGET(094).GT.0).OR. &
(IGET(095).GT.0).OR.(IGET(095).GT.0).OR. &
(IGET(096).GT.0).OR.(IGET(097).GT.0).OR. &
(IGET(098).GT.0) ) THEN
!
! COMPUTE SIGMA 0.89671 AND 0.78483 TEMPERATURES
! INTERPOLATE LINEAR IN LOG P
IF (IGET(097).GT.0.OR.IGET(098).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
P78483(I,J)=ALOG(PINT(I,J,NINT(LMH(I,J)))*0.78483)
P89671(I,J)=ALOG(PINT(I,J,NINT(LMH(I,J)))*0.89671)
ENDDO
ENDDO
DONE =.FALSE.
DONE1=.FALSE.
DO L=2,LM
DO J=JSTA,JEND
DO I=1,IM
PKL1=0.5*(ALPINT(I,J,L)+ALPINT(I,J,L+1))
PKU1=0.5*(ALPINT(I,J,L)+ALPINT(I,J,L-1))
IF(I.EQ.1 .AND. J.EQ.1)PRINT*,'L,P89671,PKL1,PKU1= ', &
L,P89671(I,J), PKL1, PKU1
IF(P78483(I,J).LT.PKL1.AND.P78483(I,J).GT.PKU1)THEN
FAC1=(PKL1-P78483(I,J))/(PKL1-PKU1)
FAC2=(P78483(I,J)-PKU1)/(PKL1-PKU1)
T78483(I,J)=T(I,J,L)*FAC2+T(I,J,L-1)*FAC1
DONE1(I,J)=.TRUE.
ENDIF
IF(P89671(I,J).LT.PKL1.AND.P89671(I,J).GT.PKU1)THEN
FAC1=(PKL1-P89671(I,J))/(PKL1-PKU1)
FAC2=(P89671(I,J)-PKU1)/(PKL1-PKU1)
T89671(I,J)=T(I,J,L)*FAC2+T(I,J,L-1)*FAC1
DONE(I,J)=.TRUE.
IF(I.EQ.1 .AND. J.EQ.1)PRINT*,'done(1,1)= ',done(1,1)
ENDIF
ENDDO
ENDDO
ENDDO
! print*,'done(1,1)= ',done(1,1)
DO J=JSTA,JEND
DO I=1,IM
IF(.NOT. DONE(I,J))THEN
PL=PINT(I,J,LM-1)
TL=0.5*(T(I,J,LM-2)+T(I,J,LM-1))
QL=0.5*(Q(I,J,LM-2)+Q(I,J,LM-1))
QSAT=PQ0/PL *EXP(A2*(TL-A3)/(TL-A4))
!
RHL=QL/QSAT
!
IF(RHL.GT.1.)THEN
RHL=1.
QL =RHL*QSAT
ENDIF
!
IF(RHL.LT.RHmin)THEN
RHL=RHmin
QL =RHL*QSAT
ENDIF
!
TVRL =TL*(1.+0.608*QL)
TVRBLO=TVRL*(P89671(I,J)/PL)**RGAMOG
T89671(I,J) =TVRBLO/(1.+0.608*QL)
!
! PKL1=0.5*(ALPINT(I,J,LM)+ALPINT(I,J,LM+1))
! PKU1=0.5*(ALPINT(I,J,LM-1)+ALPINT(I,J,LM))
! T89671(I,J)=T(I,J,LM)+(T(I,J,LM)-T(I,J,LM-1))*
! + (P89671(I,J)-PKL1)/(PKL1-PKU1)
! print*,'Debug T89671= ',i,j
! + ,P89671(I,J), PKL1, PKU1
! + ,T89671(I,J),T(I,J,LM-1),T(I,J,LM)
END IF
IF(.NOT. DONE1(I,J))THEN
PL=PINT(I,J,LM-1)
TL=0.5*(T(I,J,LM-2)+T(I,J,LM-1))
QL=0.5*(Q(I,J,LM-2)+Q(I,J,LM-1))
QSAT=PQ0/PL *EXP(A2*(TL-A3)/(TL-A4))
!
RHL=QL/QSAT
!
IF(RHL.GT.1.)THEN
RHL=1.
QL =RHL*QSAT
ENDIF
!
IF(RHL.LT.RHmin)THEN
RHL=RHmin
QL =RHL*QSAT
ENDIF
!
TVRL =TL*(1.+0.608*QL)
TVRBLO=TVRL*(P78483(I,J)/PL)**RGAMOG
T78483(I,J) =TVRBLO/(1.+0.608*QL)
!
END IF
END DO
END DO
!
! SIGMA 0.89671 TEMPERATURE
IF (IGET(097).GT.0) THEN
ID(1:25) = 0
ISVALUE = 8967
ID(11) = ISVALUE
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=T89671(I,J)
IF(T89671(I,J).GT.350.)PRINT*,'LARGE T89671 ', &
I,J,T89671(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(097),LVLS(1,IGET(097)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(097))
fld_info(cfld)%lvl=LVLSXML(1,IGET(097))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.78483 TEMPERATURE
IF (IGET(098).GT.0) THEN
ID(1:25) = 0
ISVALUE = 7848
ID(11) = ISVALUE
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=T78483(I,J)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(098),LVLS(1,IGET(098)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(098))
fld_info(cfld)%lvl=LVLSXML(1,IGET(098))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! NGM SIGMA LAYER 0.98230 FIELDS. THESE FIELDS ARE
! THE FIRST ETA LAYER BOUNDARY LAYER FIELDS.
!
!
IF ( (IGET(091).GT.0).OR.(IGET(092).GT.0).OR. &
(IGET(093).GT.0).OR.(IGET(094).GT.0).OR. &
(IGET(095).GT.0).OR.(IGET(095).GT.0).OR. &
(IGET(096).GT.0) ) THEN
!
ID(1:25) = 0
ISVALUE = 9823
ID(11) = ISVALUE
!
! PRESSURE.
IF (IGET(091).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=PBND(I,J,1)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(091),LVLS(1,IGET(091)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(091))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! TEMPERATURE.
IF (IGET(092).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=TBND(I,J,1)
ENDDO
ENDDO
if(grib=='grib1') then
CALL GRIBIT(IGET(092),LVLS(1,IGET(092)), &
GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(092))
fld_info(cfld)%lvl=LVLSXML(1,IGET(092))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SPECIFIC HUMIDITY.
IF (IGET(093).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=QBND(I,J,1)
ENDDO
ENDDO
CALL BOUND(GRID1,H1M12,H99999)
if(grib=='grib1') then
CALL GRIBIT(IGET(093),LVLS(1,IGET(093)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(093))
fld_info(cfld)%lvl=LVLSXML(1,IGET(093))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! RELATIVE HUMIDITY.
IF (IGET(094).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RHBND(I,J,1)
ENDDO
ENDDO
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(094),LVLS(1,IGET(094)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(094))
fld_info(cfld)%lvl=LVLSXML(1,IGET(094))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! U AND/OR V WIND.
IF ((IGET(095).GT.0).OR.(IGET(096).GT.0)) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=UBND(I,J,1)
GRID2(I,J)=VBND(I,J,1)
ENDDO
ENDDO
IF (IGET(095).GT.0) then
if(grib=='grib1') then
CALL GRIBIT(IGET(095), &
LVLS(1,IGET(095)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(095))
fld_info(cfld)%lvl=LVLSXML(1,IGET(095))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF (IGET(096).GT.0) then
if(grib=='grib1') then
CALL GRIBIT(IGET(096), &
LVLS(1,IGET(096)),GRID2,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(096))
fld_info(cfld)%lvl=LVLSXML(1,IGET(096))
datapd(1:im,1:jend-jsta+1,cfld)=GRID2(1:im,jsta:jend)
endif
ENDIF
ENDIF
ENDIF
ENDIF
!
! ENDIF FOR BOUNDARY LAYER BLOCK.
!
ENDIF
!
!
!
! ***BLOCK 6: MISCELLANEOUS LAYER MEAN LFM AND NGM FIELDS.
!
IF ( (IGET(066).GT.0).OR.(IGET(081).GT.0).OR. &
(IGET(082).GT.0).OR.(IGET(104).GT.0).OR. &
(IGET(099).GT.0).OR.(IGET(100).GT.0).OR. &
(IGET(101).GT.0).OR.(IGET(102).GT.0).OR. &
(IGET(103).GT.0) ) THEN
!
! LFM "MEAN" RELATIVE HUMIDITIES AND PRECIPITABLE WATER.
!
IF ( (IGET(066).GT.0).OR.(IGET(081).GT.0).OR. &
(IGET(082).GT.0).OR.(IGET(104).GT.0) ) THEN
CALL LFMFLD(RH3310,RH6610,RH3366,PW3310)
ID(1:25) = 0
!
! SIGMA 0.33-1.00 MEAN RELATIVE HUMIIDITY.
IF (IGET(066).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH3310(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 33
ID(11) = 100
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(066),LVLS(1,IGET(066)), &
GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(066))
fld_info(cfld)%lvl=LVLSXML(1,IGET(066))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
! print *,'in miscln,RH0.33-1.0,cfld=',cfld,'fld=', &
! IAVBLFLD(IGET(066)),'lvl=',fld_info(cfld)%lvl
endif
ENDIF
!
! SIGMA 0.66-1.00 MEAN RELATIVE HUMIIDITY.
IF (IGET(081).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH6610(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 67
ID(11) = 100
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(081),LVLS(1,IGET(081)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(081))
fld_info(cfld)%lvl=LVLSXML(1,IGET(081))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.33-0.66 MEAN RELATIVE HUMIIDITY.
IF (IGET(082).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH3366(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 33
ID(11) = 67
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(082),LVLS(1,IGET(082)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(082))
fld_info(cfld)%lvl=LVLSXML(1,IGET(082))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.33-1.00 PRECIPITABLE WATER.
IF (IGET(104).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=PW3310(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 33
ID(11) = 100
CALL BOUND(GRID1,D00,H99999)
if(grib=='grib1') then
CALL GRIBIT(IGET(104),LVLS(1,IGET(104)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(104))
fld_info(cfld)%lvl=LVLSXML(1,IGET(104))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
! VARIOUS LAYER MEAN NGM SIGMA FIELDS.
!
IF ( (IGET(099).GT.0).OR.(IGET(100).GT.0).OR. &
(IGET(101).GT.0).OR.(IGET(102).GT.0).OR. &
(IGET(103).GT.0) ) THEN
CALL NGMFLD(RH4710,RH4796,RH1847,RH8498,QM8510)
!
! SIGMA 0.47191-1.00000 RELATIVE HUMIDITY.
IF (IGET(099).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH4710(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 47
ID(11) = 100
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(099),LVLS(1,IGET(099)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(099))
fld_info(cfld)%lvl=LVLSXML(1,IGET(099))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.47191-0.96470 RELATIVE HUMIDITY.
IF (IGET(100).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH4796(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 47
ID(11) = 96
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(100),LVLS(1,IGET(100)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(100))
fld_info(cfld)%lvl=LVLSXML(1,IGET(100))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.18019-0.47191 RELATIVE HUMIDITY.
IF (IGET(101).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH1847(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 18
ID(11) = 47
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(101),LVLS(1,IGET(101)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(101))
fld_info(cfld)%lvl=LVLSXML(1,IGET(101))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.84368-0.98230 RELATIVE HUMIDITY.
IF (IGET(102).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH8498(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 84
ID(11) = 98
CALL SCLFLD(GRID1,H100,IM,JM)
CALL BOUND(GRID1,H1,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(102),LVLS(1,IGET(102)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(102))
fld_info(cfld)%lvl=LVLSXML(1,IGET(102))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.85000-1.00000 MOISTURE CONVERGENCE.
IF (IGET(103).GT.0) THEN
! CONVERT TO DIVERGENCE FOR GRIB
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=-1.0*QM8510(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 85
ID(11) = 100
if(grib=='grib1') then
CALL GRIBIT(IGET(103),LVLS(1,IGET(103)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(103))
fld_info(cfld)%lvl=LVLSXML(1,IGET(103))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
ENDIF
IF ( (IGET(318).GT.0).OR.(IGET(319).GT.0).OR. &
(IGET(320).GT.0))THEN
CALL LFMFLD_GFS(RH4410,RH7294,RH4472,RH3310)
!
! SIGMA 0.44-1.00 MEAN RELATIVE HUMIIDITY.
IF (IGET(318).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH4410(I,J)*100.
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 44
ID(11) = 100
CALL BOUND(GRID1,D00,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(318),LVLS(1,IGET(318)), &
GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(318))
fld_info(cfld)%lvl=LVLSXML(1,IGET(318))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.72-0.94 MEAN RELATIVE HUMIIDITY.
IF (IGET(319).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH7294(I,J)*100.
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 72
ID(11) = 94
CALL BOUND(GRID1,D00,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(319),LVLS(1,IGET(319)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(319))
fld_info(cfld)%lvl=LVLSXML(1,IGET(319))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
!
! SIGMA 0.44-0.72 MEAN RELATIVE HUMIIDITY.
IF (IGET(320).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RH4472(I,J)*100.
ENDDO
ENDDO
ID(1:25) = 0
ID(10) = 44
ID(11) = 72
CALL BOUND(GRID1,D00,H100)
if(grib=='grib1') then
CALL GRIBIT(IGET(320),LVLS(1,IGET(320)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(320))
fld_info(cfld)%lvl=LVLSXML(1,IGET(320))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
END IF
! GFS computes sigma=0.9950 T, THETA, U, V from lowest two model level fields
IF ( (IGET(321).GT.0).OR.(IGET(322).GT.0).OR. &
(IGET(323).GT.0).OR.(IGET(324).GT.0).OR. &
(IGET(325).GT.0).OR.(IGET(326).GT.0) ) THEN
DO J=JSTA,JEND
DO I=1,IM
EGRID2(I,J)=0.995*PINT(I,J,LM+1)
EGRID1(I,J)=LOG(PMID(I,J,LM)/EGRID2(I,J)) &
/LOG(PMID(I,J,LM)/PMID(I,J,LM-1))
END DO
END DO
! Temperature
IF (IGET(321).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=T(I,J,LM)+(T(I,J,LM-1)-T(I,J,LM)) &
*EGRID1(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(11) = 9950
if(grib=='grib1') then
CALL GRIBIT(IGET(321),LVLS(1,IGET(321)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(321))
fld_info(cfld)%lvl=LVLSXML(1,IGET(321))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
! print *,'in miscln,iget(321,temp,sigmadata=',maxval(GRID1(1:im,jsta:jend)), &
! minval(GRID1(1:im,jsta:jend)),'grib=',grib
ENDIF
! Potential Temperature
IF (IGET(322).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID2(I,J)=T(I,J,LM)+(T(I,J,LM-1)-T(I,J,LM)) &
*EGRID1(I,J)
ENDDO
ENDDO
CALL CALPOT(EGRID2,GRID2,GRID1)
ID(1:25) = 0
ID(11) = 9950
if(grib=='grib1') then
CALL GRIBIT(IGET(322),LVLS(1,IGET(322)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(322))
fld_info(cfld)%lvl=LVLSXML(1,IGET(322))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! RH
IF (IGET(323).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
ES1=FPVSNEW(T(I,J,LM))
ES1=MIN(ES1,PMID(I,J,LM))
QS1=CON_EPS*ES1/(PMID(I,J,LM)+CON_EPSM1*ES1)
RH1=Q(I,J,LM)/QS1
ES2=FPVSNEW(T(I,J,LM-1))
ES2=MIN(ES2,PMID(I,J,LM-1))
QS2=CON_EPS*ES2/(PMID(I,J,LM-1)+CON_EPSM1*ES2)
RH2=Q(I,J,LM-1)/QS2
GRID1(I,J)=(RH1+(RH2-RH1)*EGRID1(I,J))*100.
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H100)
ID(1:25) = 0
ID(11) = 9950
if(grib=='grib1') then
CALL GRIBIT(IGET(323),LVLS(1,IGET(323)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(323))
fld_info(cfld)%lvl=LVLSXML(1,IGET(323))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! U
IF (IGET(324).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=UH(I,J,LM)+(UH(I,J,LM-1)-UH(I,J,LM)) &
*EGRID1(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(11) = 9950
if(grib=='grib1') then
CALL GRIBIT(IGET(324),LVLS(1,IGET(324)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(324))
fld_info(cfld)%lvl=LVLSXML(1,IGET(324))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! V
IF (IGET(325).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=VH(I,J,LM)+(VH(I,J,LM-1)-VH(I,J,LM)) &
*EGRID1(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(11) = 9950
if(grib=='grib1') then
CALL GRIBIT(IGET(325),LVLS(1,IGET(325)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(325))
fld_info(cfld)%lvl=LVLSXML(1,IGET(325))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! OMGA
IF (IGET(326).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=OMGA(I,J,LM)+(OMGA(I,J,LM-1)-OMGA(I,J,LM)) &
*EGRID1(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(11) = 9950
if(grib=='grib1') then
CALL GRIBIT(IGET(326),LVLS(1,IGET(326)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(326))
fld_info(cfld)%lvl=LVLSXML(1,IGET(326))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
END IF
! MIXED LAYER CAPE AND CINS
!
FIELD1=.FALSE.
FIELD2=.FALSE.
!
IF(IGET(032).GT.0)THEN
IF(LVLS(3,IGET(032)).GT.0)FIELD1=.TRUE.
ENDIF
IF(IGET(107).GT.0)THEN
IF(LVLS(3,IGET(107)).GT.0)FIELD2=.TRUE.
ENDIF
!
IF(IGET(582).GT.0)THEN
FIELD1=.TRUE.
ENDIF
IF(IGET(583).GT.0)THEN
FIELD2=.TRUE.
ENDIF
IF(FIELD1.OR.FIELD2)THEN
ITYPE = 2
!
DO J=JSTA,JEND
DO I=1,IM
EGRID1(I,J) = -H99999
EGRID2(I,J) = -H99999
ENDDO
ENDDO
DO J=JSTA,JEND
DO I=1,IM
LB2(I,J) = (LVLBND(I,J,1) + LVLBND(I,J,2) + &
LVLBND(I,J,3))/3
P1D(I,J) = (PBND(I,J,1) + PBND(I,J,2) + PBND(I,J,3))/3
T1D(I,J) = (TBND(I,J,1) + TBND(I,J,2) + TBND(I,J,3))/3
Q1D(I,J) = (QBND(I,J,1) + QBND(I,J,2) + QBND(I,J,3))/3
ENDDO
ENDDO
!
DPBND=0.
CALL CALCAPE(ITYPE,DPBND,P1D,T1D,Q1D,LB2,EGRID1, &
EGRID2,EGRID3,EGRID4,EGRID5)
IF (IGET(032).GT.0.or.IGET(582)>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H99999)
ID(1:25) = 0
ID(09) = 116
ID(10) = PETABND(3)+15.
ID(11) = PETABND(1)-15.
if(grib=='grib1') then
CALL GRIBIT(IGET(32),LVLS(3,IGET(32)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(582))
fld_info(cfld)%lvl=LVLSXML(1,IGET(582))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF (IGET(107).GT.0.or.IGET(583)>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=-1.*EGRID2(I,J)
ENDDO
ENDDO
!
CALL BOUND(GRID1,D00,H99999)
!
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J) = -1.*GRID1(I,J)
ENDDO
ENDDO
!
ID(1:25) = 0
ID(09) = 116
ID(10) = PETABND(3)+15.
ID(11) = PETABND(1)-15.
if(grib=='grib1') then
CALL GRIBIT(IGET(107),LVLS(3,IGET(107)), &
GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(583))
fld_info(cfld)%lvl=LVLSXML(1,IGET(583))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
! MIXED LAYER LIFTING CONDENSATION PRESSURE AND HEIGHT.
! EGRID1 IS LCL PRESSURE. EGRID2 IS LCL HEIGHT.
!
! IF ( (IGET(109).GT.0).OR.(IGET(110).GT.0) ) THEN
! CALL CALLCL(P1D,T1D,Q1D,EGRID1,EGRID2)
! IF (IGET(109).GT.0) THEN
! DO J=JSTA,JEND
! DO I=1,IM
! GRID1(I,J)=EGRID2(I,J)
! ENDDO
! ENDDO
!
! ID(1:25) = 0
!
! CALL GRIBIT(IGET(109),1,
! X GRID1,IM,JM)
! ENDIF
!
! IF (IGET(110).GT.0) THEN
! DO J=JSTA,JEND
! DO I=1,IM
! GRID1(I,J)=EGRID1(I,J)
! ENDDO
! ENDDO
!
! ID(1:25) = 0
!
! CALL GRIBIT(IGET(110),1,
! X GRID1,IM,JM)
! ENDIF
! ENDIF
!
! MOST UNSTABLE CAPE-LOWEST 300 MB
!
FIELD1=.FALSE.
FIELD2=.FALSE.
!
IF(IGET(032).GT.0)THEN
IF(LVLS(4,IGET(032)).GT.0)FIELD1=.TRUE.
ENDIF
IF(IGET(107).GT.0)THEN
IF(LVLS(4,IGET(107)).GT.0)FIELD2=.TRUE.
ENDIF
!
IF(IGET(584).GT.0)THEN
FIELD1=.TRUE.
ENDIF
IF(IGET(585).GT.0)THEN
FIELD2=.TRUE.
ENDIF
!
IF(FIELD1.OR.FIELD2)THEN
ITYPE = 1
!
DO J=JSTA,JEND
DO I=1,IM
EGRID1(I,J) = -H99999
EGRID2(I,J) = -H99999
ENDDO
ENDDO
DPBND=300.E2
CALL CALCAPE(ITYPE,DPBND,P1D,T1D,Q1D,LB2,EGRID1, &
EGRID2,EGRID3,EGRID4,EGRID5)
!
IF (IGET(032).GT.0.or.IGET(584)>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID1(I,J)
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H99999)
ID(1:25) = 0
ID(09) = 116
ID(10) = 255
ID(11) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(32),4,GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(584))
fld_info(cfld)%lvl=LVLSXML(1,IGET(584))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
IF (IGET(107).GT.0.or.IGET(585)>0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=-1.0*EGRID2(I,J)
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H99999)
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J) = -1.*GRID1(I,J)
ENDDO
ENDDO
ID(1:25)=0
ID(09) = 116
ID(10) = 255
ID(11) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(107),4,GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(585))
fld_info(cfld)%lvl=LVLSXML(1,IGET(585))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! EQUILLIBRIUM HEIGHT
IF (IGET(443).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID4(I,J)
ENDDO
ENDDO
ID(1:25) = 0
if(grib=='grib1') then
CALL GRIBIT(IGET(443),LVLS(1,IGET(443)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(443))
fld_info(cfld)%lvl=LVLSXML(1,IGET(443))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! PRESSURE OF LEVEL FROM WHICH 300 MB MOST UNSTABLE CAPE
! PARCEL WAS LIFTED (eq. PRESSURE OF LEVEL OF HIGHEST THETA-E)
IF (IGET(246).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=EGRID3(I,J)
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H99999)
ID(1:25) = 0
ID(02) = 129
ID(09) = 116
ID(10) = 255
ID(11) = 0
! print *,'in miscln,PLPL=',maxval(grid1(1:im,jsta:jend)), &
! minval(grid1(1:im,jsta:jend))
if(grib=='grib1') then
CALL GRIBIT(IGET(246),1,GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(246))
fld_info(cfld)%lvl=LVLSXML(1,IGET(246))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF ! 246
! GENERAL THUNDER PARAMETER ??? 458 ???
IF (IGET(444).GT.0) THEN
DO J=JSTA,JEND
DO I=1,IM
IF (CPRATE(I,J) .GT. PTHRESH) THEN
GRID1(I,J)=EGRID5(I,J)
ELSE
GRID1(I,J)=0
ENDIF
ENDDO
ENDDO
CALL BOUND(GRID1,D00,H99999)
ID(1:25) = 0
ID(02) = 2
if(grib=='grib1') then
CALL GRIBIT(IGET(444),1,GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(444))
fld_info(cfld)%lvl=LVLSXML(1,IGET(444))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
ENDIF
!
!
! RELATIVE HUMIDITY WITH RESPECT TO PRECIPITABLE WATER
IF (IGET(749).GT.0) THEN
CALL CALRH_PW(RHPW)
DO J=JSTA,JEND
DO I=1,IM
GRID1(I,J)=RHPW(I,J)
ENDDO
ENDDO
ID(1:25) = 0
ID(2) = 129
if(grib=='grib1') then
CALL GRIBIT(IGET(749),LVLS(1,IGET(749)),GRID1,IM,JM)
elseif(grib=='grib2') then
cfld=cfld+1
fld_info(cfld)%ifld=IAVBLFLD(IGET(749))
datapd(1:im,1:jend-jsta+1,cfld)=GRID1(1:im,jsta:jend)
endif
ENDIF
! END OF ROUTINE.
!
RETURN
END