* PACKAGE P2RADS !" 物理過程(2) 短波放射
*
***********************************************************************
      SUBROUTINE SHTFLX       !" 短波放射フラックス
     M         ( SFLUX ,
     I           TAUQ  , TAUA  , SECZET,
     C           GRALB                  )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                       !" 格子点数，波数
#else
#include        "zcdim.F"                     !" 格子点数，波数
#endif
*
*   [MODIFY] 
      REAL       SFLUX  ( IDIM*JDIM, KMAX+1 ) !" 短波フラックス
*
*   [INPUT] 
      REAL       TAUQ   ( IDIM*JDIM, KMAX+1 ) !" 光学的厚さ：水
      REAL       TAUA   ( IDIM*JDIM, KMAX+1 ) !" 光学的厚さ：大気
      REAL       SECZET ( IDIM*JDIM )         !" sec(入射角)
      REAL       GRALB  ( IDIM*JDIM )         !" 地表アルベド
*
*   [INTERNAL PARM] 
      INTEGER    NCSHTD
      PARAMETER (NCSHTD = 10)
      INTEGER    NCSHT                        !" 短波バンド数
      REAL       ABSQS  ( NCSHTD )            !" 水の吸収係数
      REAL       ABSAS  ( NCSHTD )            !" 空気の吸収係数
      REAL       RWGTS  ( NCSHTD )            !" バンドウェイト
      REAL       SECSCT                       !" 散乱のsecζ
      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       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
