* PACKAGE GUNENV              " $@%Q%9L>$r4D6-JQ?t$GCV49(J
*
*"  [HIS] 92/09/20(numaguti)
*"        95/05/29(takepiro) by dcl-5.0
*
***********************************************************************
      SUBROUTINE GUNENV                      !" $@%Q%9L>4D6-JQ?tCV49(J
     M         ( HFILE ,
     I           HDEFEV, OMESG  )
*
*   [MODIFY] 
      CHARACTER  HFILE  *(*)          !" $@%Q%9L>(J
      CHARACTER  HDEFEV *(*)          !" $@4D6-JQ?t%G%U%)%k%H(J
      LOGICAL    OMESG                !" $@%a%C%;!<%8%U%i%0(J
*
*   [INTERNAL WORK] 
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HFILX  *(NFILN)
*
      NFILE = LEN( HFILE )
      IF ( HFILE(1:2) .EQ. '~/' ) THEN
         HFILX = '$HOME/'//HFILE(3:NFILE)
      ELSE
         HFILX = HFILE
      ENDIF
*
      CALL GURENV
     M   ( HFILX ,
     I     HDEFEV, OMESG  )
*
      IF ( HFILX(1:2) .EQ. './' ) THEN
         HFILE = HFILX(3:NFILN)
      ELSE
         HFILE = HFILX
      ENDIF
*
      RETURN
      END
***********************************************************************
      SUBROUTINE GURENV                      !" $@4D6-JQ?tCV49(J
     M         ( HFILE ,
     I           HDEFEV, OMESG  )
*
*   [MODIFY] 
      CHARACTER  HFILE  *(*)          !" $@%Q%9L>(J
      CHARACTER  HDEFEV *(*)          !" $@4D6-JQ?t%G%U%)%k%H(J
      LOGICAL    OMESG                !" $@%a%C%;!<%8%U%i%0(J
*
*   [INTERNAL WORK] 
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HFILX  *(NFILN)
      INTEGER    NFNAM, NFILE, I, II, IE, NENV, IEN
      CHARACTER  HCQUO, HCENV
      DATA       HCQUO, HCENV / '"', '$' /
      CHARACTER  HENVN  *(NCC)
      CHARACTER  HENVV  *(NFILN)
      CHARACTER  HMSG   *100
*
*   [EXTERNAL FUNC] 
      INTEGER    LENC
*
      NFILE = LEN ( HFILE )
      HFILX = HFILE
      HFILE = ' '
      NFNAM = LENC( HFILX )
      I     = 1
      II    = 1
*
 1100 CONTINUE 
         IF      ( HFILX(I:I) .EQ. HCQUO ) THEN
            I = I + 1
         ELSE IF ( HFILX(I:I) .EQ. HCENV ) THEN
            HENVN = ' '
            DO 1200 IE = I+1, NFNAM
               IF ( ((HFILX(IE:IE) .LT. 'A') .OR.
     &               (HFILX(IE:IE) .GT. 'Z')) .AND.
     &               (HFILX(IE:IE) .NE. '_')       ) THEN
                  IF ( IE .GT. I+1 ) THEN
                     HENVN = HFILX(I+1:IE-1)
                  ENDIF
                  I = IE
                  GOTO 1300
               ENDIF
 1200       CONTINUE 
            HENVN = HFILX(I+1:NFNAM)
            I = NFNAM+1
*
 1300       CONTINUE 
            CALL GUGENV ( HENVN, HENVV )
            IF ( HENVV .NE. ' ' ) THEN
               NENV = LENC( HENVV )
               IEN  = MIN( II+NENV-1, NFILE )
               HFILE(II:IEN) = HENVV
               II = IEN+1
            ELSE 
               IF ( OMESG ) THEN
                  NENV = LENC( HENVN )
                  HMSG = 'ENVIRONMENT VARIABLE '//
     &                       HENVN(1:NENV)//' IS NOT DEFINED'
                  CALL MSGDMP( 'W','MKFILN',HMSG )
               ENDIF 
               IF ( HDEFEV .NE. ' ' ) THEN
                  NENV = LENC( HDEFEV )
                  IEN  = MIN( II+NENV-1, NFILE )
                  HFILE(II:IEN) = HDEFEV
                  II = IEN+1
               ENDIF
            ENDIF
         ELSE
            HFILE(II:II) = HFILX(I:I)
            I  = I + 1
            II = II + 1
         ENDIF
      IF ( (I. LE. NFNAM) .AND. (II .LE. NFILE) ) GOTO 1100
*
      RETURN
      END
***********************************************************************
      SUBROUTINE GUGENV                      !" $@4D6-JQ?t<hF@(J
     I         ( HENAME ,
     O           HEVAL    )
*
      CHARACTER  HENAME *(*)
      CHARACTER  HEVAL  *(*)
*
#ifdef SYS_IBMS
      CALL SGPGET('IUNIT',IUNIT)
      OPEN (IUNIT,FILE=HENAME,ACCESS='READ',IOSTAT=IOS)
      IF ( IOS .EQ. 0 ) THEN
         READ (IUNIT,'(A)') HEVAL
         CLOSE (IUNIT)
      ELSE
         HEVAL = ' '
      ENDIF
#else
      CALL OSGENV ( HENAME, HEVAL )
#endif
*
      RETURN
      END
