* PACKAGE YHITAC  !"  機種依存ルーチン for HITAC M-880
*
*"  [HIS] 90/05/19(numaguti)
*
*********************************************************************
*    SUBROUTINE ERRTRA !" エラートレースバック
*   [INTRINSIC FUNC] 
*********************************************************************
      SUBROUTINE YCLOCP        !" CPU時間を出力
     I         ( HREM   )
*
*   [OUTPUT] 
      CHARACTER  HREM*(*)                    !" 表題
*
*   [INTERNAL SAVE] 
      REAL       CPUOLD                      !" 前の呼出のCPU時間
      DATA       CPUOLD / 0.   /
      SAVE
*
*   [INTERNAL WORK] 
      REAL       CPUTIM                      !" スカラー時間
      REAL       VPUTIM                      !" ベクトル時間
*
      CALL YCLOCK( CPUTIM, VPUTIM )
      WRITE ( 6,9000 ) HREM, CPUTIM - CPUOLD,
     &                       CPUTIME
 9000 FORMAT( ' ',A8,': CPU TIME = ', E10.5, ' : ', E10.5 )
      CPUOLD = CPUTIM
*
      RETURN
      END
********************************************************************
      SUBROUTINE YCLOCK           !" CPU時間を与える
     O         ( CPUTIM, VPUTIM )
*
*   [OUTPUT] 
      REAL       CPUTIM                      !" スカラー時間
      REAL       VPUTIM                      !" ベクトル時間
*
      CALL XCLOCK ( CPUTIM, 5 )
      VPUTIM = 0.
*
      RETURN
*======================================================================
      ENTRY      YCLOCL        !" CPU時間クリアー
*
*"     << CPU時間クリアー >>
*
      CALL XCLOCK
*
      RETURN
      END
***********************************************************************
      SUBROUTINE MKFILN  !" ファイル名 HCH を HREP に置き換え / -> .  
     M         ( HFILE ,
     I           HCH   , HREP    )
*
*   [MODIFY] 
      CHARACTER  HFILE  *(*)
*
*   [INPUT] 
      CHARACTER  HCH    *1
      CHARACTER  HREP   *(*)
*
*   [INTERNAL WORK] 
      INTEGER    NFILN
      PARAMETER (NFILN=38)
      CHARACTER  HFILX  *(NFILN)
      INTEGER    NFILE, NREP, I, II
*
*   [EXTERNAL FUNC] 
      INTEGER    LENC
*
      HFILX = HFILE
      HFILE = ' '
      NREP  = LENC( HREP )
      NFILE = LEN ( HFILE )
      II    = 1
*
      DO 1100 I = 1, MIN( NFILE, NFILN )
         IF ( II .GT. NFILE ) GOTO 1200
         IF      ( HFILX(I:I) .EQ. HCH ) THEN
            HFILE(II:II+NREP-1) = HREP(1:NREP)
            II = II + NREP
         ELSE IF ( HFILX(I:I) .EQ. '/' ) THEN
            HFILE(II:II) = '.'
            II = II + 1
         ELSE
            HFILE(II:II) = HFILX(I:I)
            II = II + 1
         ENDIF
 1100 CONTINUE
 1200 CONTINUE
*
      RETURN
      END
***********************************************************************
      SUBROUTINE REWNML         !" NAMELISTファイル, 入力巻き戻し
     O         ( IFILE, JFILE )
*
*   [OUTPUT] 
      INTEGER    IFILE
      INTEGER    JFILE
*
*   [INTERNAL SAVE] 
      INTEGER    IFILEZ, JFILEZ
      DATA       IFILEZ / 5 /
      DATA       JFILEZ / 6 /
      SAVE
*
      REWIND ( IFILEZ, ERR = 1999 )
      IFILE = IFILEZ
      JFILE = JFILEZ
      RETURN
*
 1999 IF ( IFILEZ .EQ. 5 ) THEN
         CALL MSGDMP( 'W','REWNML','UNIT 5 MAY BE A STANDARD INPUT' )
         IFILE = IFILEZ
         JFILE = JFILEZ
      ELSE
         CALL MSGDMP( 'E','REWNML','ERROR IN REWINDING' )
*        STOP
      ENDIF
*
      RETURN
*======================================================================
      ENTRY      SETNML         !"  NAMELIST入出力ファイルセット
     I         ( IFILE, JFILE )
*
      IFILEZ = IFILE
      JFILEZ = JFILE
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YPREP      !" システム前処理
*
      CALL ERRSET ( 188, 50, 50, 0 )
      CALL ERRSET ( 194, 50, 50, 0 )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YFINE      !" システム後処理
*
      RETURN
      END
***********************************************************************
      INTEGER FUNCTION IOSLEV      !" 入出力エラーレベル
     I               ( IOS   )
*
*   [INPUT] 
      INTEGER    IOS
*
      IF ( IOS.EQ.0 ) THEN
         IOSLEV = 0
      ELSE IF ( IOS .EQ. 226 ) THEN
         IOSLEV = 1
      ELSE
         IOSLEV = 2
      ENDIF
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YDATE    !" 現在日付(yyyy mm dd)の取得
     O         ( HDATE )
*
*   [OUTPUT] 
      CHARACTER  HDATE  *(*)             !" 日付(yyyy/mm/dd)
*
*   [INTERNAL WORK] 
      CHARACTER  HDATE1 *12
*
      HDATE = '19'
      CALL  DATE ( HDATE1 )
      HDATE(3:10) = HDATE1(1:8)
      HDATE(5:5)  = '/'
      HDATE(8:8)  = '/'
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YTIME  !" 現在時刻(hh mm ss)の取得
     O         ( HTIME )
*
*   [OUTPUT] 
      CHARACTER  HTIME  *(*)             !" 時刻(hh:mm:ss)
*
*   [INTERNAL WORK] 
      CHARACTER  HTIME1 *12
*
      CALL  CLOCK( HTIME1, 1 )
      HTIME = HTIME1(1:8)
      HTIME(3:3) = ':'
      HTIME(6:6) = ':'
*
      RETURN
      END
