SUBROUTINE CALWXT(T,Q,P,PINT,LMH,LM,PPT,IWX) C C FILE: CALWXT.f C WRITTEN: 11 NOVEMBER 1993, MICHAEL BALDWIN C REVISIONS: 4 April 94 - 1-d version intended for obs soundings C 16 Sept 94 - compute all variables for possible C future decsion tree modifications C 14 Oct 94 - clean up 1-d version, use new C decision tree C 31 July 95 - sounding post-processor version c 06 Dec 97 - changed threshold value - GSM C C ROUTINE TO COMPUTE PRECIPITATION TYPE USING A DECISION TREE C APPROACH THAT USES VARIABLES SUCH AS INTEGRATED WET BULB TEMP C BELOW FREEZING AND LOWEST LAYER TEMPERATURE C C SEE BALDWIN AND CONTORNO PREPRINT FROM 13TH WEATHER ANALYSIS C AND FORECASTING CONFERENCE FOR MORE DETAILS C PARAMETER (H1M12=1.E-12) C C LIST OF VARIABLES NEEDED C PARAMETERS: C D608,ROG,H1,D00 PARAMETER(D608=0.608,ROG=287.04/9.8,H1=1.0,D00=0.0) CGSM PTHRES changed from 0.0 to 0.02 2/18/97 PARAMETER(PTHRES=0.02) C C INPUT: C T,Q,P,PINT,LMH C C T - Mid layer temp (K) C Q - Mid layer spec hum (g/g) C P - Mid layer pressure (Pa) (linear average of interfacial C pressures in log P) C PINT - Interfacial pressure (Pa) C LMH - Number of layers above ground C LM - Number of layers C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C NOTE: VERTICAL ORDER OF ARRAYS MUST BE LAYER 1 = TOP C ---- . C . C . C LAYER LMH = BOTTOM C (JUST LIKE IN THE ETA MODEL) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C INTERNAL: C TWET - Mid layer wet bulb temp (K) C TD - Mid layer dew point temp (K) C C C OUTPUT: C IWX - INSTANTANEOUS WEATHER TYPE. C ACTS LIKE A 4 BIT BINARY C 1111 = RAIN/FREEZING RAIN/ICE PELLETS/SNOW C WHERE THE ONE'S DIGIT IS FOR SNOW C THE TWO'S DIGIT IS FOR ICE PELLETS C THE FOUR'S DIGIT IS FOR FREEZING RAIN C AND THE EIGHT'S DIGIT IS FOR RAIN C C------------------------------------------------------------- C IN OTHER WORDS... C C IWX=1 SNOW C IWX=2 ICE PELLETS/MIX WITH ICE PELLETS C IWX=4 FREEZING RAIN/MIX WITH FREEZING RAIN C IWX=8 RAIN C------------------------------------------------------------- C C C SUBROUTINES CALLED: C WETBLB C C C INITIALIZE WEATHER TYPE ARRAY TO ZERO (IE, OFF). C WE DO THIS SINCE WE WANT IWX TO REPRESENT THE C INSTANTANEOUS WEATHER TYPE ON RETURN. C REAL T(LM),Q(LM),P(LM),PINT(LM+1),TWET(LM),TD(LM) REAL PPT,AREAS8,AREAN8,AREAPI,AREAP4,SURFW,SURFC INTEGER LMHK,LMH C IWX = 0 IF (PPT.LE.PTHRES) RETURN AREAS8=D00 AREAN8=D00 AREAPI=D00 AREAP4=D00 SURFW =D00 SURFC =D00 C C NUMBER OF LEVELS C LMHK=LMH C C COMPUTE DEW POINTS, C FIND COLDEST TEMP IN SATURATED LAYER BETWEEN C 70 MB ABOVE GROUND AND 500 MB, C AND FIND THE HIGHEST SAT LAYER, 'TIS THE ICE NUCL LEVEL. C C PSFCK=PINT(LMHK+1) TDCHK=2.0 1960 TCOLD=T(LMHK) TWARM=T(LMHK) LICE=LMHK DO 1915 L=1,LMHK QKL=Q(L) QKL=AMAX1(H1M12,QKL) TKL=T(L) PKL=P(L) IF (Q(L).LT.3E-12) THEN TD(L)=TKL-40.0 ELSE A=ALOG(QKL*PKL/(610.78*(0.378*QKL+0.622))) TDKL=(237.3*A)/(17.269-A)+273.15 TD(L)=TDKL IF (TD(L).GT.TKL) TD(L)=TKL ENDIF C C SKIP PAST THIS IF THE LAYER IS NOT BETWEEN 70 MB ABOVE GROUND C AND 500 MB C IF (PKL.LT.50000.0.OR.PKL.GT.PSFCK-7000.0) GOTO 1915 TDPRE=TKL-TDKL C C ALSO FIND THE HIGHEST SAT LAYER-USE FOR AREAPI,AREAP4 C IF (TDPRE.LT.TDCHK.AND.P(L).LT.P(LICE)) LICE=L IF (TDPRE.LT.TDCHK.AND.TKL.GT.TWARM) TWARM=TKL IF (TDPRE.LT.TDCHK.AND.TKL.LT.TCOLD) TCOLD=TKL 1915 CONTINUE C C IF WE DONT HAVE A LAYER WITH DEW POINT DEP OF TDCHK OR LESS C INCREASE TDCHK (UP TO 6 MAX) C IF (TCOLD.EQ.T(LMHK).AND.TDCHK.LT.6.0) THEN TDCHK=TDCHK+2.0 GOTO 1960 ENDIF C C GET WET BULB TEMPS C CALL WETBLB(T,TD,P,LMHK,TWET) C C LOWEST LAYER T C TLMHK=T(LMHK) C C TWET AREA VARIABLES C FROM GROUND TO 150 MB ABOVE SURFACE C FROM GROUND TO TCOLD LAYER C FROM GROUND TO 1ST LAYER WHERE T < 0.0 C FROM GROUND TO TWARM LAYER C C PINTK1 IS THE PRESSURE AT THE BOTTOM OF THE LAYER C PINTK2 IS THE PRESSURE AT THE TOP OF THE LAYER C C AREAPI IS THE AREA OF TWET ABOVE FREEZING BELOW TCOLD LYR C AREAP4 IS THE AREA OF TWET ABOVE -4 C BELOW TCOLD LYR C PINTK1=PSFCK DO 1945 L=LMHK,LICE,-1 PINTK2=PINT(L) DZKL=T(L)*(Q(L)*D608+H1)*ROG* 1 ALOG(PINTK1/PINTK2) AREA1=(TWET(L)-273.15)*DZKL AREA2=(TWET(L)-269.15)*DZKL IF (TWET(L).GE.273.15) AREAPI=AREAPI+AREA1 IF (TWET(L).GE.269.15) AREAP4=AREAP4+AREA2 PINTK1=PINTK2 1945 CONTINUE C C AREAS8 IS THE NET AREA OF TWET W.R.T. FREEZING IN LOWEST 150MB C AREAN8 IS THE NET AREA OF TWET < FREEZING IN LOWEST 150MB C PINTK1=PSFCK PM150=PSFCK-15000. DO 1955 L=LMHK,1,-1 PINTK2=PINT(L) IF (PINTK1.LT.PM150) GOTO 1950 DZKL=T(L)*(Q(L)*D608+H1)*ROG* 1 ALOG(PINTK1/PINTK2) C C SUM PARTIAL LAYER IF IN 150 MB AGL LAYER C IF (PINTK2.LT.PM150) & DZKL=T(L)*(Q(L)*D608+H1)*ROG* 1 ALOG(PINTK1/PM150) AREA1=(TWET(L)-273.15)*DZKL AREAS8=AREAS8+AREA1 IF(AREA1.LT.0.) AREAN8=AREAN8+AREA1 1950 PINTK1=PINTK2 1955 CONTINUE C C SURFW IS THE AREA OF TWET ABOVE FREEZING BETWEEN THE GROUND C AND THE FIRST LAYER ABOVE GROUND BELOW FREEZING C SURFC IS THE AREA OF TWET BELOW FREEZING BETWEEN THE GROUND C AND THE TWARM LAYER C PINTK1=PSFCK IFRZL=0 IWRML=0 DO 2050 L=LMHK,1,-1 IF (IFRZL.EQ.0.AND.T(L).LE.273.15) IFRZL=1 IF (IWRML.EQ.0.AND.T(L).GE.TWARM) IWRML=1 PINTK2=PINT(L) DZKL=T(L)*(Q(L)*D608+H1)*ROG* 1 ALOG(PINTK1/PINTK2) AREA1=(TWET(L)-273.15)*DZKL IF (IFRZL.EQ.0) THEN IF (TWET(L).GE.273.15) SURFW=SURFW+AREA1 ENDIF IF (IWRML.EQ.0) THEN IF (TWET(L).LE.273.15) SURFC=SURFC+AREA1 ENDIF PINTK1=PINTK2 2050 CONTINUE C C DECISION TREE TIME C IF (TCOLD.GT.269.15) THEN IF (TLMHK.LE.273.15) THEN C TURN ON THE FLAG FOR C FREEZING RAIN = 4 IWX=4 GOTO 1900 ELSE C TURN ON THE FLAG FOR C RAIN = 8 IWX=8 GOTO 1900 ENDIF ENDIF C IF (AREAP4.LT.3000.0) THEN C TURN ON THE FLAG FOR C SNOW = 1 IWX=1 GOTO 1900 ENDIF C IF (SURFC.LE.-3000.0.OR. & (AREAS8.LE.-3000.0.AND.SURFW.LT.50.0)) THEN C TURN ON THE FLAG FOR C ICE PELLETS = 2 IWX=2 GOTO 1900 ENDIF IF (TLMHK.LT.273.15) THEN C TURN ON THE FLAG FOR C FREEZING RAIN = 4 IWX=4 ELSE C TURN ON THE FLAG FOR C RAIN = 8 IWX=8 ENDIF 1900 CONTINUE RETURN END