C  PEAK CONCENTRATION/ INS/ CON/ FUM/ SAO PER CGW-JHG
      SUBROUTINE CDS
      CHARACTER*1 IST
      COMMON NQI,QT(6),TWL(6),CI(10),CL(10)
      COMMON PR(1),DXT,H,HML,SXS,SYS,SZS,TIVCH,UT,BR,SF,TMP,ALF,SYR,BTA,
     1SZR,Z,RC,V,QS,TEVP,SA,FL,FMW,CDM(8),FP,CDM1(8),Z0,CDM2(11)
      COMMON IPR(1),ND,IPO,I2MC,IMA,IPC,IMM,IDD,
     1IHR,NOV,INP,MRL,ID1,ID2,IDEP,IMTCH,IM,IR,IL,IRL,ISM,IVD,K33,K42
      DIMENSION ALFA(6),BETA(6),SY100(6,2),SZ100(6)
      DIMENSION SY100C(2,3),SZ20C(2,3),BETAC(2,3)
      DIMENSION IST(11),Y(10),AR(10)
      DATA ALFA/1.0,1.0,1.0,.9,.8,.7/
      DATA BETA/1.4,1.,.9,.85,.8,.75/
      DATA SY100/9.,6.33,4.8,4.,3.,2.,27.,19.,12.5,8.,6.,4./
      DATA SZ100/14.,11.,7.5,4.5,3.5,2.5/
      DATA SY100C/41.19,31.18,66.56,30.98,26.17,29.33/
      DATA SZ20C/3.,1.652,.797,1.934,.705,1.242/
      DATA BETAC/1.344,.755,1.218,.949,1.182,1./
      DATA IST/'A','B','C','D','E','F','N','I','U','S','W'/
      DATA HK/0./
      IF (IDEP.EQ.0) GO TO 42
      WRITE(*,1)
 1    FORMAT ('CONCENTRATION NOT DEFINED FOR INSTANTEOUS'
     $' RELEASE OF VX OR HD')
      RETURN
 42   IF (IMTCH) 2,2,43
 2    DO 3 I=1,ND
      AR(I)=0.
      CL(I)=LOG(CI(I))
 3    CONTINUE
      X=0.
      DX=DXT
      SDEPL=1.
      Q=QT(1)
      IS=1
      IF (TWL(1).GT..083) IS=2
 43   IMTCH=0
      IF (IM.GT.8) GO TO 5
      IF (IM.GT.6) GO TO 4
      ALF=ALFA(IM)
      SYR=SY100(IM,IS)
      BTA=BETA(IM)
      SZR=SZ100(IM)
      GO TO 5
 4    I=UT/2.235+1
      IF (I.GT.3) I=3
      MC=IM-6
      BTA=BETAC(MC,I)
      ALF=.5
      SYR=SY100C(MC,I)
      SZR=SZ20C(MC,I)*5**BTA
 5    XC=1.E36
      IF (TWL(1).EQ.1.E36) GO TO 6
      Q=QT(1)/TWL(1)
      XC=0.
      IF (IS.EQ.1) GO TO 6
      XC=EXP(ALOG(TWL(1)*UT*157.27)/.9294)
 6    QOU=Q/UT
      HKOU=HK/UT/60.
      XCH=1.E36
      IF (TIVCH.NE.1.E36) XCH=UT*TIVCH*60.+X
      IF (IMTCH.EQ.1) GO TO 44
      MXLF=0
      TWHML=HML+HML
      IC=ND
      IND=0
      IRTP=5-IR
      CPMX=0.
      CPLSAV=-87.5
      XSAVE=0.
 44   A=0.
      B=0.
      C=0.
      IF (SXS.NE.0.) A=(SXS/.1522)**1.076-X
      IF (SYS.NE.0.) B=100*(SYS/SYR)**(1./ALF)-X
      IF (SZS.NE.0.) C=100.*(SZS/SZR)**(1./BTA)-X
      WRITE(*,7)
 7    FORMAT(/5X,'Q(MG)',4X,'TS(MIN)',3X,'HTS(M)',4X,'HML(M)',
     +6X,'WND')
      WRITE (*,8) QT(1),TWL(1),H,HML,UT,IST(IM)
 8    FORMAT (3X,1PE9.3,4(1X,E9.3),4X,A2)
      WRITE (*,9)
 9    FORMAT(/4X,'ALF',2X,'SYR',4X,'BTA',3X,'SZR',8X,'SYS(M)',
     +2X,'SZS(M)',2X,'XY(M)',3X,'XZ(M)',3X,'XC(M)')
      WRITE (*,10) ALF,SYR,BTA,SZR,SYS,SZS,B,C,XC
 10   FORMAT (1X,4F6.2,6X,1P5E8.1/)
      IF (IVD.EQ.1) CALL VDPL(Q,SY,SZ,CI(1),X,DX,DXA,XS,XCH,CP,CP,
     1SDEPL,1)
      IF (IMA.EQ.3) WRITE(*,11)
 11   FORMAT (' FUMIGATION')
      IF (IPO.NE.3) GO TO 13
      WRITE(*,12) (CI(I),I=1,ND)
 12   FORMAT('       CONCENTRATIONS',10F5.0)
      WRITE(*,*)
      WRITE(*,*) '       X       CP    CONTOUR HALF-WIDTHS'
 13   IF (IPO.LT.3) WRITE(*,41)
      IF (IMA.EQ.2) WRITE(*,*)'                 PPM'
 14   IF (X.GT.XCH) X=XCH
      DXA=DX
      IF (X.GE.(DX*10.)) DX=DX*10.
      DXA=DXA+DX
      IF (X.EQ.0) X=1
      SY=SYR*((X+B)*.01)**ALF
      SZ=SZR*((X+C)*.01)**BTA
      IF (IVD.EQ.1.AND.X.EQ.1.) CALL VDPL(Q,SY,SZ,CI(1),X,DX,DXA,XS,
     1XCH,CP,CP,SDEPL,2)
      IF (IRTP.GT.0) GO TO 15
      CALL PLRS (UT,TMP,PMM,IL,IM,IR,X,H,HML,IPC,IRTP)
 15   IF (IMA.NE.3) GO TO 16
      SYF=SY+(H*.125)
      CP=QOU/(150.39770*SYF*(H+SZ+SZ))
      GO TO 24
 16   IF (MXLF) 18,18,17
 17   CP=QOU/(150.39770*SY*HML)
      GO TO 22
 18   CP=QOU/(188.49556*SZ*SY)
      TSZSQ=SZ*SZ*2.
      HPZ=H+Z
      HMZ=H-Z
      VT=V*X/UT
      FAC=0.
      HML2=1.E36
      ARG=(HMZ-VT)**2/TSZSQ
      IF (ARG.LT.87.) FAC=FAC+EXP(-ARG)
      ARG=(HPZ-VT)**2/TSZSQ
      IF (ARG.LT.87.) FAC=FAC+RC/EXP(ARG)
      ZFAC=0.
      IF (HML.GT.1.E10.OR.MXLF.EQ.1) GO TO 21
      DO 19 JJ=1,20
      SMHML=TWHML*JJ
      ARG=(SMHML-HPZ+VT)**2/TSZSQ
      IF (ARG.GT.87.) GO TO 20
      ZFAC=ZFAC+RC**(JJ-1)/EXP(ARG)
      ARG=(SMHML-HMZ+VT)**2/TSZSQ
      IF (ARG.LT.87.) ZFAC=ZFAC+RC**JJ/EXP(ARG)
      ARG=(SMHML+HMZ-VT)**2/TSZSQ
      IF (ARG.LT.87.) ZFAC=ZFAC+RC**JJ/EXP(ARG)
      ARG=(SMHML+HPZ-VT)**2/TSZSQ
 19   IF (ARG.LT.87.) ZFAC=ZFAC+RC**(JJ+1)/EXP(ARG)
 20   IF((FAC+ZFAC).NE.0.)HML2=(2.5066283*SZ)/(FAC+ZFAC)
      IF (HML.GT.HML2.AND.(HML-HML2).LT.1) MXLF=1
 21   RF=(FAC+ZFAC)/2.
      CP=CP*RF
 22   IF (X.LT.XC) GO TO 23
      SX=.1522*((X+A)**.9294)
      CP=CP*TWL(1)*UT*23.936537/SX
 23   IF (HK.GT.0.) CP=CP/EXP(X*HKOU)
 24   IF (CP.LT.1.E-35) GO TO 36
      IF (IVD.EQ.1) CALL VDPL(Q,SY,SZ,CI(1),X,DX,DXA,XS,
     1XCH,CP,CP,SDEPL,3)
      IF (IMA.EQ.2) CP=CP*24.45/FMW
      CPL=LOG(CP)
      IF (XSAVE.EQ.0..OR.CPL.GE.CPLSAV) GO TO 28
      IND=1
 25   IF (CPMX.LT.CI(IC)) GO TO 26
      IF (CP.GT.CI(IC).OR.CPLSAV.LT.CL(IC)) GO TO 29
      XLNA=ALOG(X)
      XLNB=ALOG(XSAVE)
      XLNC=XLNB+(XLNA-XLNB)*(CL(IC)-CPLSAV)/(CPL-CPLSAV)
      XINT=EXP(XLNC)
      IF (IVD.EQ.1) WRITE(*,'(F5.2)') SDEPL
      WRITE (*,27) XINT,CI(IC)
 26   IC=IC-1
      IF (IC-MRL) 29,29,25
 27   FORMAT (/1X,F10.0,'* ',1PE10.3)
 28   IND=0
      IC=ND
      IF (CP.LT.CPMX) GO TO 29
      CPMX=CP
      XCMX=X
 29   IF (IPO.NE.3) GO TO 32
      SYRT2=1.41421*SY
      Y(1)=0.
      DO 30 IY=1,ND
      ARG=CPL-CL(IY)
      IF (ARG.LT.0.) GO TO 31
      Y(IY)=SYRT2*SQRT(ARG)
      IF (X.NE.XCH) AR(IY)=AR(IY)+Y(IY)*DXA
      IF (X.EQ.XCH) AR(IY)=AR(IY)-Y(IY)*(XSAVE+DX-XCH)
 30   CONTINUE
      IY=ND+1
 31   IY=IY-1
      WRITE (*,39) X,CP,(Y(I),I=1,IY)
      GO TO 35
 32   IF (IPO.EQ.0.OR.IPO.EQ.4) GO TO 35
      IF (RF.EQ.1.0.OR.MXLF.EQ.1) GO TO 34
      WRITE (*,33) X,CP,RF
 33   FORMAT (1X,F10.0,2X,1P2E10.3)
      GO TO 35
 34   WRITE (*,33) X,CP
 35   IF (IND.EQ.1.AND.CPL.LT.CL(1+MRL).AND.IRTP.GT.0) GO TO 37
      XSAVE=X
      CPLSAV=CPL
      IF (X.NE.XCH) GO TO 36
      IMTCH=1
      SXS=SX
      SYS=SY
      SZS=SZ
      RETURN
 36   IF (X.EQ.1..AND.DX.GT.1.) X=0.
      X=X+DX
      GO TO 14
 37   IF (CPMX.LT.CI(1+MRL)) WRITE(*,39) XCMX,CPMX
      IF (IPO.EQ.3) WRITE (*,40) (CI(I),AR(I),I=ND,1,-1)
      IF (IVD.EQ.1.AND.IPO.EQ.4) CALL VDPL(Q,SY,SZ,CI(1),X,DX,DXA,XS,
     1XCH,CP,CP,SDEPL,4)
      RETURN
 38   FORMAT (21X,10F5.0)
 39   FORMAT (1X,F10.0,1PE10.3,0P10F5.0)
 40   FORMAT (//5X,'C',8X,'AREA',/(1P2E10.3))
 41   FORMAT(/9X,'X',8X,'CP',8X,'RF')
      END
