!=================================================================
!  一次元 CO2 大気放射対流平衡計算プログラム; 透過関数の計算
!
!  2000/05/09  小高正嗣
!  2000/05/23  小高正嗣; 高速化
!-----------------------------------------------------------------
! ・Goody バンドモデル, ローレンツ線形を仮定
! ・圧力幅を Curtis-Godson 近似で考慮
! ・バンドパラメタは Houghton (1986) より
!   (The physics of atmosphere, 2nd ed., Cambridge Univ. Press)
!=================================================================

      subroutine CLTAUN
     I   ( OPL, SNU, RNU, PRES0,
     O     TAUN,
     C     DELNU,
     D     NZ , NZB, NBND       )

!-----------------------------------------------------------------      
      implicit real*8 ( a-h,o-z )
!-----------------------------------------------------------------      

      dimension 
     \   OPL  (-2:NZB),
     \   SNU  (NBND)  ,
     \   RNU  (NBND)  ,
     \   PRES0(-2:NZB),
     \   TAUN (0:NZ+1,0:NZ+1,NBND)

      parameter ( PSTD = 1.013D+5 )
      parameter ( pi = 3.14159263D0 )
      parameter ( EPSILON = 1.0D-16 )

      do inb = 1, NBND

!-----------------------------------------------------------------      
! 初期化

         
      do iz = 0, NZ+1
         do jz = 0, NZ+1
            TAUN(jz,iz,inb) = 0.0D0
         end do
      end do

      do iz = 0, NZ+1
         TAUN(iz,iz,inb) = 1.0D0
      end do

!-----------------------------------------------------------------      

      do iz = 0, NZ+1
         do jz = iz+1, NZ+1

            PMEAN   = 0.0D0
            OPLMEAN = ABS ( OPL(iz) - OPL(jz) ) 

            do kz = iz, jz-1
               PMEAN = PMEAN + 
     \              PRES0(kz) * ABS ( OPL(kz) - OPL(kz+1) ) / 
     \              MAX( OPLMEAN, EPSILON )
            end do

            W = SNU(inb) * OPLMEAN / DELNU
            S = RNU(inb) * SQRT( OPLMEAN * PMEAN / PSTD * pi ) / DELNU

            TAUN(jz,iz,inb) = 
     \           EXP ( - W * S / SQRT( W**2.0D0 + S**2.0D0 + EPSILON ) )

         end do
      end do

! 上三角成分の計算

      do iz = 0, NZ+1
         do jz = iz+1,NZ+1
            TAUN(iz,jz,inb) = TAUN(jz,iz,inb) 
         end do
      end do

!-----------------------------------------------------------------      

      end do

      return
      end


