C       X_SEC2.FOR

c ======================================================================
      Subroutine  vBRONO2_X_97 ( Num_lev,  !'T' not used GM 1/00
     *Len_t, wlt, Num_beg, Len_X, xs, K_T)
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf =21, L_j = L_hlf*3-2 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_26 / w_j_26 (L_j),
     *                   x_j_26 (L_j)
Cgal

        lun_x = 10

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'BrONO2 j' )
Cgal         read (lun_x,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (lun_x,12) AA
Cgal
Cgal       read (lun_x, * ) ( w_j(i), x_j(i),  w_j(i+L_hlf),
Cgal     *        x_j(i+L_hlf),  w_j(i+2*L_hlf), x_j(i+2*L_hlf),
Cgal     *       i = 1, L_hlf-2 )
Cgal
Cgal       read (lun_x,* )  ( w_j(i), x_j(i), w_j(i+L_hlf),
Cgal     *        x_j(i+L_hlf), i=L_hlf-1,L_hlf )
Cgal
Cgal 1      format ( 3(2x, 0pf7.2, 1pe10.2) )
Cgal 10   format ( 2(2x, 0pf7.2, 1pe10.2) )

Cgal
      do i=1,L_j
         w_j(i) =  w_j_26(i)
         x_j(i) =  x_j_26(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linoext ( L_j, Len_X, w_j, wlt(Num_beg),
     *			  x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

	return
        end

c ===================================================================
C
        Subroutine  vBRONO2_X ( Num_lev,  ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf =19, L_j = L_hlf*2 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) !'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_27 / w_j_27 (L_j),
     *                   x_j_27 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'BrONO2' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_hlf),
Cgal     *       x_j(i+L_hlf),  i = 1, L_hlf )
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
         w_j(i) =   w_j_27(i)
         x_j(i) =   x_j_27(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c ===================================================================
        Subroutine  vCH3CL_X ( Num_lev, T, Len_t, wlt, Num_beg, Len_X,
     *                xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 16, NT = 3 )
        include 'jpl.par'

        real  x_j (L_j,NT), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev), T_j (NT),
     *        xs_Tj (Len_tm, NT), xsm (NT), xsT (1)

        character*8  AA

Cgal
      COMMON / XSEC_28 / w_j_28 (L_j),
     *                   x_j_28 (L_j,NT)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        T_j (1) = 255.
        T_j (2) = 279.
        T_j (3) = 296.

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CH3Cl' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format (2x,A8)
Cgal        read (10,2) AA
Cgal
Cgal        read ( 10, * ) ( w_j(i), ( x_j(i,k), k=3,1,-1 ),
Cgal     *                   i = 1, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, 3f10.3 )

Cgal
      do i=1,L_j
           w_j(i) = w_j_28(i)
      do k=1,NT
         x_j(i,k) = x_j_28(i,k)
      end do
      end do
Cgal

c        Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

        Len_X = Len_X - 1
c   (...because otherwise extrapol. to 217 nm produces neg. value at 10km)
ccc        print *, 'Num_beg= ', Num_beg, 'Len_X= ', Len_X

c        ...and interpolate x-sections to model wlt grid:

        do it = 1, NT
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j(1,it), xs_Tj(Num_beg, it) )
        enddo

c   ... and to each temperature:

        do l = Num_beg, Num_beg+Len_X-1
            do it = 1, NT
               xsm(it) = xs_Tj(l,it)*1.E-20
            enddo
            do i = 1, Num_lev
              call linoext ( NT, 1, T_j, T(i), xsm, xsT )
              xs(l,i) = xsT(1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p4e10.2 )
        end

c ======================================================================
        Subroutine  vCH3CCL3_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *            Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 11, NT = 3 )
        include 'jpl.par'

        real  x_j (L_j,NT), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev), T_j (NT),
     *        xs_Tj (Len_tm, NT), xsm (NT), xsT (1)

        character*8  AA

Cgal
      COMMON / XSEC_29 / w_j_29 (L_j),
     *                   x_j_29 (L_j,NT)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        T_j (1) = 210.
        T_j (2) = 250.
        T_j (3) = 295.

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CH3CCl3' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format (2x,A8)
Cgal        read (10,2) AA
Cgal
Cgal        read ( 10, * ) ( w_j(i), ( x_j(i,k), k=3,1,-1 ),
Cgal     *                   i = 1, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, 3f10.3 )

Cgal
      do i=1,L_j
          w_j(i) =  w_j_29(i)
      do k=1,NT
         x_j(i,k) = x_j_29(i,k)
      end do
      end do
Cgal

c        Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

ccc        Len_X = Len_X - 1
c   (...because otherwise extrapol. to 217 nm produces neg. value at 10km)
ccc        print *, 'Num_beg= ', Num_beg, 'Len_X= ', Len_X

c        ...and interpolate x-sections to model wlt grid:

        do it = 1, NT
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j(1,it), xs_Tj(Num_beg, it) )
        enddo

c   ... and to each temperature:

        do l = Num_beg, Num_beg+Len_X-1
            do it = 1, NT
               xsm(it) = xs_Tj(l,it)*1.E-20
            enddo
            do i = 1, Num_lev
              call linoext ( NT, 1, T_j, T(i), xsm, xsT )
              xs(l,i) = xsT(1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p4e10.2 )
        end

c ======================================================================
        Subroutine  vCCL4_X ( Num_lev,  ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf =22, L_j = L_hlf*2 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t)  ! 'T (Num_lev)' not used GM1/00

        character*8  AA

Cgal
      COMMON / XSEC_30 / w_j_30 (L_j),
     *                   x_j_30 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CCl4' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_hlf),
Cgal     *       x_j(i+L_hlf),  i = 1, L_hlf )
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
        w_j(i) =  w_j_30(i)
        x_j(i) =  x_j_30(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c ===================================================================
        Subroutine  vF11_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *                        Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf = 19, L_j = L_hlf*2-1  )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j), xs298 (Len_tm),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev)

        character*8  AA

Cgal
      COMMON / XSEC_31 / w_j_31 (L_j),
     *                   x_j_31 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CCl3F' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_hlf),
Cgal     *       x_j(i+L_hlf),  i = 1, L_hlf-1 )
Cgal
Cgal       read ( 10, * )  w_j(L_hlf), x_j(L_hlf)
Cgal
Cgal 1      format ( 2x, f6.2, f12.5 )

Cgal
      do i=1,L_j
        w_j(i) =   w_j_31(i)
        x_j(i) =   x_j_31(i)
      end do
Cgal

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate  F11 x-sections to model wlt grid:

         call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),  x_j,
     *                    xs298(Num_beg) )

        do i = 1, Num_lev
           tt  = T(i) - 298.
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs298(l)*1.E-20*exp ( 1.E-4*(wlt(l)-184.9)*tt )
           enddo
        enddo

 20     format ( 2x, 0pf7.2, 1p4e10.2 )

        end
c =========================================================================
        Subroutine  vF12_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *                        Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf = 15, L_j = L_hlf*2 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j), xs298 (Len_tm),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev)

        character*8  AA

Cgal
      COMMON / XSEC_32 / w_j_32 (L_j),
     *                   x_j_32 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CCl2F2' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_hlf),
Cgal     *       x_j(i+L_hlf),  i = 1, L_hlf )
Cgal
Cgal 1      format ( 2x, f6.2, f12.5 )

Cgal
      do i=1,L_j
        w_j(i) =   w_j_32(i)
        x_j(i) =   x_j_32(i)
      end do
Cgal

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate  F12 x-sections to model wlt grid:

         call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),  x_j,
     *                    xs298(Num_beg) )

        do i = 1, Num_lev
           tt  = T(i) - 298.
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs298(l)*1.E-20*exp ( 4.1E-4*(wlt(l)-184.9)*tt )
           enddo
        enddo

 20     format ( 2x, 0pf7.2, 1p4e10.2 )

        end
c =========================================================================
        Subroutine  vCH3BR_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg,Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf =20, L_j = L_hlf*2-4 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t)   ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_33 / w_j_33 (L_j),
     *                   x_j_33 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CH3Br' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_hlf),
Cgal     *       x_j(i+L_hlf),  i = 1, L_hlf-4 )
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i), i = L_hlf-3, L_hlf )
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
        w_j(i) =   w_j_33(i)
        x_j(i) =   x_j_33(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c ===================================================================
        Subroutine  vCF3BR_X ( Num_lev,  ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j =40 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_34 / w_j_34 (L_j),
     *                   x_j_34 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CF3Br' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (23x,A6)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), a, b, x_j(i), c, i = 1, L_j )
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
        w_j(i) =  w_j_34(i)
        x_j(i) =  x_j_34(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c ===================================================================
        Subroutine  vCF2CLBR_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j =50 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t)  ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_35 / w_j_35 (L_j),
     *                   x_j_35 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CF2ClBr' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (6x,A7)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i), a,b,c, i = 1, 40 )
Cgal       read ( 10, * ) ( w_j(i), x_j(i), a,b,   i = 41, 46 )
Cgal       read ( 10, * ) ( w_j(i), x_j(i), a,     i = 47, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, f10.4 )

Cgal
      do i=1,L_j
        w_j(i) =   w_j_35(i)
        x_j(i) =   x_j_35(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c ===================================================================
        Subroutine  vHCFC22_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *            Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 16, NT = 5 )
        include 'jpl.par'

        real  x_j (L_j,NT), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev), T_j (NT),
     *        xs_Tj (Len_tm, NT), xsm (NT), xsT (1)

        character*8  AA

Cgal
      COMMON / XSEC_36 / w_j_36 (L_j),
     *                   x_j_36 (L_j,NT)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        T_j (1) = 210.
        T_j (2) = 230.
        T_j (3) = 250.
        T_j (4) = 270.
        T_j (5) = 295.

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CHClF2' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format (2x,A8)
Cgal        read (10,2) AA
Cgal
Cgal        read ( 10, * ) ( w_j(i), ( x_j(i,k), k=5,1,-1 ),
Cgal     *                   i = 1, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, 5f10.4 )

Cgal
      do i=1,L_j
         w_j(i) =  w_j_36(i)
      do k=1,NT
        x_j(i,k) = x_j_36(i,k)
      end do
      end do
Cgal

c        Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c   (...because otherwise extrapol. to 217 nm produces neg. value at 10km)
c        ...and interpolate x-sections to model wlt grid:

        do it = 1, NT
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j(1,it), xs_Tj(Num_beg, it) )
        enddo

c   ... and to each temperature:

        do l = Num_beg, Num_beg+Len_X-1
            do it = 1, NT
               xsm(it) = xs_Tj(l,it)*1.E-20
            enddo
            do i = 1, Num_lev
              call linoext ( NT, 1, T_j, T(i), xsm, xsT )
              xs(l,i) = xsT(1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p4e10.2 )
        end

c ======================================================================

        Subroutine  vC2CL3F3_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *            Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 24, NT = 2 )
        include 'jpl.par'

        real  x_j (L_j,NT), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev), T_j (NT),
     *        xs_Tj (Len_tm, NT), xsm (NT), xsT (1)

        character*16  AA

Cgal
      COMMON / XSEC_37 / w_j_37 (L_j),
     *                   x_j_37 (L_j,NT)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        T_j (1) = 210.
        T_j (2) = 295.

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CF2ClCFCl2' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format (8x,A10)
Cgal
Cgal        do i = 1, 7
Cgal          read (10,2) AA
Cgal        enddo
Cgal
Cgal        read ( 10, * ) ( w_j(i), ( x_j(i,k), k=2,1,-1 ),
Cgal     *                   a, b, c, i = 1, 11 )
Cgal        read ( 10, * ) ( w_j(i), ( x_j(i,k), k=2,1,-1 ),
Cgal     *                   a, b, i = 12, 19 )
Cgal        read ( 10, * ) ( w_j(i), ( x_j(i,k), k=2,1,-1 ),
Cgal     *                   i = 20, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, 2f10.4 )

Cgal
      do i=1,L_j
         w_j(i) =  w_j_37(i)
      do k=1,NT
        x_j(i,k) = x_j_37(i,k)
      end do
      end do
Cgal

c        Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c        ...and interpolate x-sections to model wlt grid:

        do it = 1, NT
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j(1,it), xs_Tj(Num_beg, it) )
        enddo

c   ... and to each temperature:

        do l = Num_beg, Num_beg+Len_X-1
            do it = 1, NT
               xsm(it) = xs_Tj(l,it)*1.E-20
            enddo
            do i = 1, Num_lev
              call linoext ( NT, 1, T_j, T(i), xsm, xsT )
              xs(l,i) = xsT(1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p4e10.2 )
        end

c ======================================================================
        Subroutine  vC2CL2F4_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *            Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 25, NT = 2 )
        include 'jpl.par'

        real  x_j (L_j,NT), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev), T_j (NT),
     *        xs_Tj (Len_tm, NT), xsm (NT), xsT (1)

        character*16  AA

Cgal
      COMMON / XSEC_38 / w_j_38 (L_j),
     *                   x_j_38 (L_j,NT)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        T_j (1) = 210.
        T_j (2) = 295.

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CF2ClCF2Cl' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format (24x,A10)
Cgal
Cgal        read (10,2) AA
Cgal
Cgal        read ( 10, * ) ( w_j(i), ( x_j(i,k), k=2,1,-1 ),
Cgal     *                   c, i = 1, 6 )
Cgal        read ( 10, * ) ( w_j(i), a, b, ( x_j(i,k), k=2,1,-1 ),
Cgal     *                   c, i = 7, 17 )
Cgal        read ( 10, * ) ( w_j(i), a, b, ( x_j(i,k), k=2,1,-1 ),
Cgal     *                   i = 18, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, 2f10.4 )

Cgal
      do i=1,L_j
         w_j(i) =  w_j_38(i)
      do k=1,NT
        x_j(i,k) = x_j_38(i,k)
      end do
      end do
Cgal

c        Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c        ...and interpolate x-sections to model wlt grid:

        do it = 1, NT
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j(1,it), xs_Tj(Num_beg, it) )
        enddo

c   ... and to each temperature:

        do l = Num_beg, Num_beg+Len_X-1
            do it = 1, NT
               xsm(it) = xs_Tj(l,it)*1.E-20
            enddo
            do i = 1, Num_lev
              call linoext ( NT, 1, T_j, T(i), xsm, xsT )
              xs(l,i) = xsT(1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p4e10.2 )
        end

c ======================================================================
        Subroutine  vC2CLF5_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg,Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 17 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_39 / w_j_39 (L_j),
     *                   x_j_39 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CF3CF2Cl' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format (38x,A8)
Cgal
Cgal        read (10,2) AA
Cgal
Cgal        read ( 10, * ) ( w_j(i), a, b, x_j(i), i = 1, 6 )
Cgal        read ( 10, * ) ( w_j(i), a, b, c, d, x_j(i), i = 7, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, f10.4 )

Cgal
      do i=1,L_j
         w_j(i) =   w_j_39(i)
         x_j(i) =   x_j_39(i)
      end do
Cgal

        do l = 1, L_j
           x_j(l) = x_j(l)*1.E-20
        enddo

c        Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c        ...and interpolate x-sections to model wlt grid:

          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

c   ... and to each temperature:

        do l = Num_beg, Num_beg+Len_X-1
            do i = 2, Num_lev
              xs(l,i) = xs(l,1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p1e10.2 )
        end

c ======================================================================
        Subroutine  vCLONO_X ( Num_lev, ! T,
     *   Len_t, wlt, Num_beg,Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf = 17, L_j = L_hlf*2  )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_40 / w_j_40 (L_j),
     *                   x_j_40 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'ClONO' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_hlf),
Cgal     *       x_j(i+L_hlf),  i = 1, L_hlf )
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
        w_j(i) =   w_j_40(i)
        x_j(i) =   x_j_40(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c =============================================================
        Subroutine  vCHBR3_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *                        Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_3 = 29, L_j = L_3*3  )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev)

        character*8  AA

Cgal
      COMMON / XSEC_41 / w_j_41 (L_j),
     *                   x_j_41 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CHBr3' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_3), x_j(i+L_3),
Cgal     *                    w_j(i+L_3*2), x_j(i+L_3*2), i = 1, L_3 )
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p1e10.2 )

Cgal
      do i=1,L_j
         w_j(i) =   w_j_41(i)
         x_j(i) =   x_j_41(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         L_j_noT = 51
         call  find_NL ( Len_t, wlt, L_j_noT, w_j, Num_beg,
     *        Len_X_noT )
         L_j1 = 76
         call  find_NL ( Len_t, wlt, L_j1, w_j, Num_beg, Len_X )

c      interpolate x-sections 190 to 290 nm to model wlt grid:

        call  linterp ( L_j_noT, Len_X_noT, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X_noT-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

         do i = 1, Num_lev
            tc = 273.-T(i)
            do l = Num_beg+Len_X_noT, Num_beg+Len_X-1
               xs(l,i) =  exp ( ( 0.06183 - 0.000241*wlt(l) )*tc -
     -         ( 2.376 + 0.14757*wlt(l) ) )
            enddo
         enddo

 20     format ( 2x, 0pf7.2, 1p4e10.2 )

        end

c =======================================================================
        Subroutine  vCCL2O_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg,Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 22 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_42 / w_j_42 (L_j),
     *                   x_j_42 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CCl2O' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format (11x,A8)
Cgal
Cgal        read (10,2) AA
Cgal
Cgal        read ( 10, * ) w_j(1), x_j(1)
Cgal        read ( 10, * ) ( w_j(i), x_j(i), a, b, i = 2, L_j )
Cgal
Cgal 1      format ( 2x, f7.2, f10.4 )

Cgal
      do i=1,L_j
        w_j(i) =  w_j_42(i)
        x_j(i) =  x_j_42(i)
      end do
Cgal

        do l = 1, L_j
           x_j(l) = x_j(l)*1.E-20
        enddo

c        Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c        ...and interpolate x-sections to model wlt grid:

          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

c   ... and to each temperature:

        do l = Num_beg, Num_beg+Len_X-1
            do i = 2, Num_lev
              xs(l,i) = xs(l,1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p1e10.2 )
        end

c ======================================================================
        Subroutine  vBRO_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *            Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
c       cent   - band centers
c       hlfw   - band halfwidths
c       xmax   - abs. cross-sections at the band max
c
        Parameter  ( N_band = 13, N_w = 253, N_tt = 2 )
        include 'jpl.par'

        real   cent (N_band), hlfw (N_band), xmax (N_tt, N_band),
     *         xm(1), xmax_t(N_band, Nlev), wavel (N_w),
     *         T_t(N_tt), T(Num_lev), xs131 (N_w, Nlev),
     *         xs (Len_t, Num_lev), wlt (Len_t), wb (Len_tm)

        data   cent / 313.5, 317., 320.8, 325., 329.1, 333.5,
     *                338.3, 343.7, 348.8, 354.7, 360.4, 367.7,
     *                374.5 /,
     *         xmax /  93.8, 71.2, 136., 101., 157., 118., 143.,
     *                 113., 139., 113., 147., 121., 195., 155.,
     *                 111., 93.5, 89.6, 70.3, 105., 72.2, 34.4,
     *                 26.4, 15.4, 14.5, 9.6 , 9. /,
     *         T_t  / 223., 298. /

c       Function to approx. describe undrlying continuum:
        contin (ww) = 20.*sin ( 3.14159/65.*(ww-310.) )

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

c       Interpolate max x-sects to the temperatures of the atm. layers:
        do ib = 1, N_band
           do it = 1, Num_lev
              call linoext ( N_tt, 1, T_t, T(it), xmax(1,ib), xm )
              xmax_t(ib,it) = xm(1)
           enddo
 100       format ( 2x, i5, 2f8.2 )

        enddo

c       Calculate band halfwidths and subtract continuum from band max:
        do ib = 1, N_band-1
           hlfw (ib) = ( cent(ib+1)-cent(ib) )/6.
           cont = contin (cent(ib))
           do it = 1, Num_lev
             xmax_t (ib,it) = xmax_t(ib,it) - cont
           enddo
        enddo

        hlfw (N_band) = hlfw (N_band-1)
        cont = contin (cent(N_band))

       do it = 1, Num_lev
           xmax_t (N_band,it) = xmax_t(N_band,it) - cont
        enddo

c       Define wavelength grid for which abs. x-sects are calculated:
        do iw = 1, N_w
           wavel(iw) = 312.+(iw-1.)*0.25
        enddo

c       Calculate abs. band spectrum:
        do it = 1, Num_lev
 101      format ( 2x, i5, 3f8.2 )
          call  Band_sp ( N_band, N_w, cent, hlfw, xmax_t(1,it),
     *                    wavel, xs131(1, it) )
 102      format ( 2x, i5, 2f8.2 )
        enddo

c       Add continuum:

        do iw = 1, N_w
           cont = contin ( wavel(iw) )
           do it = 1, Num_lev
             xs131(iw,it) = 1.E-19*( xs131(iw,it) + cont )
           enddo
        enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, N_w, wavel, Num_beg, Len_X )

        Num_beg = Num_beg+1
ccc       Len_X   = Len_X-1

        do l = Num_beg, Num_beg+Len_X-1
           wb(l) = .5* ( wlt(l-1)+wlt(l) )
        enddo

c      interpolate x-sections at each T to model wlt grid:

         do it = 1, Num_lev
            call  hi_lo_int ( N_w, Len_X, wavel, wb(Num_beg),
     *                xs131(1,it), xs(Num_beg,it) )
         enddo

 2      format ( 2x, 0pf7.2, 1pe10.2 )


 20     format ( 2x, 0pf7.2, 1p4e10.2 )

        end

c =======================================================================

        Subroutine  vCLO_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )

        include 'jpl.par'

        real  wavel (2), xs (Len_t, Num_lev), !'T(Num_lev)' not used GM 1/00
     *        wlt (Len_t)

        data   PI / 3.14159 /

        wavel (1) = 225.
        wavel (2) = 310.

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

        wb = 220.
        we = 310.
        xmax = 5.3e-18

c       Now,  find Num_beg and Len_X ...

        call  find_NL ( Len_t, wlt, 2, wavel, Num_beg, Len_X )

        do l = Num_beg, Num_beg+Len_X-1
           phase = PI*2./(we-wb)*(wlt(l)-wb)
           shape =  sin(phase-PI/2.)
           xs(l,1) = xmax/2.*( 1.+ shape )
           do i = 2, Num_lev
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c ========================================================================

        Subroutine  vOCLO_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *            Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
c       cent   - band centers
c       hlfw   - band halfwidths
c       xmax   - abs. cross-sections at the band max
c
        Parameter  ( N_band = 24, N_w = 392, N_tt = 3 )
        include 'jpl.par'

        real   cent (N_band), hlfw (N_band), xmax (N_tt, N_band),
     *         xm(1), xmax_t(N_band, Nlev), wavel (N_w),
     *         T_t(N_tt), T(Num_lev), xs131 (N_w, Nlev),
     *         xs (Len_t, Num_lev), wlt (Len_t), wb (Len_tm),
     *         xr (N_band)

        character*8  AA

Cgal
      COMMON / XSEC_43 / cent_43 (N_band),
     *                   xmax_43 (N_tt, N_band)
Cgal

c       Function to approx. describe undrlying continuum:
        contin (ww,TT) = (150.+.5*(TT-200.))*
     *                (sin ( 3.14159/210.*(ww-250.) ))**2


c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        T_t (1) = 204.
        T_t (2) = 296.
        T_t (3) = 378.

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'OClO' )
Cgal           read (10,2) AA
Cgal        end do
Cgal
Cgal 2      format ( 2x, A8 )
Cgal
Cgal        read (10,2) AA
Cgal        read (10,2) AA
Cgal
Cgal        read ( 10, * ) ( cent(i), ( xmax(k,i), k = 1,3 ),
Cgal     *                    i = 1, N_band  )
Cgal
Cgal 1      format ( 2x, f7.2, 3f10.4 )

Cgal
      do i=1,N_band
          cent(i) = cent_43(i)
      do k=1,N_tt
        xmax(k,i) = xmax_43(k,i)
      end do
      end do
Cgal

        call  reverse ( N_band, cent )
        do k = 1, N_tt
           do i = 1, N_band
              xr(i) = xmax(k,i)
           enddo
           call reverse ( N_band, xr )
           do i = 1, N_band
              xmax(k,i) = xr(i)
           enddo
         enddo

c       Interpolate max x-sects to the temperatures of the atm. layers:
        do ib = 1, N_band
           do it = 1, Num_lev
              call linoext ( N_tt, 1, T_t, T(it), xmax(1,ib), xm )
              xmax_t(ib,it) = xm(1)
           enddo
 100       format ( 2x, i5, 2f8.2 )

        enddo

c       Calculate band halfwidths and subtract continuum from band max:
        do ib = 1, N_band-1
           hlfw (ib) = ( cent(ib+1)-cent(ib) )/6.
           do it = 1, Num_lev
             cont = contin (cent(ib),T(it))
             xmax_t (ib,it) = xmax_t(ib,it) - cont
           enddo
        enddo

        hlfw (N_band) = hlfw (N_band-1)

       do it = 1, Num_lev
           cont = contin (cent(N_band),T(it))
           xmax_t (N_band,it) = xmax_t(N_band,it) - cont
        enddo

c       Define wavelength grid for which abs. x-sects are calculated:
        do iw = 1, N_w
           wavel(iw) = 269.+(iw-1.)*0.5
        enddo

c       Calculate abs. band spectrum:
        do it = 1, Num_lev
 101      format ( 2x, i5, 3f8.2 )
          call  Band_sp ( N_band, N_w, cent, hlfw, xmax_t(1,it),
     *                    wavel, xs131(1, it) )
 102      format ( 2x, i5, 2f8.2 )
        enddo

c       Add continuum:

        do iw = 1, N_w
           do it = 1, Num_lev
             cont = contin ( wavel(iw),T(it) )
             xs131(iw,it) = 1.E-20*( xs131(iw,it) + cont )
           enddo
        enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, N_w, wavel, Num_beg, Len_X )

         Num_beg = Num_beg+1

        do l = Num_beg, Num_beg+Len_X-1
           wb(l) = .5* ( wlt(l-1)+wlt(l) )
        enddo

c      interpolate x-sections at each T to model wlt grid:

         do it = 1, Num_lev
            call  hi_lo_int ( N_w, Len_X, wavel, wb(Num_beg),
     *                xs131(1,it), xs(Num_beg,it) )
         enddo

 22     format ( 2x, 0pf7.2, 1pe10.2 )

 20     format ( 2x, 0pf7.2, 1p4e10.2 )

        end

c =======================================================================

        Subroutine  vCO2_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_hlf = 42, L_j = L_hlf*4+1  )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) !'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_44 / w_j_44 (L_j),
     *                   x_j_44 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CO2' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( ( w_j((i-1)*4+k), x_j((i-1)*4+k), k=1, 4),
Cgal     *                    i=1, L_hlf )
Cgal       read ( 10, * ) w_j (L_j), x_j (L_j)
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
        w_j(i) =  w_j_44(i)
        x_j(i) =  x_j_44(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c =======================================================================
        Subroutine  vHOBR_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_trd = 31, L_j = L_trd*3-2  )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_45 / w_j_45 (L_j),
     *                   x_j_45 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'HOCl' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (2x,A8)
Cgal        read (10,12) AA
Cgal
Cgal       read ( 10, * ) ( w_j(i), x_j(i),  w_j(i+L_trd),
Cgal     *       x_j(i+L_trd),  w_j(i+2*L_trd-1), x_j(i+2*L_trd-1),
Cgal     *             i = 1, L_trd-1 )
Cgal
Cgal       read ( 10, * ) w_j(L_trd), x_j(L_trd)
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
        w_j(i) =  w_j_45(i)
        x_j(i) =  x_j_45(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
c           Recommendation of Baulch et.al. (1982):
c           shift 30 nm to the red
            w_j(l) = w_j(l) + 30.
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate HOBR x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

c =======================================================================

        Subroutine  vBRCL_X ( Num_lev, T, Len_t, wlt, Num_beg, Len_X,
     *                xs, K_T )
c
c       Notation: same as in  X_SEC
c
        parameter ( L_j = 2, L_cl2 = 211 )
        include 'jpl.par'

        real  w_j (L_j), xs (Len_t, Num_lev), wlt (Len_t),
     *        T (Num_lev)

C  character*8  AA  not used GM 1/00. Victor says the x-section for this
C  species is not read but calculated from analytical parameterization

        x_sect (alf,w) = 1.e-20*sqrt(alf)*( 27.3*exp(-99.*alf*
     *    (alog(329.5/w))**2) + .932*exp(-91.5*alf*(alog(406.5/w))**2) )

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1

        w_j(1)=260.
        w_j(2)=470.

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

c       Recommendation by Dough Kinnison:
c       start with CL2 spectrum, shift 80 nm to the red
c       and multiply by 2
        do l = 1, L_j
           w_j(l) = w_j(l) + 80.
        enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      Now, calculate BrCl x-sections:

         do i = 1, Num_lev
            alf = tanh ( 402.7/T(i) )
            do l = Num_beg, Num_beg+Len_X-1
               xs(l,i) = 2.*x_sect(alf,wlt(l)-80.)
            enddo
         enddo

 20     format ( 2x, 0pf7.2, 1p4e10.2 )

        end

c =======================================================================

        Subroutine  vC2H3FCL2_X (Num_lev,      ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg,Len_X, xs, K_T)
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 16 )
        include 'jpl.par'

        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM 1/00

        character*8  AA

Cgal
      COMMON / XSEC_46 / w_j_46 (L_j),
     *                   x_j_46 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0

        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo

Cgal        do while ( AA .ne. 'CH3CFCl2' )
Cgal           read (10,12) AA
Cgal        end do
Cgal
Cgal 12     format (3x,A8)
Cgal        read (10,12) AA
Cgal
Cgal        read ( 10, * ) ( w_j(i), x_j(i), a,b,c, i = 1, L_j )
Cgal
Cgal 1      format ( 2x, 0pf7.2, 1p3e10.2 )

Cgal
      do i=1,L_j
        w_j(i) =  w_j_46(i)
        x_j(i) =  x_j_46(i)
      end do
Cgal

         do l = 1, L_j
            x_j(l) = x_j(l)*1.E-20
         enddo

c        Now,  find Num_beg and Len_X ...

         call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )

c      interpolate x-sections to model wlt grid:

        call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )

         do i = 2, Num_lev
           do l = Num_beg, Num_beg+Len_X-1
              xs(l,i) = xs(l,1)
           enddo
         enddo

 20     format ( 2x, 0pf7.2, 1pe10.2 )

        end

        Subroutine vOCS_X ( Num_lev, T, Len_t, wlt, Num_beg,
     *            Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 41, NT = 2 )
        include 'jpl.par'

        real  x_j (L_j,NT), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t), T (Num_lev), T_j (NT),
     *        xs_Tj (Len_tm, NT), xsm (NT), xsT (1)
        character*3  AA

Cgal
      COMMON / XSEC_47 / w_j_47 (L_j),
     *                   x_j_47 (L_j,NT)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 1
        T_j (1) = 225.
        T_j (2) = 295.
        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo
Cgal        do while (AA .ne.'OCS')
Cgal           read (10,100)AA
Cgal        end do
Cgal 100    format(8x,A3)
Cgal        read(10,100)AA
Cgal        DO 1 I=1,L_j
Cgal   1       read (10,200)w_j(i),(x_j(i,k),k=2,1,-1 )
Cgal
Cgal 200    format(F5.1,2F8.4)

Cgal
      do i=1,L_j
         w_j(i) =  w_j_47(i)
      do k=1,NT
        x_j(i,k) = x_j_47(i,k)
      end do
      end do
Cgal
C
C        Now,  find Num_beg and Len_X ...
C
        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )
C
C        ...and interpolate x-sections to model wlt grid:
C
        do it = 1, NT
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j(1,it), xs_Tj(Num_beg, it) )
        enddo
C
C   ... and to each temperature:
C
        do l = Num_beg, Num_beg+Len_X-1
            do it = 1, NT
               xsm(it) = xs_Tj(l,it)*1.E-20
            enddo
            do i = 1, Num_lev
              call linoext ( NT, 1, T_j, T(i), xsm, xsT )
              xs(l,i) = xsT(1)
            enddo
        enddo

 20     format ( 2x, 0pf4.0, 1p4e10.2 )
        end
c =======================================================================
        Subroutine  vSO2_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 20 )
        include 'jpl.par'
        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T(Num_lev)' not used GM1/00
        character*8  AA

Cgal
      COMMON / XSEC_48 / w_j_48 (L_j),
     *                   x_j_48 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0
        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo
Cgal        do while ( AA .ne. 'SO2' )
Cgal           read (10,2) AA
Cgal        end do
Cgal 2      format (2x,A8)
Cgal        read (10,2) AA
Cgal        DO 1 I=1,L_j
Cgal   1       read (10,200)w_j(i),x_j(i)
Cgal 200    format(F4.0,F7.2)

Cgal
      do i=1,L_j
        w_j(i) =  w_j_48(i)
        x_j(i) =  x_j_48(i)
      end do
Cgal

        do l = 1, L_j
           x_j(l) = x_j(l)*1.E-20
        enddo
C
C        Now,  find Num_beg and Len_X ...
C
        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )
C
C        ...and interpolate x-sections to model wlt grid:
C
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )
C
C   ... and to each temperature:
C
        do l = Num_beg, Num_beg+Len_X-1
            do i = 2, Num_lev
              xs(l,i) = xs(l,1)
            enddo
        enddo
        end

c =======================================================================
        Subroutine  vSO3_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 68 )
        include 'jpl.par'
        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T (Num_lev)' not used GM1/00
        character*8  AA

Cgal
      COMMON / XSEC_49 / w_j_49 (L_j),
     *                   x_j_49 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0
        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo
Cgal        do while ( AA .ne. 'SO3' )
Cgal           read (10,2) AA
Cgal        end do
Cgal 2      format (2x,A8)
Cgal        read (10,2) AA
Cgal        DO 1 I=1,L_j
Cgal   1       read (10,200)w_j(i),x_j(i)
Cgal 200    format(F4.0,F6.3)

Cgal
      do i=1,L_j
        w_j(i) =   w_j_49(i)
        x_j(i) =   x_j_49(i)
      end do
Cgal

        do l = 1, L_j
           x_j(l) = x_j(l)*1.E-20
        enddo
C
C        Now,  find Num_beg and Len_X ...
C
        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )
C
C        ...and interpolate x-sections to model wlt grid:
C
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )
C
C   ... and to each temperature:
C
        do l = Num_beg, Num_beg+Len_X-1
            do i = 2, Num_lev
              xs(l,i) = xs(l,1)
            enddo
        enddo
        end

c =======================================================================
        Subroutine  vCS2_X ( Num_lev, ! 'T' not used GM 1/00
     *   Len_t, wlt, Num_beg, Len_X, xs, K_T )
c
c       Notation: same as in  X_SEC
c
        Parameter  ( L_j = 11 )
        include 'jpl.par'
        real  x_j (L_j), w_j (L_j),
     *        xs (Len_t, Num_lev), wlt (Len_t) ! 'T (Num_lev)' not used GM1/00
        character*8  AA

Cgal
      COMMON / XSEC_50 / w_j_50 (L_j),
     *                   x_j_50 (L_j)
Cgal

c       Temperature dependance: yes - K_T = 1, no - K_T = 0
        K_T = 0
        do l = 1, Len_t
           do i = 1, Num_lev
              xs(l,i) = 0.
           enddo
        enddo
Cgal        do while ( AA .ne. 'CS2' )
Cgal           read (10,2) AA
Cgal        end do
Cgal 2      format (2x,A8)
Cgal        read (10,2) AA
Cgal        DO 1 I=1,L_j
Cgal   1       read (10,200)w_j(i),x_j(i)
Cgal 200    format(F4.0,F6.1)

Cgal
      do i=1,L_j
        w_j(i) =  w_j_50(i)
        x_j(i) =  x_j_50(i)
      end do
Cgal

        do l = 1, L_j
           x_j(l) = x_j(l)*1.E-20
        enddo
C
C        Now,  find Num_beg and Len_X ...
C
        call  find_NL ( Len_t, wlt, L_j, w_j, Num_beg, Len_X )
C
C        ...and interpolate x-sections to model wlt grid:
C
          call  linterp ( L_j, Len_X, w_j, wlt(Num_beg),
     *                    x_j, xs(Num_beg,1) )
C
C   ... and to each temperature:
C
        do l = Num_beg, Num_beg+Len_X-1
            do i = 2, Num_lev
              xs(l,i) = xs(l,1)
            enddo
        enddo
        end

c ===================================================================

        Subroutine find_NL (Len_t, wlt, Len_jpl, wlt_jpl, Num_beg,
     *                      Len_X)
c
c       Program to define the # of the wavelength where the X
c       photolysis spectrun starts, and the length of the phot. interval

        real   wlt (Len_t), wlt_jpl (Len_jpl)

        wb = wlt_jpl(1)
        do l = 1, Len_t
           if ( wlt(l) .ge. wb ) then
              if ( l .eq. 1 ) then
                 Num_beg = 1
              else if ( wlt(l)-wb .le. wb-wlt(l-1) ) then
                  Num_beg = l
              else
                  Num_beg = l-1
              endif
              goto 5
           endif
        enddo
  5     continue

        we = wlt_jpl(Len_jpl)
        if ( wlt(Len_t) .le. we ) then
                Num_end = Len_t
        else
           do l = Num_beg, Len_t
              if ( wlt(l) .ge. we ) then
                if ( wlt(l)-we .le. we-wlt(l-1) ) then
                    Num_end = l
                else
                    Num_end = l-1
                endif
                goto 6
              endif
           enddo
        endif
  6     continue

        Len_X = Num_end - Num_beg + 1

        end
c =========================================================================

        Subroutine Band_sp ( N_band, N_w, cent, hlfw, xmax, wavel,
     *                        x_sec )

c       Program to calculate absorption x-sections for spectra
c       with the band structure

        real   cent (N_band), hlfw (N_band), xmax (N_band),
     *         wavel (N_w), x_sec (N_w)

        gshape ( dw, hlf, xmx ) = xmx*exp ( -( dw/hlf )**2 )

        do iw = 1, N_w
           xs = 0.
           do ib = 1, N_band
             dw = abs ( wavel(iw)-cent(ib) )
             if ( dw .gt. hlfw(ib)*4. ) goto 1
             xs = xs + gshape ( dw, hlfw(ib), xmax(ib) )
  1          continue
           enddo
           x_sec(iw) = xs
        enddo

        end

c ------------------------------------------------------------
c
      SUBROUTINE REVERSE ( MAXCLY, X )
c
      PARAMETER ( MX = 51 )
      REAL  X(MAXCLY), Y(MX)
c
      DO I = 1, MAXCLY
         Y(I) = X(MAXCLY-I+1)
      ENDDO
c
      DO I = 1, MAXCLY
         X(I) = Y(I)
      ENDDO
c
      END
c
c ----------------------------------------------------
