      SUBROUTINE OPTRAN(NLEV,P,T,Q,PW,O3,ANGLE,NCHNUS,
     +                  CHAN,PTRANS,ERSTAT)  
      IMPLICIT NONE
C***********************************************************************
C
C   NAME- OPTRAN
C
C   LANGUAGE- FORTRAN     TYPE- SUBROUTINE
C
C   VERSION- 2.0    DATE-  2/08/96    PROGRAMMER- CARLA NEIGH (SMSRC)
C   VERSION- 2.1    DATE-  3/25/96    PROGRAMMER- ROBERT FELDMAN (SMSRC)
C   ATOVS- 384  ADDITION OF ARRAY Q WHICH CONTAINS MIXING RATIO PROFI
C   VERSION- 3.0    DATE-  6/13/96    PROGRAMMER- MIKE PETTEY (HSTX)
C   VERSION- 3.1    DATE- 10/08/96    PROGRAMMER- MIKE PETTEY (HSTX)
C   VERSION- 3.2    DATE- 10/01/98    PROGRAMMER- BRIAN BARIL (ITSS)
C   VERSION- 3.3    DATE- 11/14/01    PROGRAMMER- RICKEY ROLLINS (CSC)
C
C   FUNCTION- COMPUTES THE TRANSMITTANCE USING THE OPTICAL PATH
C             REGRESSION ALGORITHM.
C
C      VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS
C                   BASELINE ON THE CRAY
C      VERSION 3.1- REMOVED A BUG THAT SET THE VALUE OF 'FIRST' TO
C                   TRUE EVERY TIME THIS ROUTINE IS RUN
C      VERSION 3.1- CHANGED NLEV TO NLEVEL,CHANGED COEFFS SENT TO
C                   MAKWLV,SPLIT TRANSMITTENCE LOOP,SUBTRACTED -.005
C                   FROM SLANTP.    
C      VERSION 3.3 PORTED TO IBM SP CORRECTED BOOLEAN CONSTANT 
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   NLEV    INT     I    NUMBER OF LEVELS.
C   P       REAL    I    ARRAY (DIM NLEVEL) OF PRESSURE LEVELS.
C   T       REAL    I    ARRAY (DIM NLEVEL) OF TEMPERATURES (K).
C   Q       REAL    I    ARRAY (DIM NLEVEL) CONTAINING THE ATMOSPHERIC MIX
C                        RATIO PROFILE.
C   PW      REAL    I    ARRAY (DIM NLEVEL) OF PRECIPITABLE WATER (CM).
C   O3      REAL    I    ARRAY (DIM NLEVEL) OF THE INTEGRATED OZONE
C                        PROFILE.
C   ANGLE   REAL    I    ZENITH ANGLE TO USE (DEGREES).
C   NCHNUS  INT     I    NUMBER OF CHANNELS TO USE.
C   CHAN    INT     I    ARRAY (DIM NCHNUS) OF CHANNELS FOR WHICH TO
C                        COMPUTE TRANSMITTANCE.
C   PTRANS  REAL    O    ARRAY (DIM NLEVEL X NCHNUS) OF TRANSMITTANCES.
C   ERSTAT  INT     O    ERROR RETURN CODE-
C                        SEE EXIT STATES BELOW.
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'OPTPARM'
      INCLUDE 'OPTCOE'
      INCLUDE 'SPVAL'
C
C   LOCAL PARAMETERS-
C   NAME    TYPE   DESCRIPTION
C   ----    ----   -----------
C   WW      REA    ARRAY (DIM 0:OPTPARM:NW) CONTAINING THE WET ABSORBER
C                  AMOUNT SPACE
C   AA      REA    ARRAY (DIM 0:OPTPARM:NW) CONTAINING THE DRY ABSORBER
C                  AMOUNT SPACE
C   OO      REAL   ARRAY (DIM 0:OPTPARM:NW) CONTAINING THE OZONE ABSORBE
C                  AMOUNT SPACE
C   PWMAX   REAL   MAX WET ABSORBER AT WW(OPTPARM:NW)
C   PMAX    REAL   MAX DRY ABSORBER AT AA(OPTPARM:NW)
C   OZMAX   REAL   MAX OZONE ABSORBER AT OO(OPTPARM:NW)
C   SLNTPW  REAL   ARRAY (DIM OPTPARM:NLEVEL) CONTAINING THE WET ABSORBE
C                  PROFILE ON A GENERALIZED SLANT PATH
C   SLANTP  REAL   ARRAY (DIM OPTPARM:NLEVEL) CONTAINING THE DRY ABSORBE
C                  PROFILE ON A GENERALIZED SLANT PATH
C   SLNTOZ  REAL   ARRAY (DIM OPTPARM:NLEVEL) CONTAINING THE OZONE ABSOR
C                  PROFILE ON A GENERALIZED SLANT PATH
C   ODWET   REAL   ARRAY (DIM OPTPARM:NLEVEL X OPTPARM:NCHAN) CONTAINING
C                  WET OPTICAL DEPTH ON PRESSURE LEVELS
C   ODDRY   REAL   ARRAY (DIM OPTPARM:NLEVEL X OPTPARM:NCHAN) CONTAINING
C                  DRY OPTICAL DEPTH ON PRESSURE LEVELS
C   ODOZO   REAL   ARRAY (DIM OPTPARM:NLEVEL X OPTPARM:NCHAN) CONTAINING
C                  OZONE OPTICAL DEPTH ON PRESSURE LEVELS
C   DTR     REAL   DEGREES TO RADIANS CONVERSION
C   SECANT  REAL   SECANT OF ANGLE
C   LEVEL   INT    DO LOOP COUNTER FOR LEVEL
C   I       INT    DO LOOP INDEX
C   FIRST    L     SET TO .TRUE. ON FIRST EXECUTION OF ROUTINE
C
C   SUBPROGRAMS CALLED- MAKWLV, OPTSPE
C
C   FUNCTIONS USED- COS, EXP
C
C   EXIT STATES-
C     ERSTAT = 0 : NORMAL EXECUTION
C     ERSTAT = 99: FATAL ERROR, TRANSMITTANCES COULD NOT BE COMPUTED
C
C   COMMENTS-  THIS ROUTINE IS BASED ON THE SUBROUTINE CALLED
C              'OPTRANS' WRITTEN BY THOMAS J. KLEESPIES OF THE
C              ORA PHYSICS BRANCH.
C
C              ****************** WARNING ********************
C              BEFORE CALLING THIS ROUTINE, THE COMMON BLOCK
C              /OPTCOE/ MUST BE FILLED BY CALLING THE ROUTINE
C              OPCOEF.
C              ****************** WARNING ********************
C
C***********************************************************************
C
      INTEGER NCHNUS, NLEV, CHAN(NCHAN), ERSTAT, LVL
      REAL P(NLEVEL),T(NLEVEL), Q(NLEVEL), PW(NLEVEL), O3(NLEVEL), ANGLE
      REAL PTRANS(NLEVEL,NCHAN)
      REAL WW(0:NW), AA(0:NW), OO(0:NW)
      REAL SLNTPW(NLEVEL), SLANTP(NLEVEL), SLANTZ(NLEVEL)
      REAL ODWET(NLEVEL,NCHAN), ODDRY(NLEVEL,NCHAN), ODOZO(NLEVEL,NCHAN)
      REAL PWMAX	
      REAL PMAX
      REAL OZMAX	
      REAL DTR
      REAL SECANT, REXPO
      INTEGER LEVEL, I
      LOGICAL FIRST

      DATA FIRST/.TRUE./

      SAVE FIRST, WW, AA, OO


C-- THE FOLLOWING LINES WERE MOVED FROM TO DECLARATION STATEMENTS FOR
C   ATOVS BASELINING

      PWMAX  = 13.87981
      PMAX   = 2100.
      OZMAX  = 1.1403912
      DTR    = 1.74532952E-2

      ERSTAT = 0
   
      

C-- THE FIRST TIME THIS ROUTINE IS EXECUTED, CONSTRUCT THE
C   ABSORBER AMOUNT SPACES

      IF (FIRST) THEN
         CALL MAKWLV(1,PWMAX,1.0E-7,WW,ERSTAT)
         IF (ERSTAT .EQ. 99) RETURN

         CALL MAKWLV(1,PMAX,0.01,AA,ERSTAT)
         IF (ERSTAT .EQ. 99) RETURN

         CALL MAKWLV(1,OZMAX,2.0E-5,OO,ERSTAT)
         IF (ERSTAT .EQ. 99) RETURN

	 FIRST = .FALSE.
      END IF


C-- IF NLEV > NLEVEL, COMPUTATIONS CANNOT BE DONE CORRECTLY

      IF (NLEV .GT. NLEVEL) THEN
         ERSTAT = 99
         RETURN
      END IF

C *** ASSUMING LIMB CORRECTIONS HAVE BEEN PERFORMED THE ***
C ***   0.0 DEG ZENITH ANGLE SENT FROM CLDTOP IS VALID  ***

      SECANT = 1.0 / COS(ANGLE*DTR)


C-- COMPUTE SLANT PATH ABSORBER AMOUNTS

      DO 100 LEVEL= 1 , NLEVEL	
         SLANTP(LEVEL) = P(LEVEL)*SECANT - 0.005
         SLNTPW(LEVEL) = PW(LEVEL)*SECANT
         SLANTZ(LEVEL) = O3(LEVEL)*SECANT
  100 CONTINUE


C-- GET WET OPTICAL DEPTH PROFILE

      CALL OPTSPE(NLEVEL,NWET+1,NWET,BW,WW,P,T,Q,SLNTPW,NCHNUS,CHAN,
     +            PRDWET,ODWET)



C- GET DRY OPTICAL DEPTH PROFILE

      CALL OPTSPE(NLEVEL,NDRY+1,NDRY,BD,AA,P,T,Q,SLANTP,NCHNUS,CHAN,
     +            PRDDRY,ODDRY)


C-- GET OZONE OPTICAL DEPTH PROFILE

      CALL OPTSPE(NLEVEL,NOZO+1,NOZO,BO,OO,P,T,Q,SLANTZ,NCHNUS,CHAN,
     +            PRDOZO,ODOZO)

C-- COMPUTE TOTAL TRANSMITTANCE PROFILE

      DO 300 I = 1, NCHNUS
      
         PTRANS(1,I) = 1.0
         DO 200 LEVEL = 2, NLEV
            REXPO= EXP(-(ODWET(LEVEL,I)+ODDRY(LEVEL,I)+ODOZO(LEVEL,I)))
            PTRANS(LEVEL,I) = PTRANS(LEVEL-1,I)*REXPO
            print *,'PTRANS(',Level,I,')',ptrans(level,i),
     +              ' PTRANS(',(level-1),i,')',ptrans(level-1,i)

  200    CONTINUE
  300 CONTINUE

      RETURN
      END






