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