* PACKAGE YSUN   !"   $B5!<o0MB8%k!<%A%s(B for FACOM UXP/VP Fortran
*
*"  [HIS] 90/05/19(numaguti)
*"        96/02/01(takepiro)
*
*********************************************************************
      SUBROUTINE ERRTRA !" $B%(%i!<%H%l!<%9%P%C%/(B
*
      CALL ABORT
*
      RETURN
      END
*********************************************************************
      SUBROUTINE YCLOCP        !" CPU$B;~4V$r=PNO(B
     I         ( HREM   )
*
*   [INPUT] 
      CHARACTER  HREM*(*)                    !" $BI=Bj(B
*
*   [INTERNAL SAVE]  
#ifdef AUTO_DBL
      REAL*8     CPUOLD                      !" $BA0$N8F=P$N7P2a;~4V(B
      REAL*8     VPUOLD                      !" $BA0$N8F=P$N%f!<%6;~4V(B
#else
      REAL       CPUOLD                      !" $BA0$N8F=P$N7P2a;~4V(B
      REAL       VPUOLD                      !" $BA0$N8F=P$N%f!<%6;~4V(B
#endif
      DATA       CPUOLD, VPUOLD / 0.  , 0.   /
      SAVE
*
*   [INTERNAL WORK] 
#ifdef AUTO_DBL
      REAL*8     CPUTIM                      !" $B7P2a;~4V(B
      REAL*8     VPUTIM                      !" $B%f!<%6;~4V(B
#else
      REAL       CPUTIM                      !" $B7P2a;~4V(B
      REAL       VPUTIM                      !" $B%f!<%6;~4V(B
#endif
*
      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$B;~4V$rM?$($k(B
     O         ( CPUTIM, VPUTIM )
*
*   [OUTPUT] 
#ifdef AUTO_DBL
      REAL*8     CPUTIM                      !" $B7P2a;~4V(B
      REAL*8     VPUTIM                      !" $B%f!<%6;~4V(B
#else
      REAL       CPUTIM                      !" $B7P2a;~4V(B
      REAL       VPUTIM                      !" $B%f!<%6;~4V(B
#endif
*
*   [INTERNAL SAVE] 
#ifdef AUTO_DBL
      REAL*8     TICKS
      REAL*8     TICK0, TUSR0                !" $B%9%?!<%H(B
#else
      REAL       TICKS
      REAL       TICK0, TUSR0                !" $B%9%?!<%H(B
#endif
      DATA       TICK0, TUSR0 / 0.  , 0.    /
      SAVE
*
*   [INTERNAL WORK] 
      REAL*4       TARRAY( 2 )       !" *4 $B$KJQ99(B by takepiro 92/06/15
*
*   [INTRINSIC FUNC] 
      REAL*4       ETIME             !" *4 $B$KJQ99(B by takepiro 92/06/15
*
      TICKS  = ETIME( TARRAY )
      CPUTIM = TICKS - TICK0
      VPUTIM = TARRAY( 1 ) - TUSR0
*
      RETURN
*======================================================================
      ENTRY      YCLOCL        !" CPU$B;~4V%/%j%"!<(B
*
      TICK0 = ETIME( TARRAY )
      TUSR0 = TARRAY( 1 )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE MKFILN      !" $B%U%!%$%kL>(B HCH $B$r(B HREP $B$KCV$-49$((B
     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$B%U%!%$%k(B, $BF~NO4,$-La$7(B
     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$BF~=PNO%U%!%$%k%;%C%H(B
     I         ( IFILE, JFILE )
*
      IFILEZ = IFILE
      JFILEZ = JFILE
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YPREP      !" $B%7%9%F%`A0=hM}(B
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YFINE      !" $B%7%9%F%`8e=hM}(B
*
      RETURN
      END
***********************************************************************
      INTEGER FUNCTION IOSLEV      !" $BF~=PNO%(%i!<%l%Y%k(B
     I               ( IOS   )
*
*   [INPUT] 
      INTEGER    IOS
*
      IF ( IOS.EQ.0 ) THEN
         IOSLEV = 0
      ELSE
         IOSLEV = 2
      ENDIF
*
      RETURN
      END
***********************************************************************
      SUBROUTINE YDATE    !" $B8=:_F|IU(B(yyyy mm dd)$B$N<hF@(B
     O         ( HDATE )
*
*   [OUTPUT] 
      CHARACTER  HDATE  *(*)             !" $BF|IU(B(yyyy/mm/dd)
*
*   [INTERNAL WORK] 
      INTEGER    IDATE1 ( 3 )            !" $BF|IU(B(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  !" $B8=:_;~9o(B(hh mm ss)$B$N<hF@(B
     O         ( HTIME )
*
*   [OUTPUT] 
      CHARACTER  HTIME  *(*)             !" $B;~9o(B(hh:mm:ss)
*
*   [INTERNAL WORK] 
      INTEGER    ITIME1 ( 3 )            !" $B;~9o(B(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
