* PACKAGE USUBS       
*
*"  [HIS] 90/08/31(numaguti)
*
***********************************************************************
      SUBROUTINE RESET     
     O         ( DATA  ,
     D           IDIM   )
*
*   [PARAM] 
      INTEGER    IDIM
*
*   [OUTPUT]       
      ReaL*8       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*8       DATAO ( IDIM )                
*
*   [INPUT] 
      ReaL*8       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*8       DATA ( IDIM )                 
*
*   [INPUT] 
      ReaL*8       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*8       DATA ( IDIM, JDIM, KMAX )   
*
*   [INPUT] 
      ReaL*8       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*8       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*8       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                          
      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
