* PACKAGE P2RADS 
*
***********************************************************************
      SUBROUTINE SHTFLX       
     M         ( SFLUX ,
     I           TAUQ  , TAUA  , SECZET,
     C           GRALB                  )
*
*   [PARAM] 




* PACKAGE  ZXT10L32 !" 格子点数，波数 X-Z
*
      INTEGER     IMAX           !" 経度格子数
      INTEGER     JMAX           !" 緯度格子数
      INTEGER     IDIM           !" 経度配列サイズ
      INTEGER     JDIM           !" 緯度配列サイズ
      INTEGER     MMAX           !" 最大東西波数
      INTEGER     LMAX           !" 最大南北波数
      INTEGER     NMAX           !" 最大全波数
      INTEGER     MINT           !" 東西波数間隔
      INTEGER     KMAX           !" 鉛直層数
      INTEGER     KDIM           !" 鉛直配列サイズ
      INTEGER     NMDIM          !" 水平波数成分数
      INTEGER     JMXHF          !" JMAX/2+1
      INTEGER     NWORK          !" ワーク領域大きさ
*
      PARAMETER ( IMAX  = 32,     JMAX =  1,
     &            IDIM  = IMAX+1, JDIM = JMAX,
     &            MMAX  = 10,     LMAX =  0,    NMAX = MMAX, MINT = 1,
     &            KMAX  = 32,     KDIM = KMAX,
     &            NMDIM = (MMAX/MINT+1)*(2*(NMAX+1)-MMAX)
     &                  - (NMAX-LMAX)/MINT*(NMAX-LMAX+1),
     &            JMXHF = JMAX/2+1,
     &            NWORK = IDIM*JDIM*KMAX*12                       )

*
*   [MODIFY] 
      ReaL*8       SFLUX  ( IDIM*JDIM, KMAX+1 ) 
*
*   [INPUT] 
      ReaL*8       TAUQ   ( IDIM*JDIM, KMAX+1 ) 
      ReaL*8       TAUA   ( IDIM*JDIM, KMAX+1 ) 
      ReaL*8       SECZET ( IDIM*JDIM )         
      ReaL*8       GRALB  ( IDIM*JDIM )         
*
*   [INTERNAL PARM] 
      INTEGER    NCSHTD
      PARAMETER (NCSHTD = 10)
      INTEGER    NCSHT                        
      ReaL*8       ABSQS  ( NCSHTD )            
      ReaL*8       ABSAS  ( NCSHTD )            
      ReaL*8       RWGTS  ( NCSHTD )            
      ReaL*8       SECSCT                       
      DATA       NCSHT  / 1 /
      DATA       ABSQS  / 0.002  , 9*0. /
      DATA       ABSAS  / 0.0    , 9*0. /
      DATA       RWGTS  / 1.00   , 9*0. /
      DATA       SECSCT / 1.66   /
*
      NAMELIST  /NMRADS/ NCSHT , ABSQS , ABSAS , RWGTS , SECSCT
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE
*
*   [INTERNAL WORK] 
      INTEGER    IJ, K, IC
      INTEGER    IFPAR, JFPAR
      ReaL*8       SUMWGS
*
*   [ONCE] 
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' SHORTWAVE RADIATION N-BAND P2.2 DATE=91/06/22'
         OFIRST = .FALSE.
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMRADS, END=190 )
  190    WRITE  ( JFPAR, NMRADS )
         SUMWGS = 0.  
*
         DO 210 IC = 1, NCSHT
            SUMWGS = SUMWGS + RWGTS( IC )
  210    CONTINUE
         DO 220 IC = 1, NCSHT
            RWGTS( IC ) =  RWGTS( IC ) / SUMWGS
  220    CONTINUE
      ENDIF
*
*
      CALL RESET ( SFLUX, IDIM*JDIM*KMAX )
*
      DO 1100 IC = 1, NCSHT
         DO 1110 K = 1, KMAX+1
            DO 1120 IJ = 1, IDIM*JDIM
*
*"         < 1. 各レベルでの下向き透過 >
*
               IF ( K .NE. KMAX+1 ) THEN
                  SFLUX( IJ,K )
     &          = SFLUX( IJ,K )
     &            + RWGTS ( IC ) * SFLUX( IJ,KMAX+1 )
     &               * EXP( - SECZET(IJ)
     &                         * (   ABSQS(IC)*TAUQ( IJ,K )
     &                             + ABSAS(IC)*TAUA( IJ,K ) )
     &                    )
                ENDIF
*
*"         < 2. 各レベルでの上向き透過 >
*
                  SFLUX( IJ,K )
     &          = SFLUX( IJ,K )
     &            - RWGTS ( IC ) * SFLUX( IJ,KMAX+1 )
     &               * EXP( - SECZET(IJ)
     &                         * (   ABSQS(IC)*TAUQ( IJ,1 )
     &                             + ABSAS(IC)*TAUA( IJ,1 ) )
     &                    )
     &               * GRALB( IJ )
     &               * EXP( - SECSCT
     &                        *(  ABSQS(IC)*(   TAUQ( IJ,1 )
     &                                        - TAUQ( IJ,K )  )
     &                          + ABSAS(IC)*(   TAUA( IJ,1 )
     &                                        - TAUA( IJ,K )  )  )
     &                   )
*
 1120       CONTINUE
 1110    CONTINUE
 1100 CONTINUE
*
*"         < 3. 吸収なしのとき >
*
      IF ( NCSHT .EQ. 0 ) THEN
         DO 3100 K = 1, KMAX+1
            DO 3110 IJ = 1, IDIM*JDIM
               SFLUX( IJ,K ) = ( 1.  - GRALB( IJ ) ) 
     &                        * SFLUX( IJ,KMAX+1 )
 3110       CONTINUE
 3100    CONTINUE
      ENDIF
*
      RETURN
      END
