*"表題 ファイル書き込み GTOOL3(GFWRIT)
*
*"履歴 90/08/15 沼口  敦
*"     92/06/18 沼口  敦  倍精度対応
*"     97/02/14 竹広真一  GFWRTZ を単/倍精度に分割
*"     99/12/02 竹広真一  メッセージ出力番号を DCL より取得
*
**********************************************************************
*"      <<  GTOOL3標準フォーマットデータ書き込み >>
**********************************************************************
      SUBROUTINE GFWRIT
     I         ( HHEAD , GDATA ,
     I           JFILE , MODE  , NOEND  )
*
      CHARACTER  HHEAD ( * )*(*)         !" ヘッダー
      REAL       GDATA ( * )             !" データ
      INTEGER    JFILE                   !" 装置番号
      INTEGER    MODE                    !" モード(1なら表示ON)
      INTEGER    NOEND                   !" ENDFILEの間隔
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HSIGN *(NCC)
      CHARACTER  HITEM *(NCC)
      CHARACTER  HSIZE *(NCC)
      CHARACTER  HFMT  *(NCC)
      CHARACTER  HDFMT *(NCC)
      CHARACTER  HSIGN0*(NCC)
      DATA       HSIGN0 / 'GTOOL3' /
      INTEGER    ITIME
      INTEGER    ISTR  , IEND  , JSTR  , JEND  , KSTR  , KEND
*
*"         < 1.  NOUT : 出力した回数を記録 >
*
      INTEGER   IUNIT
      INTEGER   NOUT ( 99 )
      INTEGER   NFOU ( 99 )
      LOGICAL   OFIRST
      DATA      OFIRST /.TRUE./
      SAVE      NOUT, NFOU, OFIRST, IUNIT
*
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         DO 1100 J = 1, 99
            NOUT( J ) = 0
            NFOU( J ) = 1
 1100    CONTINUE
         CALL GTCGET( 'MYSIGN', HSIGN )
         IF ( HSIGN .EQ. HSIGN0 ) THEN
            CALL MSGDMP( 'W', 'GFWRIT',
     &                   'PLEASE SPECIFY YOUR SIGN BY <GTSIGN>.' )
         ENDIF
         CALL GLIGET( 'MSGUNIT', IUNIT )
      ENDIF
*
*"         < 2. ファイル番号チェック >
*
      IF (  ( JFILE.LT.1 ).OR.( JFILE.GT.99 )  ) THEN
        RETURN
      ENDIF
*
*"         < 3. メッセージを書く >
*
      IF ( MODE.EQ.1 )   THEN
         CALL GHCGET ( HHEAD, 'ITEM', HITEM )
         CALL GHPGET ( HHEAD, 'TIME', ITIME )
         WRITE (IUNIT,*) '** WRITE ', HITEM, ' T = ', ITIME
      ENDIF
*
      CALL GUSNOW ( HHEAD, 'MDATE'  )
      CALL GTCGET ( 'MYSIGN', HSIGN )
      CALL GHCSET ( HHEAD, 'MSIGN', HSIGN )
*
*"         < 4. データの大きさ >
*
      CALL GUQSIZ
     I         ( HHEAD ,
     O           ISTR  , IEND  , IDIM ,
     O           JSTR  , JEND  , JDIM ,
     O           KSTR  , KEND  , KDIM   )
*
      CALL GHPINQ ( 'SIZE', HFMT  )
      WRITE ( HSIZE, HFMT ) IDIM*JDIM*KDIM
*
*"         < 5. ヘッダー付データ出力 >
*
      WRITE ( JFILE ) ( HHEAD( II ), II=1, NDC-1 ), HSIZE
*
      CALL GHCGET ( HHEAD, 'DFMT', HDFMT )
      IF ( HDFMT .EQ. 'UR8' ) THEN
         CALL GFWRZD            !" 倍精度書き込み
     O        ( GDATA ,
     I          JFILE , IDIM*JDIM*KDIM )
      ELSE
         CALL GFWRZR            !" 単精度書き込み
     O        ( GDATA ,
     I          JFILE , IDIM*JDIM*KDIM )
      ENDIF
*
*"         < 6. ENDFILE 処理 >
*
      NOUT( JFILE ) = NOUT( JFILE ) + 1
*
      IF ( NOEND .GE. 1 ) THEN
*
         IF ( NOUT( JFILE ) .GE. NOEND ) THEN
            ENDFILE JFILE
*
            WRITE (IUNIT,6100) JFILE, NFOU( JFILE )
 6100       FORMAT (' === END OF OUTPUT FILE FT', I2.2, 'F', I3.3 )
            NOUT( JFILE ) = 0
            NFOU( JFILE ) = NFOU( JFILE ) + 1
         ENDIF
*
      ENDIF
*
      RETURN
      END
************************************************************************
*"         << データ書き込み >>
************************************************************************
      SUBROUTINE GFWRZR
     I         ( GDATA ,
     I           JFILE , IJKDIM )
*
      REAL       GDATA ( IJKDIM )              !" データ
      INTEGER    JFILE                         !" ファイル番号
*
      WRITE ( JFILE ) GDATA
*
      RETURN
      END
************************************************************************
      SUBROUTINE GFWRZD
     I         ( GDATA ,
     I           JFILE , IJKDIM )
*
      REAL*8     GDATA ( IJKDIM )              !" データ
      INTEGER    JFILE                         !" ファイル番号
*
      WRITE ( JFILE ) GDATA
*
      RETURN
      END