* PACKAGE USUBS       !" 雑ルーチン
*
*"  [HIS] 90/08/31(numaguti)
*
***********************************************************************
      SUBROUTINE RESET     !" 配列を０リセット
     O         ( DATA  ,
     D           IDIM   )
*
*   [PARAM] 
      INTEGER    IDIM
*
*   [OUTPUT]       
      REAL       DATA ( IDIM )
*
*   [INTERNAL WORK] 
      INTEGER    I
*
      DO 1100 I = 1, IDIM
        DATA ( I ) = 0.  
 1100 CONTINUE
*
*
      RETURN
      END
***********************************************************************
      SUBROUTINE COPY     !" 配列を複写
     O         ( DATAO  ,
     I           DATAI  ,
     D           IDIM     )
*
*   [PARAM]
      INTEGER    IDIM
*
*   [OUTPUT]       
      REAL       DATAO ( IDIM )                !" 出力データ
*
*   [INPUT] 
      REAL       DATAI ( IDIM )                !" 入力データ
*
*   [INTERNAL WORK] 
      INTEGER    I
*
      DO 1100 I = 1, IDIM
        DATAO ( I ) = DATAI ( I )
 1100 CONTINUE
*
      RETURN
      END
***********************************************************************
      SUBROUTINE SETV   !" 配列にスカラー値をセット
     O         ( DATA  ,
     I           VALUE ,
     D           IDIM   )
*
*   [PARAM] 
      INTEGER    IDIM
*
*   [OUTPUT] 
      REAL       DATA ( IDIM )                 !" 配列
*
*   [INPUT] 
      REAL       VALUE                         !" 入力データ
*
*   [INTERNAL WORK] 
      INTEGER    I
*
      DO 1100 I = 1, IDIM
        DATA ( I ) = VALUE
 1100 CONTINUE
*
      RETURN
      END
***********************************************************************
      SUBROUTINE FILLV  !" 配列のある範囲を値で埋める >>
     M         ( DATA  ,
     I           VALUE ,
     D           IMIN  , IMAX  , IDIM  , JMIN  , JMAX  , JDIM  ,
     D           KMIN  , KMAX                                   )
*
*   [PARAM] 
      INTEGER    IDIM
      INTEGER    JDIM
      INTEGER    KMAX
*
*   [MODIFY] 
      REAL       DATA ( IDIM, JDIM, KMAX )   !" 配列データ
*
*   [INPUT] 
      REAL       VALUE                       !" 入力データ
      INTEGER    IMIN                        !" 第１次元始め
      INTEGER    IMAX                        !" 第１次元終り
      INTEGER    JMIN                        !" 第２次元始め
      INTEGER    JMAX                        !" 第２次元終り
      INTEGER    KMIN                        !" 第３次元始め
*
*   [INTERNAL WORK] 
      INTEGER    I, J, K
*
      DO 1100 K = KMIN, KMAX
        DO 1100 J = JMIN, JMAX
          DO 1100 I = IMIN, IMAX
            DATA ( I, J, K ) = VALUE
 1100 CONTINUE
*
*
      RETURN
      END
************************************************************************
      SUBROUTINE MAXMIN      !"  配列の最小値最大値を出力 
     I         ( DATA, IDIM, JDIM, KMAX, IMAX, JMAX, HITEM )
*
*   [PARAM] 
      INTEGER    IDIM
      INTEGER    JDIM
      INTEGER    KMAX
*
*   [INPUT] 
      REAL       DATA( IDIM, JDIM, KMAX )
      INTEGER    IMAX
      INTEGER    JMAX
      CHARACTER  HITEM*(*)                     !" 表題
*
*   [INTERNAL WORK] 
      INTEGER    I, J, K
      INTEGER    IPMIN, JPMIN, KPMIN
      INTEGER    IPMAX, JPMAX, KPMAX
      REAL       DMIN, DMAX
*
      DMIN =  1.E36
      DMAX = -1.E36
*
      DO 1100 K=1,KMAX
        DO 1100 J=1,JMAX
          DO 1100 I=1,IMAX
*
            IF ( DATA( I,J,K ) .LT. DMIN ) THEN
              DMIN = DATA( I,J,K )
              IPMIN = I
              JPMIN = J
              KPMIN = K
            ENDIF
*
            IF ( DATA( I,J,K ) .GT. DMAX ) THEN
              DMAX = DATA( I,J,K )
              IPMAX = I
              JPMAX = J
              KPMAX = K
            ENDIF
*
 1100 CONTINUE
*
      WRITE (6,*) HITEM, ': min = ', DMIN,' at ', IPMIN,JPMIN,KPMIN
      WRITE (6,*) HITEM, ': max = ', DMAX,' at ', IPMAX,JPMAX,KPMAX
*
      RETURN
      END
*********************************************************************
      INTEGER FUNCTION IUNITM  !" 時間単位の変換
     I        ( KT    , HUNIT  , IDELT  )
*
*   [INPUT] 
      INTEGER     KT                          !" 時間(単位HUNIT)
      CHARACTER   HUNIT*(*)                   !" 時間単位
      INTEGER     IDELT                       !" Δｔ
*
*   [INTERNAL WORK] 
      INTEGER    IT
*
      IF      (    ( HUNIT       .EQ. 'STEP' )
     &         .OR.( HUNIT       .EQ. 'step' )  ) THEN
*
*"         < 1. step のとき Δｔを単位 >
*
        IT = KT * IDELT
*
*"         < 2. sec, min, hour, day >
*
      ELSE IF (    ( HUNIT (1:1) .EQ. 'S' )
     &         .OR.( HUNIT (1:1) .EQ. 's' )  ) THEN
        IT = KT
*
      ELSE IF (    ( HUNIT (1:1) .EQ. 'M' )
     &         .OR.( HUNIT (1:1) .EQ. 'm' )  ) THEN
        IT = KT*60
*
      ELSE IF (    ( HUNIT (1:1) .EQ. 'H' )
     &         .OR.( HUNIT (1:1) .EQ. 'h' )  ) THEN
        IT = KT*60*60
*
      ELSE IF (    ( HUNIT (1:1) .EQ. 'D' )
     &         .OR.( HUNIT (1:1) .EQ. 'd' )  ) THEN
        IT = KT*60*60*24
*
      ELSE
*
*"         < 3. それ以外 : 分 >
*
        IT = KT*60
        WRITE (6,*) 'UNIT = ',HUNIT , 'KT = ',KT
        WRITE (6,*) '単位が正しくありません。Ｍ（分）を仮定しました'
      ENDIF
*
      IUNITM = IT
*
      RETURN
      END
***********************************************************************
      INTEGER FUNCTION MALLOC  !" ワーク領域ポインター割り当て
     I        ( LENGTH, IPMAX  )
*
*   [INPUT] 
      INTEGER LENGTH                         !" 割当て長さ
      INTEGER IPMAX                          !" 最大領域
*
*   [INTERNAL SAVE] 
      INTEGER IP                             !" 割当てるポインタ
      INTEGER IPP                            !" 次に割当てるポインタ
      DATA    IPP / 1 /
      SAVE    IPP
*
*   [ENTRY FUNC] 
      INTEGER    MFREE
*
      IF ( LENGTH .LE. 0 ) THEN
         CALL MSGDMP( 'E','MALLOC','ASSIGN LENGTH IS NEGATIVE.')
*
      ELSE
         IP  = IPP
         IPP = IP + LENGTH
         IF ( (IPP-1) .GT. IPMAX ) THEN
            WRITE ( 6,* ) ' **** FURTHER ',  IPP-IPMAX-1,
     &                    ' BYTES AT MINIMUM'
            CALL MSGDMP( 'E','MALLOC','WORK AREA IS NOT ENOUGH.')
         ENDIF
*
C        WRITE ( 6,* ) ' POINTER OK ...', IP
         MALLOC = IP
      ENDIF
*
      RETURN
*======================================================================
      ENTRY MFREE()       !" ワーク領域ポインターリセット
*
      IPP   = 1
      MFREE = 1
*
      RETURN
      END
