C  STACK PROGRAM/ PLUME RISE/ GROUND FIRE/ CGW
      SUBROUTINE PLRS (UR,TMP,PMM,IL,IM,IR,XI,HT,HML,IPC,IRTP)
      COMMON PDM(60),HS,DS,TSC,VS,RDE,P,HR,CR,PD2(42)
      DIMENSION DELF(6),DTDZ(6),PT(6,3),ITT(12) 
      DATA DXT /10./
      DATA G /9.8/  
      DATA ZR /2./  
      DATA CP /.24/ 
      DATA GI /.64/ 
      DATA GC /.5/  
      DATA DELF/1.2,1.1,1.,1.,.9,.8/
      DATA DTDZ/-.01,-.008,-.006,0.,.01,.037/   
      DATA PT/.05,.05,.1,.1,.15,.15,.05,.1,.15,.2,.25,.3,.1,.15,.2,.25, 
     1.3,.35/   
      DATA ITT/3,2,3,1,3,2,3,2,2,3,3,0/ 
      IF (XI.EQ.0.) GO TO 30
      IF (IPC.GT.1) GO TO 10
      IRTP=1
      RETURN
  10  X=XI  
      IF (XI.LT.XMX) GO TO 20   
      X=XMX 
      IRTP=IRTP+1   
  20  IF (IR-6) 280,290,320
  30  IRTP=-1   
      TA=TMP+273.   
      S=G*DTDZ(IM)/TA   
      IF (IL.NE.12) GO TO 60
C     16. ATMOSPHERIC PRESSURE  
  40  CALL READA (16,IRT,IA,PMM)
      IF (IRT.LT.0) GO TO 40
  60  PA=1013.*PMM/760. 
C     23. OUTPUT CONTROL CODE   
  50  CALL DEF (23,IRT) 
      IF (IRT.EQ.0) READ(*,*,ERR=70) IPC
      GO TO 80  
  70  CALL DEF (63,IRT) 
      GO TO 50  
  80  IF (IR.GT.6) GO TO 300
C     24. HEIGHT OF STACK   
  90  CALL READA (24,IRT,IA,HS) 
      IF (IRT.LT.0) GO TO 90
C     25. DIAMETER OF STACK 
 100  CALL READA (25,IRT,IA,DS) 
      IF (IRT.LT.0) GO TO 100   
C     26. TEMPERATURE OF STACK  
 110  CALL READA (26,IRT,IA,TSC)
      IF (IRT.LT.0) GO TO 110   
C     27. VELOCITY OF EFFLUENT  
 120  CALL READA (27,IRT,IA,VS) 
      IF (IRT.LT.0) GO TO 120   
C     28. RELATIVE DENSITY OF EFFLUENT  
 130  CALL DEF (28,IRT) 
      IF (IRT.EQ.0) READ(*,*) RDE   
 140  TS=TSC+273.   
      F=0.  
      IF (TS.LT.TA) WRITE(*,150)
 150  FORMAT(' DHH/DHB/DHBT NOTE: STK TMP LESS THAN AIR TMP')   
      IF (TS.LT.TA) GO TO 160   
      F=(TS-TA)/TS*G*VS*DS**2/4.
      IF (F.LE.55.) XA=14.*F**.625  
      IF (F.GT.55.) XA=34.*F**.4
      XMX=3.5*XA
 160  IT=ITT(IL)
      IF (IT.NE.0) P=PT(IM,IT)  
      IF (IT.NE.0) GO TO 170
C     29. FROST PROFILE EXPONENT
      CALL DEF (29,IRT) 
      IF (IRT.EQ.0) READ(*,*) P 
 170  UZ=UR*(HS/ZR)**P
      IF (S.GT.0.) XMX=2.4*UZ/S**.5 
      FM=RDE*VS*VS*DS*DS/4. 
      IF (UZ.LT.1..AND.S.GE.0.) GO TO 200   
      VR=VS/UZ  
      IF (VR.LT.4) WRITE(*,180) 
 180  FORMAT (' DHJ NOTE: VS/UZ LT 4')  
      IF (S.LT.0.) WRITE(*,190) 
 190  FORMAT (' DHJ NOTE: UNSTABLE MET CONDITIONS') 
      DHJ=3.*VR*DS  
      GO TO 210 
 200  DHJ=4.*(FM/S)**.25
 210  IF (S.LE.0.) GO TO 220
      DHJB=1.5*(FM/UZ)**.333/S**.167
      IF (DHJB.LT.DHJ) DHJ=DHJB 
 220  X=1.  
      IF (IR.EQ.5.AND.IPC.EQ.0) X=XMX   
      DELH=(VS*DS/UR)*(1.5+(2.68E-3*PA*((TS-TA)/TS)*DS))
      DHH=DELH*DELF(IM) 
      WRITE(*,230)  
 230  FORMAT (/8X,'X',8X,'DHH',7X,'DHB',6X,'DHBT',5X,'DHJ') 
      DEL=1.6*(F**.333)/UZ  
 240  IF (IR.EQ.5.AND.X.GT.XMX) X=XMX   
      DHB=DEL*X**.667
      IF (S.LE.0.) GO TO 250
      DHB=2.5*(F/(UZ*S))**.333  
      IF (UR.GE.1.) GO TO 250   
      DHMTT=5.*(F**.25)/(S**.375)   
      IF (DHMTT.LT.DHB) DHB=DHMTT   
 250  DHJX=1.44*DS*(VS/UZ)**.667*(X/DS)**.333   
      IF (DHJX.GT.DHJ) DHJX=DHJ 
      DHBT=F**.333*X**.667/UZ*(1.065-6.25*DTDZ(IM)) 
      IF (IPC.EQ.1.OR.IPC.EQ.3) WRITE(*,260) X,DHH,DHB,DHBT,DHJX
      IF (IR.EQ.5.AND.X.GE.XMX) GO TO 270   
      IF (IR.EQ.6.AND.DHJX.GE.DHJ) GO TO 270
 260  FORMAT (6F10.2)   
      IF (X.EQ.1.) X=0. 
      X=X+DXT   
      GO TO 240 
 270  WRITE(*,260) X,DHH,DHB,DHBT,DHJ,P 
      IF (IR.EQ.5) HT=HS+DHBT   
      IF (IR.EQ.6) XMX=X
      IF (IR.EQ.6) HT=HS+DHJ
      RETURN
 280  DHBT=F**.333*X**.667/UZ*(1.065-6.25*DTDZ(IM)) 
      HT=HS+DHBT
      GO TO 360
 290  DHJX=1.44*DS*(VS/UZ)**.667*(X/DS)**.333   
      IF (DHJX.GT.DHJ) DHJX=DHJ 
      HT=HS+DHJX
      GO TO 360 
C     30. HEAT RELEASED 
 300  CALL READA (30,IRT,IA,HR) 
      IF (IRT.LT.0) GO TO 300   
C     31. CLOUD RADIUS  
 305  CALL READA (31,IRT,IA,CR) 
      IF (IRT.LT.0) GO TO 305   
      HT=0. 
      IF (IM.LT.4) GO TO 330
      IF (IM.EQ.4) S=G*3.322E-4/TA  
      ROA=352320.*PMM/760./TA   
      RTS=S**.5 
      XMX=3.14159*UR/RTS
      X=XMX 
      WRITE(*,310) XMX  
 310  FORMAT (' XMX=',F7.0) 
 320  FT=1.-COS(RTS*X/UR)   
      FB=G*HR/(3.14159*ROA*CP*TA)   
      IF (IR.EQ.8) GO TO 350
      HT=(3.*FB*FT/(S*GI**3)+(CR/GI)**4)**.25-(CR/GI)
      GO TO 360
 330  WRITE(*,340)
 340  FORMAT (' HEIGHT DEFINED FOR STABLE CONDITIONS ONLY')
      RETURN
 350  HT=(3.*FB*FT/(UR*GC*GC*S)+(CR/GC)**3)**.333-(CR/GC)
 360  IF (HT.LT.HML) GO TO 370
      HT=HML
 370  WRITE(*,380) HT
 380  FORMAT(' HTS=',F7.2)
      RETURN
      END
