* PACKAGE YOSF !" 機種依存ルーチン for HITAC OSF * *" [HIS] 90/05/19(numaguti) *" 95/09/27(takepiro) for HITAC OSF * ********************************************************************* SUBROUTINE ERRTRA !" エラートレースバック * 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 !" ユーザ時間(ダミー) * CALL CLOCK( CPUTIM ) * CALL VCLOCK( VPUTIM ) * RETURN *====================================================================== ENTRY YCLOCL !" CPU時間クリアー * CALL CLOCK * CALL VCLOCK * 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 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 !" システム前処理 * 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] 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