*"表題 ファイルのオープン GTOOL3(GFOPEN)
*
*"履歴 90/08/31 沼口  敦
*"     90/09/06 沼口  敦
*"     92/09/19 沼口  敦   環境変数対応
*"     96/06/22 竹広真一   IBM AIX fortran open 文への対応
*"                         FUJITSU SUN fortran open 文への対応
*
*
************************************************************************
*"      << ファイルのオープン >>
************************************************************************
      SUBROUTINE GFOPEN
     O         ( IFILE , IERR  ,
     I           HFILX , IFILED, HACT  , HFORM   )
*
      INTEGER    IFILE                       !" 装置番号
      INTEGER    IERR                        !" エラー≠０
      CHARACTER  HFILX *(*)                  !" ファイル名
      INTEGER    IFILED                      !" デフォルト装置番号
      CHARACTER  HACT  *(*)                  !" 読み／書き
      CHARACTER  HFORM *(*)                  !" フォーマット
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                    !" NCC, NDC
#else
#include         "gzsize.F"                  !" NCC, NDC
#endif
      LOGICAL    OEXIST, OPEND, OPENDX
      CHARACTER  HMSG   *50
      CHARACTER  HFILE  *(NFILN)
*
      HFILE = HFILX
      CALL GUNENV( HFILE, '.', .FALSE. )
*
      IF      ( HFILE .EQ. ' ' ) THEN
         IERR  = 0
         IFILE = 0
         RETURN
*
      ELSE IF  ( HFILE .EQ. '.' ) THEN
         CALL MSGDMP ( 'W', 'GFOPEN', 
     &                'INVALID FILE NAME: POSSIBLY ENV.VAR. MISMATCH' )
         IERR  = 0
         IFILE = 0
         RETURN
*
      ELSE IF ( ( HFILE(1:1).GE.'1' ).AND.( HFILE(1:1).LE.'9' ) ) THEN
         IERR  = 0
         IF ( LENC(HFILE) .EQ. 1 ) THEN
            READ ( HFILE(1:1), '(I1)' ) IFILE
         ELSE
            READ ( HFILE(1:2), '(I2)' ) IFILE
         ENDIF
         RETURN
*
      ELSE IF ( HFILE .EQ. 'CON' ) THEN
         IERR  = 0
         IF ( HACT .EQ. 'READ' ) THEN
            IFILE = 5
         ELSE
            IFILE = 6
         ENDIF
         RETURN
      ENDIF
*
      INQUIRE ( FILE=HFILE  , IOSTAT=IERR, EXIST=OEXIST,
     &          OPENED=OPEND, NUMBER=IFILE               )
*
      IF ( ( .NOT. OEXIST ).AND.( HACT.EQ.'READ' ) ) THEN
         HMSG = 'FILE '//HFILE//' NOT FOUND'
         CALL MSGDMP( 'W', 'GFOPEN', HMSG )
         IERR  = 1
         IFILE = 0
         RETURN
      ENDIF
*
      IF ( .NOT. OPEND ) THEN
         IFILE  = IFILED
         ICOUNT = 0
 2100    CONTINUE
            ICOUNT = ICOUNT + 1
*
            INQUIRE ( UNIT=IFILE, OPENED=OPENDX )
            IF ( OPENDX ) THEN
               IFILE = IFILE+1
               IF ( IFILE .GE. 100 ) IFILE=IFILE-90
               IF ( ICOUNT .GT. 90 ) THEN
                  HMSG = 'I/O UNIT FULL'
                  CALL MSGDMP( 'W', 'GFOPEN', HMSG )
                  IERR = 1
                  RETURN
*
               ENDIF
               GOTO 2100
            ENDIF
*
#ifdef SYS_IBMS
#define NOAPPEND
#endif
*
#ifdef SYS_IBMAIX
#define NOAPPEND
#endif
*
#ifdef SYS_FSun
#define NOAPPEND
#endif
*
#ifdef NOAPPEND
            OPEN ( UNIT=IFILE , FILE=HFILE, IOSTAT=IERR,
     &                ACTION=HACT, FORM=HFORM,
     &                ACCESS='SEQUENTIAL'                 )
#else
            IF ( HACT .EQ. 'APPEND' ) THEN
               OPEN ( UNIT=IFILE , FILE=HFILE, IOSTAT=IERR,
     &                FORM=HFORM,
     &                ACCESS='APPEND'                     )
            ELSE
               OPEN ( UNIT=IFILE , FILE=HFILE, IOSTAT=IERR,
     &                FORM=HFORM,
     &                ACCESS='SEQUENTIAL'                 )
            ENDIF
#endif      
*
         IF ( IERR .NE. 0 ) THEN
            HMSG = 'FILE OPEN ERROR'
            WRITE( HMSG(17:21), '(I5)' ) IERR
            CALL MSGDMP( 'W', 'GFOPEN', HMSG )
         ENDIF
*
      ELSE
         IERR = 0
      ENDIF
*
      RETURN
      END
*********************************************************************
*"         << ファイルクローズ >>
*********************************************************************
      SUBROUTINE GFCLSE
     M         ( IFILE  )
*
      LOGICAL    OPENDX
*
      INTEGER    IFILE                    !" 装置番号
*
      IF (  ( IFILE.LT.1 ).OR.( IFILE.GT.99 )  ) THEN
        RETURN
      ELSE
        INQUIRE ( UNIT=IFILE, OPENED=OPENDX )
        IF ( OPENDX ) CLOSE ( IFILE )
      ENDIF
*
      RETURN
      END
