C**********************************************************************C
C                Optical depts at reference wavelengths                C
C                       M=1:  0.5 mu, M=2: 1.0 mu                      C
C        Version:  23. Feb., 2009                                      C
C**********************************************************************C
      SUBROUTINE OPTD(M,TAU)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER(KDIM=1000,IFDIM=11)
      COMMON/CONST/HP,CL,BK,PM,SIG,GRAV,PI,SUNM,SUNR,SUNL,YEAR,RGAS,PAT
      COMMON/ABUND/EPSHE,EPSC,EPSN,EPSO,EPSNE,EPSNA,EPSMG,EPSAL,EPSSI,
     *  EPSS,EPSAR,EPSCA,EPSFE,EPSNI
      COMMON/RMOD/RD(KDIM),TG(KDIM),RHO(KDIM),VV(KDIM),DKAP(KDIM),
     *  GAM(KDIM),FV(KDIM,IFDIM),VDR(KDIM,IFDIM),KL,KK
      COMMON/COLI/V0OLI,A0OLI,EPSOLI,ALFOLI,ALFOLEX
      COMMON/CPYR/V0PYR,A0PYR,EPSPYR,ALFPYR,ALFPYEX
      COMMON/CQUA/V0QUA,A0QUA,EPSQUA,ALFQUA
      COMMON/CIRO/V0IRO,A0IRO,EPSIRO,ALFIRO
      COMMON/CCAR/V0CAR,A0CAR,EPSCAR,ALFCAR
      COMMON/CSIC/V0SIC,A0SIC,EPSSIC,ALFSIC
      COMMON/CTE/CHM,RCOS,RCOC
      DIMENSION QA05(4),QS05(4),QA10(4),QS10(4)
C     -- Absorption and scattering data at 0.5 and 1.0 mue --
      DATA QA05/6.175E+03,1.548E+05,1.118E+04,1.090E+05/
      DATA QS05/1.000E+05,1.790E+05,1.354E+06,2.090E+05/
      DATA QA10/3.212E+03,7.440E+04,8.108E+03,7.860E+04/
      DATA QS10/6.425E+03,3.530E+04,5.134E+04,6.080E+04/
C     -- dust opacity --
      FSIL=.75D0*EPSSI*V0OLI/(1.4D0*PM)
      FCAR=.75D0*EPSC*V0CAR/(1.4D0*PM)
      FSIC=.75D0*EPSSI*V0SIC/(1.4D0*PM)
      FIRO=.75D0*EPSFE*V0IRO/(1.4D0*PM)
      IF(M.EQ.1) THEN
        EXTSIL=(QA05(1)+QS05(1))*FSIL
        EXTCAR=(QA05(2)+QS05(2))*FCAR
        EXTSIC=(QA05(3)+QS05(3))*FSIC
        EXTIRO=(QA05(4)+QS05(4))*FIRO
      ELSE
        EXTSIL=(QA10(1)+QS10(1))*FSIL
        EXTCAR=(QA10(2)+QS10(2))*FCAR
        EXTSIC=(QA10(3)+QS10(3))*FSIC
        EXTIRO=(QA10(4)+QS10(4))*FIRO
      END IF
C     -- optical depth --
      RCO=EPSC/EPSO
      TAU=0D0
      EXTDUL=0D0
      DO K=2,KK
        IF(RCO.LE.RCOS) THEN
C         -- M-stars --
          EXTDU=(FV(K,1)+FV(K,3)+FV(K,5))*EXTSIL+FV(K,6)*EXTIRO
        ELSE
        IF(RCO.LE.RCOC) THEN
C         -- S-stars --             
          EXTDU=FV(K,1)*EXTIRO+FV(K,2)*EXTSIL
        ELSE
C         -- C-stars --
          EXTDU=FV(K,1)*EXTCAR+FV(K,2)*EXTSIC+FV(K,3)*EXTIRO
        END IF
        END IF
        TAU=TAU+.5D0*(RD(K)-RD(K-1))*(RHO(K)*EXTDU+RHO(K-1)*EXTDUL)
        EXTDUL=EXTDU
      END DO
      RETURN
      END