SUBROUTINE MISCLN(IMOUT,JMOUT) C C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: MISCLN POSTS MISCELLANEOUS FIELDS C PRGRMMR: TREADON ORG: W/NP2 DATE: 92-12-20 C C ABSTRACT: C THIS ROUTINE HAS BECOME THE CATCH-ALL FOR MISCELLANEOUS C OUTPUT FIELDS POSTED BY THE ETA POST PROCESSOR. C CURRENTLY THIS ROUTINE POSTS THE FOLLOWING FIELDS: C (1) TROPOPAUSE LEVEL Z,P, T, U, V, AND VERTICAL WIND SHEAR, C (2) MAX WIND LEVEL Z, P, U, AND V, C (3) FD LEVEL T, U, AND V, C (4) FREEZING LEVEL Z AND RH, C (5) CONSTANT MASS (BOUNDARY) FIELDS, C (6) LFM LOOK-ALIKE FIELDS, AND C (7) NGM LOOK-ALIKE FIELDS. C C . C C PROGRAM HISTORY LOG: C 92-12-20 RUSS TREADON C 93-06-19 RUSS TREADON - ADDED TYPE 2 CAPE POSTING. C 94-11-07 MIKE BALDWIN - ADDED HELICITY POSTING. C 96-03-26 MIKE BALDWIN - CHANGE ETA BOUNDARY LAYER LABELS FOR GRIB C 96-11-19 MIKE BALDWIN - BACK OUT PREVIOUS CHANGE C 97-04-25 MIKE BALDWIN - CHANGE ETA BOUNDARY LAYER LABELS FOR GRIB C 97-04-29 GEOFF MANIKIN - ADDED TROPOPAUSE HEIGHT AND C MAX WIND LEVEL FIELDS C 98-06-15 T BLACK - CONVERSION FROM 1-D TO 2-D C 98-07-17 MIKE BALDWIN - REMOVED LABL84 C 00-01-04 JIM TUCCILLO - MPI VERSION C C USAGE: CALL MISCLN(IMOUT,JMOUT) C INPUT ARGUMENT LIST: C IMOUT - FIRST DIMENSION OF OUTPUT GRID. C JMOUT - SECOND DIMENSION OF OUTPUT GRID. C C OUTPUT ARGUMENT LIST: C NONE C C OUTPUT FILES: C STDOUT - RUN-TIME MESSAGES (FOR DEBUGGING, NOW TURNED OFF) C C SUBPROGRAMS CALLED: C UTILITIES: C TRPAUS - COMPUTE TROPOPAUSE LEVEL FIELDS. C CALMXW - COMPUTE MAX WIND LEVEL FIELDS. C E2OUT - INTERPOLATE STAGGERED E-GRID TO OUTPUT GRID. C SCLFLD - SCALE ARRAY ELEMENTS BY CONSTANT. C OUTPUT - DRIVER FOR TYPE OF FILE OUTPUT. C CALPOT2 - CALCULATE POTENTIAL TEMPERATURE. C FDLVL - COMPUTE FD LEVEL DATA (AGL OR MSL). C FRZLVL - COMPUTE FREEZING LEVEL DATA. C BOUND - BOUND ARRAY ELEMENTS BETWEEN MINIMUM AND MAXIMUM VALUES. C BNDLYR2 - COMPUTE BOUNDARY LAYER FIELDS. C CALDWP2 - CALCULATE DEWPOINT TEMPERATURE. C CALMCVG - CALCULATE MOISTURE CONVERGENCE. C OTLFT2 - COMPUTE LIFTED INDEX AT 500MB. C CALLCL - COMPUTE LCL DATA. C LFMFLD - COMPUTE LFM LOOK-ALIKE FIELDS. C NGMFLD2 - COMPUTE NGM LOOK-ALIKE FIELDS. C CALTHTE - COMPUTE THETA-E. C CALHEL - COMPUTE HELICITY AND STORM MOTION. C C LIBRARY: C COMMON - RQSTFLD C MASKS C IOUNIT C OPTIONS C C ATTRIBUTES: C LANGUAGE: FORTRAN C MACHINE : CRAY C-90 C$$$ C C C INCLUDE GRID DIMENSIONS. DERIVE DEPENDENT PARAMETERS. C INCLUDE "parmeta" INCLUDE "parmout" INCLUDE "params" C C SET LOCAL PARAMETERS. MAKE SURE NFD AND NBND AGREE C WITH THE VALUES SET IN SUBROUTINES FDLVL AND BNDLYR2, C RESPECTIVELY. PARAMETER (NFD=6,NBND=6,SMALL=1.E-12) PARAMETER (C2K=273.15) C C DECLARE VARIABLES. C LOGICAL NORTH LOGICAL RUN,FIRST,RESTRT,SIGMA,OLDRD,STDRD LOGICAL FIELD1,FIELD2 INTEGER LVLBND(IM,JM,NBND),LB2(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 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 T78483(IM,JM),T89671(IM,JM),P78483(IM,JM),P89671(IM,JM) 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 HTFD(NFD),T6D(IM,JM,NFD),U6D(IM,JM,NFD),V6D(IM,JM,NFD) REAL PETABND(NBND),SIGBND(NBND),HELI(IM,JM) REAL EGRID1(IM,JM),EGRID2(IM,JM) REAL GRID1(IMOUT,JMOUT),GRID2(IMOUT,JMOUT) CGSM REAL MAXWP(IM,JM),MAXWZ(IM,JM),MAXWU(IM,JM), MAXWV(IM,JM) C Lyra GSM Max wind REAL MAXWUold(IM,JM),MAXWVold(IM,JM) REAL MAXWP(IM,JM),MAXWZ(IM,JM) C Lyra GSM Max wind CHOU integrated qU & qV REAL QUINT(IM,JM), QVINT(IM,JM) REAL CLW(IM,JM), CLI(IM,JM) REAL HPBL(IM,JM) !consistent w/ etafcst, not using NBND layers C C INCLUDE COMMON BLOCKS. INCLUDE "RQSTFLD.comm" INCLUDE "MASKS.comm" INCLUDE "IOUNIT.comm" INCLUDE "OPTIONS.comm" INCLUDE "VRBLS.comm" INCLUDE "EXTRA.comm" INCLUDE "DYNAM.comm" INCLUDE "CTLBLK.comm" C C C EQUIVALENCES FOR SUBROUTINE MISCLN. EQUIVALENCE (TBND(1,1,1),T6D(1,1,1)) EQUIVALENCE (TBND(1,1,2),T6D(1,1,2)) EQUIVALENCE (TBND(1,1,3),T6D(1,1,3)) EQUIVALENCE (TBND(1,1,4),T6D(1,1,4)) EQUIVALENCE (TBND(1,1,5),T6D(1,1,5)) EQUIVALENCE (TBND(1,1,6),T6D(1,1,6)) EQUIVALENCE (UBND(1,1,1),U6D(1,1,1)) EQUIVALENCE (UBND(1,1,2),U6D(1,1,2)) EQUIVALENCE (UBND(1,1,3),U6D(1,1,3)) EQUIVALENCE (UBND(1,1,4),U6D(1,1,4)) EQUIVALENCE (UBND(1,1,5),U6D(1,1,5)) EQUIVALENCE (UBND(1,1,6),U6D(1,1,6)) EQUIVALENCE (VBND(1,1,1),V6D(1,1,1)) EQUIVALENCE (VBND(1,1,2),V6D(1,1,2)) EQUIVALENCE (VBND(1,1,3),V6D(1,1,3)) EQUIVALENCE (VBND(1,1,4),V6D(1,1,4)) EQUIVALENCE (VBND(1,1,5),V6D(1,1,5)) EQUIVALENCE (VBND(1,1,6),V6D(1,1,6)) C C SET FD LEVEL HEIGHTS IN GEOPOTENTAL METERS. DATA HTFD / 914.E0,1524.E0,1829.E0, X 2134.E0,2743.E0,3658.E0/ C C SET MIDPOINT "SIGMA" VALUES FOR ETA BOUNDARY LAYERS. DATA SIGBND / 0.985,0.955,0.925,0.895,0.865,0.835 / DATA PETABND / 15.,45.,75.,105.,135.,165. / C C**************************************************************************** C START MISCLN HERE. C C HELICITY AND STORM MOTION. IF (IGET(162).GT.0.OR.IGET(163).GT.0.OR.IGET(164).GT.0) THEN CALL CALHEL(UST,VST,HELI) IF (IGET(162).GT.0) THEN CALL E2OUT(162,000,HELI,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 ID(10) = 30 ID(11) = 0 CALL OUTPUT(IOUTYP,IGET(162),LVLS(1,IGET(162)), X GRID1,IMOUT,JMOUT) ENDIF IF ((IGET(163).GT.0).OR.(IGET(164).GT.0)) THEN CALL E2OUT(163,164,UST,VST,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 ID(10) = 30 ID(11) = 85 IF (IGET(163).GT.0) CALL OUTPUT(IOUTYP,IGET(163), X LVLS(1,IGET(163)),GRID1,IMOUT,JMOUT) ID(1:25) = 0 ID(10) = 30 ID(11) = 85 IF (IGET(164).GT.0) CALL OUTPUT(IOUTYP,IGET(164), X LVLS(1,IGET(164)),GRID2,IMOUT,JMOUT) ENDIF ENDIF C C C C ***BLOCK 1: TROPOPAUSE P, Z, T, U, V, AND WIND SHEAR. C IF ( (IGET(054).GT.0).OR.(IGET(055).GT.0).OR. X (IGET(056).GT.0).OR.(IGET(057).GT.0).OR. X (IGET(177).GT.0).OR. X (IGET(058).GT.0).OR.(IGET(108).GT.0) ) THEN CALL TRPAUS(P1D,T1D,Z1D,U1D,V1D,SHR1D) C C TROPOPAUSE PRESSURE. IF (IGET(054).GT.0) THEN CALL E2OUT(054,000,P1D,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(054),LVLS(1,IGET(054)), X GRID1,IMOUT,JMOUT) ENDIF C TROPOPAUSE HEIGHT. IF (IGET(177).GT.0) THEN CALL E2OUT(177,000,Z1D,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(177),LVLS(1,IGET(177)), X GRID1,IMOUT,JMOUT) ENDIF C C TROPOPAUSE TEMPERATURE. IF (IGET(055).GT.0) THEN CALL E2OUT(055,000,T1D,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(055),LVLS(1,IGET(055)), X GRID1,IMOUT,JMOUT) ENDIF C C TROPOPAUSE POTENTIAL TEMPERATURE. IF (IGET(108).GT.0) THEN CALL CALPOT2(P1D,T1D,EGRID1,IM,JM) CALL E2OUT(108,000,EGRID1,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(108),LVLS(1,IGET(108)), X GRID1,IMOUT,JMOUT) ENDIF C C TROPOPAUSE U WIND AND/OR V WIND. IF ((IGET(056).GT.0).OR.(IGET(057).GT.0)) THEN CALL E2OUT(056,057,U1D,V1D,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 IF (IGET(056).GT.0) CALL OUTPUT(IOUTYP,IGET(056), X LVLS(1,IGET(056)),GRID1,IMOUT,JMOUT) ID(1:25) = 0 IF (IGET(057).GT.0) CALL OUTPUT(IOUTYP,IGET(057), X LVLS(1,IGET(057)),GRID2,IMOUT,JMOUT) ENDIF C C TROPOPAUSE WIND SHEAR. IF (IGET(058).GT.0) THEN CALL E2OUT(058,000,SHR1D,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(058),LVLS(1,IGET(058)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C C C ***BLOCK 2: MAX WIND LEVEL P, Z, U, AND V C C MAX WIND LEVEL CALCULATIONS IF ((IGET(173).GT.0) .OR. (IGET(174).GT.0) .OR. X (IGET(175).GT.0) .OR. (IGET(176).GT.0)) THEN CLyra GSM Max wind CALL CALMXW(MAXWP,MAXWZ,MAXWUold,MAXWVold) CLyra GSM Max wind ENDIF C PRESSURE OF MAX WIND LEVEL IF (IGET(173).GT.0) THEN CALL E2OUT(173,000,MAXWP,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(173),LVLS(1,IGET(173)), X GRID1,IMOUT,JMOUT) ENDIF C HEIGHT OF MAX WIND LEVEL IF (IGET(174).GT.0) THEN CALL E2OUT(174,000,MAXWZ,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(174),LVLS(1,IGET(174)), X GRID1,IMOUT,JMOUT) ENDIF C MAX WIND LEVEL U WIND AND/OR V WIND. IF ((IGET(175).GT.0).OR.(IGET(176).GT.0)) THEN CALL E2OUT(175,176,MAXWU,MAXWV,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 IF (IGET(175).GT.0) CALL OUTPUT(IOUTYP,IGET(175), X LVLS(1,IGET(175)),GRID1,IMOUT,JMOUT) ID(1:25) = 0 IF (IGET(176).GT.0) CALL OUTPUT(IOUTYP,IGET(176), X LVLS(1,IGET(176)),GRID2,IMOUT,JMOUT) ENDIF C C C C ***BLOCK 3: FD LEVEL T, U, AND V. C IF ( (IGET(059).GT.0).OR.(IGET(060).GT.0).OR. X (IGET(061).GT.0) ) THEN C C DETERMINE WHETHER TO DO MSL OR AGL FD LEVELS C ITYPE=1 DO IFD = 1,NFD IF (IGET(059).GT.0) THEN IF (LVLS(IFD,IGET(059)).GT.1) ITYPE=2 ENDIF IF (IGET(060).GT.0) THEN IF (LVLS(IFD,IGET(060)).GT.1) ITYPE=2 ENDIF IF (IGET(061).GT.0) THEN IF (LVLS(IFD,IGET(061)).GT.1) ITYPE=2 ENDIF ENDDO CALL FDLVL(ITYPE,T6D,U6D,V6D) C DO 10 IFD = 1,NFD ID(1:25) = 0 ISVALUE = NINT(HTFD(IFD)) ID(11) = ISVALUE C C FD LEVEL TEMPERATURE. IF (IGET(059).GT.0) THEN IF (LVLS(IFD,IGET(059)).GT.0) THEN CALL E2OUT(059,000,T6D(1,1,IFD),EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(059), X LVLS(IFD,IGET(059)),GRID1,IMOUT,JMOUT) ENDIF ENDIF C C FD LEVEL U WIND AND/OR V WIND. IF ((IGET(060).GT.0).OR.(IGET(061).GT.0)) THEN CALL E2OUT(060,061,U6D(1,1,IFD),V6D(1,1,IFD), X GRID1,GRID2,IMOUT,JMOUT) IF (IGET(060).GT.0) THEN IF (LVLS(IFD,IGET(060)).GT.0) CALL OUTPUT(IOUTYP, X IGET(060),LVLS(IFD,IGET(060)),GRID1,IMOUT,JMOUT) ENDIF IF (IGET(061).GT.0) THEN IF (LVLS(IFD,IGET(061)).GT.0) CALL OUTPUT(IOUTYP, X IGET(061),LVLS(IFD,IGET(061)),GRID2,IMOUT,JMOUT) ENDIF ENDIF 10 CONTINUE ENDIF C C C C ***BLOCK 4: FREEZING LEVEL Z AND RH. C IF ( (IGET(062).GT.0).OR.(IGET(063).GT.0) ) THEN CALL FRZLVL(Z1D,RH1D) C C FREEZING LEVEL HEIGHT. IF (IGET(062).GT.0) THEN CALL E2OUT(062,000,Z1D,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL BOUND (GRID1,D00,H99999,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(062),LVLS(1,IGET(062)), X GRID1,IMOUT,JMOUT) ENDIF C C FREEZING LEVEL RELATIVE HUMIDITY. IF (IGET(063).GT.0) THEN CALL E2OUT(063,000,RH1D,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(063),LVLS(1,IGET(063)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF IF (IGET(165).GT.0) THEN CALL FRZLVL2(Z1D,RH1D) C C HIGHEST FREEZING LEVEL HEIGHT. CALL E2OUT(165,000,Z1D,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL BOUND (GRID1,D00,H99999,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(165),LVLS(1,IGET(165)), X GRID1,IMOUT,JMOUT) ENDIF C C C C ***BLOCK 5: BOUNDARY LAYER FIELDS. C IF ( (IGET(067).GT.0).OR.(IGET(068).GT.0).OR. X (IGET(069).GT.0).OR.(IGET(070).GT.0).OR. X (IGET(071).GT.0).OR.(IGET(072).GT.0).OR. X (IGET(073).GT.0).OR.(IGET(074).GT.0).OR. X (IGET(088).GT.0).OR.(IGET(089).GT.0).OR. X (IGET(090).GT.0).OR.(IGET(075).GT.0).OR. X (IGET(109).GT.0).OR.(IGET(110).GT.0).OR. X (IGET(031).GT.0).OR.(IGET(032).GT.0).OR. X (IGET(107).GT.0)) THEN Chou X (IGET(107).GT.0).OR.(IGET(091).GT.0).OR. Chou X (IGET(092).GT.0).OR.(IGET(093).GT.0).OR. Chou X (IGET(094).GT.0).OR.(IGET(095).GT.0).OR. Chou X (IGET(096).GT.0).OR.(IGET(097).GT.0).OR. Chou X (IGET(098).GT.0) ) THEN C C COMPUTE ETA BOUNDARY LAYER FIELDS. CALL BNDLYR2(PBND,TBND,QBND,RHBND,UBND,VBND, X OMGBND,PWTBND,LVLBND) C C 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.) C C BOUNDARY LAYER PRESSURE. IF (IGET(067).GT.0) THEN IF (LVLS(LBND,IGET(067)).GT.0) THEN CALL E2OUT(067,000,PBND(1,1,LBND),EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(067), X LVLS(LBND,IGET(067)),GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER TEMPERATURE. IF (IGET(068).GT.0) THEN IF (LVLS(LBND,IGET(068)).GT.0) THEN CALL E2OUT(068,000,TBND(1,1,LBND),EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(068),LVLS(LBND,IGET(068)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER POTENTIAL TEMPERATURE. IF (IGET(069).GT.0) THEN IF (LVLS(LBND,IGET(069)).GT.0) THEN CALL CALPOT2(PBND(1,1,LBND),TBND(1,1,LBND),EGRID1,IM,JM) CALL E2OUT(069,000,EGRID1,EGRID2,GRID1,GRID2, X IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(069),LVLS(LBND,IGET(069)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER RELATIVE HUMIDITY. IF (IGET(072).GT.0) THEN IF (LVLS(LBND,IGET(072)).GT.0) THEN CALL E2OUT(072,000,RHBND(1,1,LBND),EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(072),LVLS(LBND,IGET(072)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER DEWPOINT TEMPERATURE. IF (IGET(070).GT.0) THEN IF (LVLS(LBND,IGET(070)).GT.0) THEN CALL CALDWP2(PBND(1,1,LBND),QBND(1,1,LBND),EGRID1, X TBND(1,1,LBND)) CALL E2OUT(070,000,EGRID1,EGRID2,GRID1,GRID2, X IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(070),LVLS(LBND,IGET(070)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER SPECIFIC HUMIDITY. IF (IGET(071).GT.0) THEN IF (LVLS(LBND,IGET(071)).GT.0) THEN CALL E2OUT(071,000,QBND(1,1,LBND),EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL BOUND(GRID1,H1M12,H99999,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(071),LVLS(LBND,IGET(071)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER MOISTURE CONVERGENCE. IF (IGET(088).GT.0) THEN IF (LVLS(LBND,IGET(088)).GT.0) THEN CALL CALMCVG(QBND(1,1,LBND),UBND(1,1,LBND), X VBND(1,1,LBND),-1,EGRID1) C CONVERT TO DIVERGENCE FOR GRIB DO J=JSTA,JEND DO I=1,IM EGRID1(I,J)=-1.0*EGRID1(I,J) ENDDO ENDDO CALL E2OUT(088,000,EGRID1,EGRID2,GRID1,GRID2, X IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(088),LVLS(LBND,IGET(088)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER U WIND AND/OR V WIND. C FIELD1=.FALSE. FIELD2=.FALSE. C 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 C IF(FIELD1.OR.FIELD2)THEN CALL E2OUT(073,074,UBND(1,1,LBND),VBND(1,1,LBND), X GRID1,GRID2,IMOUT,JMOUT) C C TWO ROUTINES WERE WRITTEN DURING POST PROCESSOR C DEVELOPMENT TO MIMIC LFM BOUNDARY LAYER WINDS. C BOTH APPLY AN EKMAN SPIRAL ROTATION TO AN ARTIFICIALLY C REDUCED GEOSTROPHIC WIND FIELD. SUBROUTINE CALEKM C BASES THE GEOSTROPHIC WIND ON 1000MB HEIGHTS WHILE C CALEKM2 USES THE SEA LEVEL PRESSURE FIELD. IF C LBND EQUALS ONE AND LVLS IS 8 POST THE CALEKM WINDS C AS BOUNDARY LAYER ONE WINDS. IF LBND EQUALS ONE AND C LVLS IS 9 POST CALEKM2 WINDS AS BOUNDARY LAYER ONE C WINDS. OTHERWISE, POST THE "TRUE" BOUNDARY LAYER C ONE WINDS. C - 19 OCTOBER 1993, RUSS TREADON C IF (IGET(073).GT.0) THEN IF ((LBND.EQ.1).AND.(LVLS(LBND,IGET(073)).EQ.8)) THEN WRITE(STDOUT,*)'MISCLN: BNDLYR ',LBND, X ' UV USING EKMAN-GEO Z1000 UV' CALL CALEKM(U1D,V1D) CALL E2OUT(073,074,U1D,V1D,GRID1,GRID2,IMOUT,JMOUT) ENDIF ENDIF C IF (IGET(073).GT.0) THEN IF ((LBND.EQ.1).AND.(LVLS(LBND,IGET(073)).EQ.9)) THEN WRITE(STDOUT,*)'MISCLN: BNDLYR ',LBND, X ' UV USING EKMAN-GEO PMSL UV' CALL CALEKM2(U1D,V1D) CALL E2OUT(073,074,U1D,V1D,GRID1,GRID2,IMOUT,JMOUT) ENDIF ENDIF C IF (IGET(073).GT.0) THEN IF (LVLS(LBND,IGET(073)).GT.0) X CALL OUTPUT(IOUTYP,IGET(073), X LVLS(LBND,IGET(073)),GRID1,IMOUT,JMOUT) ENDIF IF (IGET(074).GT.0) THEN IF (LVLS(LBND,IGET(074)).GT.0) X CALL OUTPUT(IOUTYP,IGET(074), X LVLS(LBND,IGET(074)),GRID2,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER OMEGA. IF (IGET(090).GT.0) THEN IF (LVLS(LBND,IGET(090)).GT.0) THEN CALL E2OUT(090,000,OMGBND(1,1,LBND),EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(090),LVLS(LBND,IGET(090)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER PRECIPITBLE WATER. IF (IGET(089).GT.0) THEN IF (LVLS(LBND,IGET(089)).GT.0) THEN CALL E2OUT(089,000,PWTBND(1,1,LBND),EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL BOUND(GRID1,D00,H99999,IMOUT,JMOUT) CALL OUTPUT(IOUTYP,IGET(089),LVLS(LBND,IGET(089)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER LIFTED INDEX. IF (IGET(075).GT.0) THEN IF (LVLS(LBND,IGET(075)).GT.0) THEN CALL OTLFT2(PBND(1,1,LBND),TBND(1,1,LBND), X QBND(1,1,LBND),EGRID1) CALL E2OUT(075,000,EGRID1,EGRID2, X GRID1,GRID2,IMOUT,JMOUT) C C 23 SEPTEMBER 1993, RUSS TREADON. C ON LFM FORECAST GRID 026 WE POST THE FIRST ETA C BOUNDARY LAYER LI AS THE SURFACE TO 500MB LI. C THE CALL TO E2OUT INTERPOLATES THE LI FROM C THE E-GRID TO THE OUTPUT GRID. IF WE ARE POSTING C DATA THE THE LFM GRID WE NEED TO SAVE THIS C INTERPOLATED FIELD FOR USE BELOW. WHY? WHEN C PACKING THE DATA IN GRIB1 THE VALUES IN GRID1 C ARE MULTIPLIED BY 10. IF WE SEND GRID1 TO THE C GRIB PACKER A SECOND TIME THE LI'S ARE 10 TIMES C TOO BIG. C CALL E2OUT(075,000,EGRID1,EGRID2,GRID1,GRID2,IMOUT,JMOUT) IF (KGTYPE.EQ.026) THEN if ( me .eq. 0 ) then DO J=1,JMOUT DO I=1,IMOUT GRID2(I,J) = GRID1(I,J) ENDDO ENDDO end if ENDIF CALL OUTPUT(IOUTYP,IGET(075),LVLS(LBND,IGET(075)), X GRID1,IMOUT,JMOUT) C C 25 JUNE 1993, RUSS TREADON. C ON THE LFM FORECAST GRID (026) WE POST THE FIRST C BOUNDARY LAYER LIFTED INDEX AS THE SURFACE LI. C IF (KGTYPE.EQ.026) THEN if ( me .eq. 0 ) then DO J=1,JMOUT DO I=1,IMOUT GRID2(I,J) = GRID2(I,J) + C2K ENDDO ENDDO end if C ID(1:25) = 0 ID(9) = 101 ID(10) = 50 ID(11) = 0 CALL OUTPUT(IOUTYP,IGET(030),LVLS(1,IGET(030)), X GRID2,IMOUT,JMOUT) ENDIF ENDIF ENDIF C C END OF ETA BOUNDARY LAYER LOOP. 20 CONTINUE C C BEST LIFTED INDEX FROM BOUNDARY LAYER FIELDS. C IF (IGET(031).GT.0) THEN DO J=JSTA,JEND DO I=1,IM EGRID1(I,J) = H99999 EGRID2(I,J) = H99999 ENDDO ENDDO C DO 50 LBND = 1,NBND CALL OTLFT2(PBND(1,1,LBND),TBND(1,1,LBND), X 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 CALL E2OUT(031,000,EGRID1,EGRID2, X GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 ID(10) = PETABND(NBND)+15. ID(11) = PETABND(1)-15. CALL OUTPUT(IOUTYP,IGET(031),LVLS(1,IGET(031)), X GRID1,IMOUT,JMOUT) ENDIF C C BEST BOUNDARY LAYER CAPE AND CINS. C FIELD1=.FALSE. FIELD2=.FALSE. C 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 C IF(FIELD1.OR.FIELD2)THEN ITYPE = 2 C DO J=JSTA,JEND DO I=1,IM EGRID1(I,J) = -H99999 EGRID2(I,J) = -H99999 ENDDO ENDDO C DO 80 LBND = 1,NBND CALL CALTHTE(PBND(1,1,LBND),TBND(1,1,LBND), X 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 C CALL CALCAPE(ITYPE,P1D,T1D,Q1D,LB2,EGRID1,EGRID2) C IF (IGET(032).GT.0) THEN CALL E2OUT(032,000,EGRID1,EGRID2, X GRID1,GRID2,IMOUT,JMOUT) CALL BOUND(GRID1,D00,H99999,IMOUT,JMOUT) ID(1:25) = 0 ID(09) = 116 ID(10) = PETABND(NBND)+15. ID(11) = PETABND(1)-15. CALL OUTPUT(IOUTYP,IGET(032),LVLS(1,IGET(032)), X GRID1,IMOUT,JMOUT) ENDIF C IF (IGET(107).GT.0) THEN CALL E2OUT(107,000,EGRID2,EGRID1, X GRID1,GRID2,IMOUT,JMOUT) if ( me .eq. 0 ) then DO J=1,JMOUT DO I=1,IMOUT GRID1(I,J) = -1.*GRID1(I,J) ENDDO ENDDO end if C CALL BOUND(GRID1,D00,H99999,IMOUT,JMOUT) C if ( me .eq. 0 ) then DO J=1,JMOUT DO I=1,IMOUT GRID1(I,J) = -1.*GRID1(I,J) ENDDO ENDDO end if C ID(1:25) = 0 ID(09) = 116 ID(10) = PETABND(NBND)+15. ID(11) = PETABND(1)-15. CALL OUTPUT(IOUTYP,IGET(107),LVLS(1,IGET(107)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C C BOUNDARY LAYER LIFTING CONDENSATION PRESSURE AND HEIGHT. C EGRID1 IS LCL PRESSURE. EGRID2 IS LCL HEIGHT. C IF ( (IGET(109).GT.0).OR.(IGET(110).GT.0) ) THEN CALL CALLCL(PBND(1,1,1),TBND(1,1,1), X QBND(1,1,1),EGRID1,EGRID2) IF (IGET(109).GT.0) THEN CALL E2OUT(109,000,EGRID2,EGRID1, X GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(109),ILVL, X GRID1,IMOUT,JMOUT) ENDIF IF (IGET(110).GT.0) THEN CALL E2OUT(110,000,EGRID1,EGRID2, X GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(110),ILVL, X GRID1,IMOUT,JMOUT) ENDIF ENDIF C CGSM NGM BOUNDARY LAYER FIELDS. C C IF ( (IGET(091).GT.0).OR.(IGET(092).GT.0).OR. C X (IGET(093).GT.0).OR.(IGET(094).GT.0).OR. C X (IGET(095).GT.0).OR.(IGET(095).GT.0).OR. C X (IGET(096).GT.0).OR.(IGET(097).GT.0).OR. C X (IGET(098).GT.0) ) THEN C C COMPUTE SIGMA 0.89671 AND 0.78483 TEMPERATURES C INTERPOLATE LINEAR IN LOG P C IF (IGET(097).GT.0.OR.IGET(098).GT.0) THEN C DO J=JSTA,JEND C DO I=1,IM C P78483(I,J)=ALOG((PD(I,J)+PT)*0.78483) C P89671(I,J)=ALOG((PD(I,J)+PT)*0.89671) C ENDDO C ENDDO !!$omp parallel do !!$omp& private(fac1,fac2,pkl1,pku1,t78483,t89671) C DO L=2,LM C DO J=JSTA,JEND C DO I=1,IM C PKL1=0.5*(ALPINT(I,J,L)+ALPINT(I,J,L+1)) C PKU1=0.5*(ALPINT(I,J,L)+ALPINT(I,J,L-1)) C IF(P78483(I,J).LE.PKL1.AND.P78483(I,J).GT.PKU1)THEN C FAC1=(PKL1-P78483(I,J))/(PKL1-PKU1) C FAC2=(P78483(I,J)-PKU1)/(PKL1-PKU1) C T78483(I,J)=T(I,J,L)*FAC2+T(I,J,L-1)*FAC1 C ENDIF C IF(P89671(I,J).LE.PKL1.AND.P89671(I,J).GT.PKU1)THEN C FAC1=(PKL1-P89671(I,J))/(PKL1-PKU1) C FAC2=(P89671(I,J)-PKU1)/(PKL1-PKU1) C T89671(I,J)=T(I,J,L)*FAC2+T(I,J,L-1)*FAC1 C ENDIF C ENDDO C ENDDO C ENDDO C C SIGMA 0.89671 TEMPERATURE C IF (IGET(097).GT.0) THEN C ID(1:25) = 0 C ISVALUE = 8967 C ID(11) = ISVALUE C CALL E2OUT(097,000,T89671,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(097),LVLS(1,IGET(097)), C X GRID1,IMOUT,JMOUT) C ENDIF C SIGMA 0.78483 TEMPERATURE C IF (IGET(098).GT.0) THEN C ID(1:25) = 0 C ISVALUE = 7848 C ID(11) = ISVALUE C CALL E2OUT(098,000,T78483,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(098),LVLS(1,IGET(098)), C X GRID1,IMOUT,JMOUT) C ENDIF C ENDIF C C NGM SIGMA LAYER 0.98230 FIELDS. THESE FIELDS ARE C THE FIRST ETA LAYER BOUNDARY LAYER FIELDS. AN C EXCEPTION IS MADE FOR RELATIVE HUMIDITY ON THE LFM C FORECAST GRID (026). ON THIS OUTPUT GRID THE SIGMA C 0.98230 RELATIVE HUMIDITY IS THE MEAN RELATIVE HUMIDITY C COMPUTED BY AVERAGING ETA BOUNDARY LAYER 1, 2, AND 3 C RELATIVE HUMIDITIES. THIS AD HOC APPROACH WAS TAKEN C TO PRODUCE A MORE "LFM-LIKE" BOUNDARY LAYER RELATIVE C HUMIDITY FIELD FOR THE AVIATION BRANCH OF MOD. C C THIS IS NOT A SATISFACTORY SOLUTION. THE SIGMA C 0.98230 RELATIVE HUMIDITY SHOULD BE CONSISTENT C WITH THE OTHER SIGMA 0.98230 FIELDS. C C C IF ( (IGET(091).GT.0).OR.(IGET(092).GT.0).OR. C X (IGET(093).GT.0).OR.(IGET(094).GT.0).OR. C X (IGET(095).GT.0).OR.(IGET(095).GT.0).OR. C X (IGET(096).GT.0) ) THEN C C ID(1:25) = 0 C ISVALUE = 9823 C ID(11) = ISVALUE C C PRESSURE. C IF (IGET(091).GT.0) THEN C CALL E2OUT(091,000,PBND(1,1,1),EGRID2, C X GRID1,GRID2,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(091),LVLS(1,IGET(091)), C X GRID1,IMOUT,JMOUT) C ENDIF C C TEMPERATURE. C IF (IGET(092).GT.0) THEN C CALL E2OUT(092,000,TBND(1,1,1),EGRID2, C X GRID1,GRID2,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(092),LVLS(1,IGET(092)), C X GRID1,IMOUT,JMOUT) C ENDIF C C SPECIFIC HUMIDITY. C IF (IGET(093).GT.0) THEN C CALL E2OUT(093,000,QBND(1,1,1),EGRID2, C X GRID1,GRID2,IMOUT,JMOUT) C CALL BOUND(GRID1,H1M12,H99999,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(093),LVLS(1,IGET(093)), C X GRID1,IMOUT,JMOUT) C ENDIF C RELATIVE HUMIDITY. C IF (IGET(094).GT.0) THEN C IF (KGTYPE.EQ.026) THEN C DO J=JSTA,JEND C DO I=1,IM C RH1D(I,J)=(RHBND(I,J,1)+RHBND(I,J,2)+ C & RHBND(I,J,3))*0.33333333 c ENDDO C ENDDO C ELSE C DO J=JSTA,JEND C DO I=1,IM C RH1D(I,J)=RHBND(I,J,1) C ENDDO C ENDDO C ENDIF C CALL E2OUT(094,000,RH1D,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(094),LVLS(1,IGET(094)), C X GRID1,IMOUT,JMOUT) C ENDIF C C CHOU 13/06/2009: NEW EXTRA FIELDS, using NGM slot C IF (IGET(091).GT.0) THEN CALL E2OUT(091,000,TLMAX,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(091),LVLS(1,IGET(091)), X GRID1,IMOUT,JMOUT) ENDIF IF (IGET(092).GT.0) THEN CALL E2OUT(092,000,TLMIN,EGRID2,GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(092),LVLS(1,IGET(092)), X GRID1,IMOUT,JMOUT) ENDIF CHOU INCLUDE vertically integrated moisture transport U & V components C integral((q+cwm) x U) dp/g and integral((q+cwm) x V) dp/G) C IF ((IGET(093).GT.0).OR.(IGET(094).GT.0)) THEN CALL CALQUV(QUINT,QVINT) C C qu component IF (IGET(093).GT.0) THEN CALL E2OUT(093,000,QUINT,EGRID2, GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(093),LVLS(1,IGET(093)), X GRID1,IMOUT,JMOUT) ENDIF C C qv component IF (IGET(094).GT.0) THEN CALL E2OUT(094,000,QVINT,EGRID2, GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(094),LVLS(1,IGET(094)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF C Chou Vert Integrated Cloud Water IF ((IGET(097).GT.0).OR.(IGET(098).GT.0)) THEN CALL CALCWI(CLW,CLI) IF (IGET(097).GT.0) THEN CALL E2OUT(097,000,CLW,EGRID2, GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(097),LVLS(1,IGET(097)), X GRID1,IMOUT,JMOUT) ENDIF C Chou Vert Integrated Cloud ICE IF (IGET(098).GT.0) THEN CALL E2OUT(098,000,CLI,EGRID2, GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(098),LVLS(1,IGET(098)), X GRID1,IMOUT,JMOUT) ENDIF ENDIF Chou 20221226 HPBL IF (IGET(066).GT.0) THEN CALL CALHPBL(HPBL) CALL E2OUT(066,000,HPBL,EGRID2, GRID1,GRID2,IMOUT,JMOUT) ID(1:25) = 0 CALL OUTPUT(IOUTYP,IGET(066),LVLS(1,IGET(066)), X GRID1,IMOUT,JMOUT) ENDIF Chou Chou IF ((IGET(093).GT.0).OR.(IGET(094).GT.0)) THEN Chou CALL CALQUV(QUINT,QVINT) Chou CALL E2OUT(093,094,QUINT,QVINT, Chou X GRID1,GRID2,IMOUT,JMOUT) Chou ID(1:25) = 0 Chou IF (IGET(093).GT.0) CALL OUTPUT(IOUTYP,IGET(093), Chou X LVLS(1,IGET(093)),GRID1,IMOUT,JMOUT) Chou ID(1:25) = 0 Chou IF (IGET(094).GT.0) CALL OUTPUT(IOUTYP,IGET(094), Chou X LVLS(1,IGET(094)),GRID2,IMOUT,JMOUT) Chou ENDIF C U AND/OR V WIND. IF ((IGET(095).GT.0).OR.(IGET(096).GT.0)) THEN CALL E2OUT(095,096,UBND(1,1,1),VBND(1,1,1), X GRID1,GRID2,IMOUT,JMOUT) IF (IGET(095).GT.0) CALL OUTPUT(IOUTYP,IGET(095), X LVLS(1,IGET(095)),GRID1,IMOUT,JMOUT) IF (IGET(096).GT.0) CALL OUTPUT(IOUTYP,IGET(096), X LVLS(1,IGET(096)),GRID2,IMOUT,JMOUT) ENDIF ENDIF CGSM ENDIF C C ENDIF FOR BOUNDARY LAYER BLOCK. C CGSM ENDIF C C C C ***BLOCK 6: MISCELLANEOUS LAYER MEAN LFM AND NGM FIELDS. C CHOU 2022/10/30 COMMENTED OUT LFM and NGM outputs, IGET(IQ) can be used for new Cvariables C C IF ( (IGET(066).GT.0).OR.(IGET(081).GT.0).OR. C X (IGET(082).GT.0).OR.(IGET(104).GT.0).OR. C X (IGET(099).GT.0).OR.(IGET(100).GT.0).OR. C X (IGET(101).GT.0).OR.(IGET(102).GT.0).OR. C X (IGET(103).GT.0) ) THEN CC CC LFM "MEAN" RELATIVE HUMIDITIES AND PRECIPITABLE WATER. CC C IF ( (IGET(066).GT.0).OR.(IGET(081).GT.0).OR. C X (IGET(082).GT.0).OR.(IGET(104).GT.0) ) THEN c CALL LFMFLD(RH3310,RH6610,RH3366,PW3310) C ID(1:25) = 0 CC CC SIGMA 0.33-1.00 MEAN RELATIVE HUMIIDITY. C IF (IGET(066).GT.0) THEN C CALL E2OUT(066,000,RH3310,EGRID2,GRID1,GRID2,IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 33 C ID(11) = 100 C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(066),LVLS(1,IGET(066)), C X GRID1,IMOUT,JMOUT) C ENDIF CC CC SIGMA 0.66-1.00 MEAN RELATIVE HUMIIDITY. C IF (IGET(081).GT.0) THEN C CALL E2OUT(081,000,RH6610,EGRID2,GRID1,GRID2,IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 67 C ID(11) = 100 C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(081),LVLS(1,IGET(081)), C X GRID1,IMOUT,JMOUT) C ENDIF CC CC SIGMA 0.33-0.66 MEAN RELATIVE HUMIIDITY. C IF (IGET(082).GT.0) THEN C CALL E2OUT(082,000,RH3366,EGRID2,GRID1,GRID2,IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 33 C ID(11) = 67 C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(082),LVLS(1,IGET(082)), C X GRID1,IMOUT,JMOUT) C ENDIF CC CC SIGMA 0.33-1.00 PRECIPITABLE WATER. C IF (IGET(104).GT.0) THEN C CALL E2OUT(104,000,PW3310,EGRID2,GRID1,GRID2,IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 33 C ID(11) = 100 C CALL BOUND(GRID1,D00,H99999,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(104),LVLS(1,IGET(104)), C X GRID1,IMOUT,JMOUT) C ENDIF C ENDIF CC CC VARIOUS LAYER MEAN NGM SIGMA FIELDS. CC C IF ( (IGET(099).GT.0).OR.(IGET(100).GT.0).OR. C X (IGET(101).GT.0).OR.(IGET(102).GT.0).OR. C X (IGET(103).GT.0) ) THEN C CALL NGMFLD2(RH4710,RH4796,RH1847,RH8498,QM8510) CC CC SIGMA 0.47191-1.00000 RELATIVE HUMIDITY. C IF (IGET(099).GT.0) THEN C CALL E2OUT(099,000,RH4710,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 47 C ID(11) = 100 C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(099),LVLS(1,IGET(099)), C X GRID1,IMOUT,JMOUT) C ENDIF CC CC SIGMA 0.47191-0.96470 RELATIVE HUMIDITY. C IF (IGET(100).GT.0) THEN C CALL E2OUT(100,000,RH4796,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 47 C ID(11) = 96 C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(100),LVLS(1,IGET(100)), C X GRID1,IMOUT,JMOUT) C ENDIF CC CC SIGMA 0.18019-0.47191 RELATIVE HUMIDITY. C IF (IGET(101).GT.0) THEN C CALL E2OUT(101,000,RH1847,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 18 C ID(11) = 47 C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(101),LVLS(1,IGET(101)), C X GRID1,IMOUT,JMOUT) C ENDIF CC CC SIGMA 0.84368-0.98230 RELATIVE HUMIDITY. C IF (IGET(102).GT.0) THEN C CALL E2OUT(102,000,RH8498,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) C ID(1:25) = 0 C ID(10) = 84 C ID(11) = 98 C CALL SCLFLD(GRID1,H100,IMOUT,JMOUT) C CALL BOUND(GRID1,H1,H100,IMOUT,JMOUT) C CALL OUTPUT(IOUTYP,IGET(102),LVLS(1,IGET(102)), C X GRID1,IMOUT,JMOUT) C ENDIF CC CC SIGMA 0.85000-1.00000 MOISTURE CONVERGENCE. C IF (IGET(103).GT.0) THEN C CALL E2OUT(103,000,QM8510,EGRID2,GRID1,GRID2, C X IMOUT,JMOUT) CC CONVERT TO DIVERGENCE FOR GRIB C if ( me .eq. 0 ) then C DO J = 1,JMOUT C DO I = 1,IMOUT C GRID1(I,J) = -1.0 * GRID1(I,J) C ENDDO C ENDDO C end if C ID(1:25) = 0 C ID(10) = 85 C ID(11) = 100 C CALL OUTPUT(IOUTYP,IGET(103),LVLS(1,IGET(103)), C X GRID1,IMOUT,JMOUT) C ENDIF C ENDIF C ENDIF C CHOU 2022/10/30 end of commented out block 6 C C END OF ROUTINE. C RETURN END