* PACKAGE YSUN   !"   機種依存ルーチン for Sun Fortran
*
*"  [HIS] 90/05/19(numaguti)
*"        92/06/05(takepiro)
*"        93/07/05(takepiro) Sun fortran デバッグ用関数追加
*
*********************************************************************
      SUBROUTINE ERRTRA !" エラートレースバック
*
*   [INTERNAL WORK] 
      INTEGER    IPID, IRET
*
*   [INTRINSIC FUNC] 
      INTEGER    GETPID
      INTEGER    KILL
*      
      IPID=GETPID()
      IRET=KILL(IPID,5)
*
      RETURN
      END
*********************************************************************
      SUBROUTINE YCLOCP        !" CPU時間を出力
     I         ( HREM   )
*
*   [INPUT] 
      CHARACTER  HREM*(*)                    !" 表題
*
*   [INTERNAL SAVE]  
      REAL       CPUOLD                      !" 前の呼出の経過時間
      REAL       VPUOLD                      !" 前の呼出のユーザ時間
      DATA       CPUOLD, VPUOLD / 0.  , 0.   /
      SAVE
*
*   [INTERNAL WORK] 
      REAL       CPUTIM                      !" 経過時間
      REAL       VPUTIM                      !" ユーザ時間
*
      CALL YCLOCK( CPUTIM, VPUTIM )
      WRITE ( 6,9000 ) HREM, CPUTIM - CPUOLD, VPUTIM - VPUOLD,
     &                       CPUTIM         , VPUTIM
 9000 FORMAT( ' ',A8,': CPU/VPU TIME = ', 2E10.5, ' : ', 2E10.5 )
      CPUOLD = CPUTIM
      VPUOLD = VPUTIM
*
      RETURN
      END
********************************************************************
      SUBROUTINE YCLOCK           !" CPU時間を与える
     O         ( CPUTIM, VPUTIM )
*
*   [OUTPUT] 
      REAL       CPUTIM                      !" 経過時間
      REAL       VPUTIM                      !" ユーザ時間
*
*   [INTERNAL SAVE] 
      REAL       TICKS
      REAL       TICK0, TUSR0                !" スタート
      DATA       TICK0, TUSR0 / 0.  , 0.    /
      SAVE
*
*   [INTERNAL WORK] 
      REAL*4       TARRAY( 2 )
*
*   [INTRINSIC FUNC] 
      REAL*4       ETIME
*
      TICKS  = ETIME( TARRAY )
      CPUTIM = TICKS - TICK0
      VPUTIM = TARRAY( 1 ) - TUSR0
*
      RETURN
*======================================================================
      ENTRY      YCLOCL        !" CPU時間クリアー
*
      TICK0 = ETIME( TARRAY )
      TUSR0 = TARRAY( 1 )
*
      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
            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 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      !" システム前処理
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YFINE      !" システム後処理
*
      RETURN
      END
***********************************************************************
      INTEGER FUNCTION IOSLEV      !" 入出力エラーレベル
     I               ( IOS   )
*
*   [INPUT] 
      INTEGER    IOS
*
      IF ( IOS.EQ.0 ) THEN
         IOSLEV = 0
      ELSE
         IOSLEV = 2
      ENDIF
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YDATE    !" 現在日付(yyyy mm dd)の取得
     O         ( HDATE )
*
*   [OUTPUT] 
      CHARACTER  HDATE  *(*)             !" 日付(yyyy/mm/dd)
*
*   [INTERNAL WORK] 
      INTEGER    IDATE1 ( 3 )            !" 日付(yyyy, mm,  dd)
*
      CALL  IDATE ( IDATE1 )
      IF ( IDATE1(1) .LT. 100 ) IDATE1(1) = IDATE1(1) + 1900

      HDATE = '****/0*/0*'
      WRITE ( HDATE(1:4) , '(I4)'   ) IDATE1(1)
      WRITE ( HDATE(6:7) , '(I2.2)' ) IDATE1(2)
      WRITE ( HDATE(9:10), '(I2.2)' ) IDATE1(3)
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YTIME  !" 現在時刻(hh mm ss)の取得
     O         ( HTIME )
*
*   [OUTPUT] 
      CHARACTER  HTIME  *(*)             !" 時刻(hh:mm:ss)
*
*   [INTERNAL WORK] 
      INTEGER    ITIME1 ( 3 )            !" 時刻(hh, mm, ss)
*
      CALL  ITIME ( ITIME1 )

      HTIME = '0*:0*:0*'
      WRITE ( HTIME(1:2), '(I2.2)' ) ITIME1(1)
      WRITE ( HTIME(4:5), '(I2.2)' ) ITIME1(2)
      WRITE ( HTIME(7:8), '(I2.2)' ) ITIME1(3)
*
      RETURN
      END
***********************************************************************
      integer function common_handler   !"  デバッグ用関数
     &                  (sig,code,sigcontext,addr)
*
      integer sig,code,sigcontext(5)
      integer addr
*
      write (0,10) loc(code), loc(addr)
 10   format ("ieee exception ", z3, " occurred at address ", z8)
      end