* PACKAGE ASETS  !" 共通 定数(σ座標値)
*
*"  [HIS] 90/05/19(numaguti)
*"        92/11/09(takepiro)
*
***********************************************************************
      SUBROUTINE SETSIG      !"  σレベル 
     O         ( SIG   , DSIG  , HASIG ,
     O           SIGM  , DSIGM , HASIGM,
     D           KMAX  , KDIM            )
*
*"               (*  Arakawa & Suarez 鉛直差分 σ座標 *)
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zccom.F"                    !" 標準物理定数
#endif
      INTEGER    KMAX,  KDIM
*
*   [OUTPUT] 
      REAL       SIG   ( KDIM )              !" σレベル(整数)
      REAL       SIGM  (KDIM+1)              !" σレベル(半整数)
      REAL       DSIG  ( KDIM )              !" Δσ(整数)
      REAL       DSIGM (KDIM+1)              !" Δσ(半整数)
      CHARACTER  HASIG  *(*)                 !" 鉛直軸名称：整数
      CHARACTER  HASIGM *(*)                 !" 鉛直軸名称：半整数
*
*    [INTERNAL WORK]    
      REAL       AKAPPA                      !" κ= Ｒ／Ｃp
      INTEGER    K
*
*"         < 1. σ(半整数) >
*
      CALL SETSGM
     O         ( SIGM  , HASIG , HASIGM ,
     I           KMAX                    )
*
*"         < 2. σ, Δσの計算 >
*
      AKAPPA = RAIR / CP
*
      DO 3100 K = 1 , KMAX
*
        DSIG  ( K ) =   SIGM ( K ) - SIGM ( K+1 )
*
        SIG   ( K ) = (    (   SIGM ( K   )**( 1. + AKAPPA )
     &                       - SIGM ( K+1 )**( 1. + AKAPPA )  )
     &                   / (   DSIG ( K ) *  ( 1. + AKAPPA )  )
     &                 )
     &                  **( 1. /AKAPPA )
*
 3100 CONTINUE
*
      DO 3200 K = 2, KMAX
        DSIGM ( K ) = SIG ( K-1 ) - SIG ( K )
 3200 CONTINUE
      DSIGM ( 1      ) = SIGM( 1    ) - SIG ( 1      )
      DSIGM ( KMAX+1 ) = SIG ( KMAX ) - SIGM( KMAX+1 )
*
      RETURN
      END
************************************************************************
*"         << σレベル(半整数) >>
************************************************************************
      SUBROUTINE SETSGM
     O         ( SIGMX , HASIGX , HASIMX,
     I           KMAX                     )
*
*   [PARAM] 
      INTEGER    KMAX
*
*   [OUTPUT] 
      REAL       SIGMX (KMAX+1)              !" σレベル(半整数)
      CHARACTER  HASIGX *(*)                 !" 第3軸名称：整数
      CHARACTER  HASIMX *(*)                 !" 第3軸名称：半整数
*
*   [INTERNAL WORK] 
#ifdef SYS_IBMS
      INCLUDE   (ZHDIM)
#else
#include        "zhdim.F"
#endif
      INTEGER    KDIMD
      PARAMETER ( KDIMD=100 )
      REAL       SIGM  ( KDIMD )
*
*    [INTERNAL PARAM]
      INTEGER    KM1, KM2, KM5, KM12, KM16, KM23, KM45
*
      SAVE
*
      PARAMETER  ( KM1=1 )
      REAL       SIGM1 ( KM1+1 )
      DATA       SIGM1 / 1.000  , 0.000   /
      PARAMETER  ( KM2=2 )
      REAL       SIGM2 ( KM2+1 )
      DATA       SIGM2 / 1.000  , 0.500  , 0.000 /
      PARAMETER  ( KM5= 5 )
      REAL       SIGM5 ( KM5+1 )
      DATA       SIGM5 / 1.000, 0.800, 0.600, 0.300,
     &                   0.150,
     &                   0.000                /
      PARAMETER  ( KM12=12 )
      REAL       SIGM12 ( KM12+1 )
      DATA       SIGM12/ 1.000  , 0.990  , 0.970  , 0.930  , 0.850  ,
     &                   0.750  , 0.630  , 0.500  , 0.360  , 0.220  ,
     &                   0.100  , 0.050  , 0.000                    /
      PARAMETER  ( KM16=16 )
      REAL       SIGM16 ( KM16+1 )
      DATA       SIGM16/ 1.000  , 0.990  , 0.970  , 0.930  , 0.870  ,
     &                   0.790  , 0.700  , 0.600  , 0.500  , 0.410  ,
     &                   0.330  , 0.260  , 0.200  , 0.150  , 0.100  ,
     &                   0.050  , 0.000                             /
      PARAMETER  ( KM23=23 )
      REAL       SIGM23 ( KM23+1 )
      DATA       SIGM23/ 1.000  , 0.990  , 0.980  , 0.965  , 0.945  ,
     &                   0.920  , 0.890  , 0.850  , 0.800  , 0.740  ,
     &                   0.650  , 0.550  , 0.450  , 0.360  , 0.300  ,
     &                   0.260  , 0.220  , 0.180  , 0.150  , 0.120  ,
     &                   0.090  , 0.060  , 0.030  , 0.000           /
      PARAMETER  ( KM45=45 )
      REAL       SIGM45 ( KM45+1 )
      DATA       SIGM45/ 1.000, 0.990, 0.970, 0.930, 0.870,
     &                   0.790, 0.700, 0.600, 0.500, 0.410,
     &                   0.330, 0.260, 0.200, 0.150, 0.100,
     &                  0.861E-01,0.741E-01,0.638E-01,0.549E-01,
     &                  0.472E-01,0.407E-01,0.350E-01,0.301E-01,
     &                  0.259E-01,0.223E-01,0.192E-01,0.165E-01,
     &                  0.142E-01,0.122E-01,0.105E-01,0.907E-02,
     &                  0.781E-02,0.672E-02,0.578E-02,0.498E-02,
     &                  0.429E-02,0.369E-02,0.317E-02,0.273E-02,
     &                  0.235E-02,0.202E-02,0.174E-02,0.150E-02,
     &                  0.129E-02,0.111E-02, 0.000             /
*
      CHARACTER  HASIG1 *(NCC)
      DATA       HASIG1 / 'CSIG'  /
*
      WRITE ( 6,* ) 
     &     ' SIGMA LEVEL CSIG A2.1 MODIFIED BY TAKE. DATE=92/11/09'
*
*"         < 1. デフォルト値 >
*
      IF      ( KMAX .EQ. KM1 ) THEN
         CALL COPY  ( SIGM, SIGM1, KM1+1 )
      ELSE IF ( KMAX .EQ. KM2 ) THEN
         CALL COPY  ( SIGM, SIGM2, KM2+1 )
      ELSE IF ( KMAX .EQ. KM5 ) THEN
         CALL COPY  ( SIGM, SIGM5, KM5+1 )
      ELSE IF ( KMAX .EQ. KM12 ) THEN
         CALL COPY  ( SIGM, SIGM12, KM12+1 )
      ELSE IF ( KMAX .EQ. KM16 ) THEN
         CALL COPY  ( SIGM, SIGM16, KM16+1 )
      ELSE IF ( KMAX .EQ. KM23 ) THEN
         CALL COPY  ( SIGM, SIGM23, KM23+1 )
      ELSE IF ( KMAX .EQ. KM45 ) THEN
         CALL COPY  ( SIGM, SIGM45, KM45+1 )
      ELSE
         CALL MSGDMP( 'E', 'SETSGM', 'LEVEL NOT DEFINED' )
      ENDIF
*
      CALL       SETSIX
     M         ( SIGM  ,
     O           HASIGX, HASIMX,
     I           HASIG1, KMAX   )
*
      CALL COPY ( SIGMX, SIGM, KMAX+1 )
*
      RETURN
*--------------------------------------------------------------------
      ENTRY      STNSIG
     O         ( HASIGX, HASIMX ,
     I           KMAX             )
*
      CALL       SETSIX
     M         ( SIGM  ,
     O           HASIGX, HASIMX,
     I           HASIG1, KMAX   )
*
      RETURN
      END
*====================================================================
      SUBROUTINE SETSIX
     M         ( SIGMY ,
     O           HASIGX, HASIMX,
     I           HASIG1, KMAX   )
*
*   [PARAM] 
      INTEGER    KMAX
*
*   [MODIFY] 
      REAL       SIGMY ( * )
*
*   [OUTPUT] 
      CHARACTER  HASIGX *(*)                 !" 第3軸名称：整数
      CHARACTER  HASIMX *(*)                 !" 第3軸名称：半整数
*
*   [INPUT] 
      CHARACTER  HASIG1 *(*)                 !" 第3軸名称
*
*   [INTERNAL PARM] 
#ifdef SYS_IBMS
      INCLUDE   (ZHDIM)
#else
#include        "zhdim.F"
#endif
      INTEGER    KDIMD
      PARAMETER ( KDIMD=100 )
      CHARACTER  HASIG  *(NCC)
      CHARACTER  HASIGM *(NCC)
      REAL       SIGM  ( KDIMD )
*
      NAMELIST  /NMSIGM/ SIGM, HASIG , HASIGM
*
      CHARACTER  HASI0Z *(NCC)
      CHARACTER  HNUM   *(NCC)
*
*    [INTERNAL WORK]
      INTEGER    INUM, IAZ, K, IFPAR, JFPAR
*
*    [EXTERNAL FUNC]
      INTEGER    LENC
*
*"         < 1. 名称セット >
*
      CALL GULCHR
     I     ( '(I4)', KMAX  ,
     O       HNUM  , INUM   )
*
      HASI0Z = HASIG1
*
      IAZ    = LENC( HASI0Z )
      HASIG  = HASI0Z(1:IAZ)//HNUM(1:INUM)//'.P'
      HASIGM = HASI0Z(1:IAZ)//HNUM(1:INUM)//'.M'
*
*"         < 2. NAMELIST 読み込み >
*
      DO 2100 K = 1, KMAX
         SIGM( K ) = SIGMY( K )
 2100 CONTINUE    
*
      WRITE ( 6,* ) ' CONTROL PARAMETER NMSIGM: '
*
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMSIGM, END=2190 )
 2190 WRITE  ( JFPAR, NMSIGM )
*
      HASIGX = HASIG
      HASIMX = HASIGM
*
      DO 2900 K = 1, KMAX
         SIGMY( K ) = SIGM( K )
 2900 CONTINUE    
*
      RETURN
      END
