C =============================================================================

C ZONE-TO-ZONE LINE-OF-SIGHT PROPAGATION
C FOR HOMOGENEOUS MATRIX ELEMENT EVALUATIONS.
C
C -----------------------------------------------------------------------------
C NOTE THAT THIS ROUTINE MAINTAINS A STRICT ADHERENCE TO THE RT-GRID DENSITY
C AND TEMPERATURE ARRAYS
C
C 23 SEPT 94 . . . UPDATED TO NONISOTHERMAL EVALUATIONS.
C 25 JAN  02 . . . ELIMINATED REFERENCE TO NONIT
C 31 JAN  02 . . . SOUGHT TO GENERALIZE USE OF LOS_PARAM & FAR_SIDE
C -----------------------------------------------------------------------------

      SUBROUTINE ZONE(IKNT,JKNT,BRAD,BCHI,HDNS,O2DNS,TATM,
     &                I1,J1,R1,X1,THETA,PHI,LPROF,SPDPT,
     &                TRIP,ODLC,ODO2,I_EXIT,J_EXIT)

      IMPLICIT REAL*8 (A-H,O-Z)
      LOGICAL PASS, INSIDE, TRIP(IKNT,JKNT)

      DIMENSION BRAD(IKNT+1),BCHI(JKNT+1)
      DIMENSION HDNS(IKNT),O2DNS(IKNT),TATM(IKNT)
      DIMENSION SPDPT(LPROF) 
      DIMENSION ODLC(2,0 : LPROF,IKNT,JKNT,2),ODO2(2,IKNT,JKNT,2)

      DIMENSION PARAM_LOS(13)
C     COMMON / LOSREF_PARM /
C    &   CX1, SX1, CU1, SU1, CP1, SP1,
C    &   RSMU, DSMU, XSKIM, XTOT, OSKIM, OTOT, IPHASE, PASS

      COMMON /EXOS/  GM,CONL,PLANETR,RBASE,RC,RUPR,RP,TEXO,DEXO,VELT,
     &               RADPF,CENTER,ABSCSX,FTSAT,FDSAT,IGEO
      COMMON /NMBR/  PI,RTPI,PID2,OFFSET

C -----------------------------------------------------------------------------
C INITIALIZE STORAGE ARRAYS (MOST ENTRIES REMAIN ZERO/FALSE)
C -----------------------------------------------------------------------------

      DO III = 1,IKNT
      DO JJJ = 1,JKNT

        TRIP(III,JJJ) = .FALSE.

        DO INOUT = 1,2
        DO KROSS = 1,2

          ODO2(INOUT,III,JJJ,KROSS) = 0.0D0

          DO LP = 0,LPROF
            ODLC(INOUT,LP,III,JJJ,KROSS) = 0.0D0
          END DO

        END DO
        END DO

      END DO
      END DO

      TAU_O2 = 0.0D0
      TAULOC = 0.0D0

C -----------------------------------------------------------------------------
C LINE OF SIGHT REFERENCE QUANTITIES
C -----------------------------------------------------------------------------

      CALL LOS_PARAM(I1,J1,R1,X1,THETA,PHI,PARAM_LOS,PASS,IPHASE)

C -----------------------------------------------------------------------------
C LOS-SEGMENT FROM INITIAL POINT (NOMINAL CELL CENTER) TO CELL POINT-OF-EXIT
C AND CORRESPONDING INCREMENT TO SPECTRAL OPACITY
C -----------------------------------------------------------------------------

      ITRIP = 0

      DELTA_A = 0.0D0

      I_A = I1
      J_A = J1
      R_A = R1
      X_A = X1
      T_A = THETA

      CALL FAR_SIDE(IKNT, JKNT, BRAD, BCHI, PARAM_LOS, INSIDE,
     &              I_A, J_A, T_A, R_A, X_A, PASS, IPHASE,
     &              I_B, J_B, T_B, R_B, X_B, OMEGA)

      DELTA_B = SQRT(R_B**2 + R1**2 - 2.0D0*R_B*R1*COS(OMEGA))

C OPTICAL DEPTH ARRAY ELEMENTS

      IF ( INSIDE ) THEN

        KROSS_A = 1

        TAU_O2 = DELTA_B * O2DNS(I_A) * ABSCSX
        TAULOC = DELTA_B * HDNS(I_A)  * CENTER

        ODO2(2,  I_A,J_A,KROSS_A) = TAU_O2
        ODLC(2,0,I_A,J_A,KROSS_A) = TAULOC

        FCTR = SQRT(TEXO/TATM(I_A))
        DO LP = 1,LPROF
          XPNT = (FCTR * SPDPT(LP))**2
          ODLC(2,LP,I_A,J_A,KROSS_A) = TAULOC * FCTR * EXP(-XPNT)
        END DO

        TRIP(I_A,J_A) = .TRUE.

        IF ((I_B.LT.1).OR.(I_B.GT.IKNT)) GO TO 222

        ODO2(1,  I_B,J_B,KROSS_A) = ODO2(2,  I_A,J_A,KROSS_A)
        ODLC(1,0,I_B,J_B,KROSS_A) = ODLC(2,0,I_A,J_A,KROSS_A)
        DO LP = 1,LPROF
          ODLC(1,LP,I_B,J_B,KROSS_A) = ODLC(2,LP,I_A,J_A,KROSS_A)
        END DO

      END IF

C -----------------------------------------------------------------------------
C SUBSEQUENT STEPS THROUGH CELLS ALONG LINE OF SIGHT
C -----------------------------------------------------------------------------

 111  CONTINUE

      ITRIP = ITRIP + 1

      DELTA_A = DELTA_B

      I_A = I_B
      J_A = J_B
      R_A = R_B
      X_A = X_B
      T_A = T_B

      CALL FAR_SIDE(IKNT, JKNT, BRAD, BCHI, PARAM_LOS, INSIDE,
     &              I_A, J_A, T_A, R_A, X_A, PASS, IPHASE,
     &              I_B, J_B, T_B, R_B, X_B, OMEGA)

      DELTA_B = SQRT(R_B**2 + R1**2 - 2.0D0*R_B*R1*COS(OMEGA))

C OPTICAL DEPTH ARRAY ELEMENTS

      IF ( INSIDE ) THEN

        KROSS_A = 1
        IF (TRIP(I_A,J_A)) KROSS_A = 2

        TAU_O2 = (DELTA_B - DELTA_A) * O2DNS(I_A) * ABSCSX
        TAULOC = (DELTA_B - DELTA_A) * HDNS(I_A)  * CENTER

        ODO2(2,  I_A,J_A,KROSS_A) = ODO2(1,  I_A,J_A,KROSS_A) + TAU_O2
        ODLC(2,0,I_A,J_A,KROSS_A) = ODLC(1,0,I_A,J_A,KROSS_A) + TAULOC

        FCTR = SQRT(TEXO/TATM(I_A))
        DO LP = 1,LPROF
          XPNT = (FCTR * SPDPT(LP))**2
          ODLC(2,LP,I_A,J_A,KROSS_A) = TAULOC * FCTR * EXP(-XPNT)
     &                               + ODLC(1,LP,I_A,J_A,KROSS_A)
        END DO

        TRIP(I_A,J_A) = .TRUE.

        IF ((I_B.LT.1).OR.(I_B.GT.IKNT)) GO TO 222

        KROSS_B = 1
        IF (TRIP(I_B,J_B)) KROSS_B = 2
        ODO2(1,  I_B,J_B,KROSS_B) = ODO2(2,  I_A,J_A,KROSS_A)
        ODLC(1,0,I_B,J_B,KROSS_B) = ODLC(2,0,I_A,J_A,KROSS_A)
        DO LP = 1,LPROF
          ODLC(1,LP,I_B,J_B,KROSS_B) = ODLC(2,LP,I_A,J_A,KROSS_A)
        END DO

      END IF

      GO TO 111

C -----------------------------------------------------------------------------

 222  CONTINUE

      I_EXIT = I_A
      J_EXIT = J_A

C -----------------------------------------------------------------------------

      RETURN
      END

C =============================================================================