*"表題 ヘッダー読み書き GTOOL3(GHPGET)
*
*"履歴 90/08/21 沼口  敦
*"     99/12/02 竹広真一  メッセージ出力番号を DCL より取得
*
*
**********************************************************************
*"         << 記述子（数）の参照 >>
**********************************************************************
      SUBROUTINE GHPGET
     I         ( HHEAD , HP    ,
     I           IX              )
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HHEAD (NDC)*(NCC)       !" ヘッダー
      CHARACTER  HP         *(*)         !" ヘッダーの記述子指定
*"   (INTEGER)   IX                      ! 記述子の内容：数
*
      CHARACTER  HX         *(*)         !" 記述子の内容：文字
      CHARACTER  HFM        *(*)         !" 記述子の書式
*
      CHARACTER  HPARA ( NDC )*8
      CHARACTER  HFMT  ( NDC )*8
*
      REAL       AY
      INTEGER    IY
      EQUIVALENCE (AY,IY)
*
      CHARACTER  HMSG*50
      INTEGER    NHP
*
      INTEGER    IDFM0                   !" フォーマットid
      DATA       IDFM0 /9010/
*
      INTEGER    NPARA
      DATA       NPARA / 64 /
*
      DATA       HPARA(  1 )/'IDFM    '/, HFMT(  1 )/'(I16)'/
      DATA       HPARA(  2 )/'DSET    '/, HFMT(  2 )/'(A)'/
      DATA       HPARA(  3 )/'ITEM    '/, HFMT(  3 )/'(A)'/
      DATA       HPARA(  4 )/'EDIT1   '/, HFMT(  4 )/'(A)'/
      DATA       HPARA(  5 )/'EDIT2   '/, HFMT(  5 )/'(A)'/
      DATA       HPARA(  6 )/'EDIT3   '/, HFMT(  6 )/'(A)'/
      DATA       HPARA(  7 )/'EDIT4   '/, HFMT(  7 )/'(A)'/
      DATA       HPARA(  8 )/'EDIT5   '/, HFMT(  8 )/'(A)'/
      DATA       HPARA(  9 )/'EDIT6   '/, HFMT(  9 )/'(A)'/
      DATA       HPARA( 10 )/'EDIT7   '/, HFMT( 10 )/'(A)'/
      DATA       HPARA( 11 )/'EDIT8   '/, HFMT( 11 )/'(A)'/
      DATA       HPARA( 12 )/'FNUM    '/, HFMT( 12 )/'(I16)'/
      DATA       HPARA( 13 )/'DNUM    '/, HFMT( 13 )/'(I16)'/
      DATA       HPARA( 14 )/'TITL1   '/, HFMT( 14 )/'(A)'/
      DATA       HPARA( 15 )/'TITL2   '/, HFMT( 15 )/'(A)'/
      DATA       HPARA( 16 )/'UNIT    '/, HFMT( 16 )/'(A)'/
      DATA       HPARA( 17 )/'ETTL1   '/, HFMT( 17 )/'(A)'/
      DATA       HPARA( 18 )/'ETTL2   '/, HFMT( 18 )/'(A)'/
      DATA       HPARA( 19 )/'ETTL3   '/, HFMT( 19 )/'(A)'/
      DATA       HPARA( 20 )/'ETTL4   '/, HFMT( 20 )/'(A)'/
      DATA       HPARA( 21 )/'ETTL5   '/, HFMT( 21 )/'(A)'/
      DATA       HPARA( 22 )/'ETTL6   '/, HFMT( 22 )/'(A)'/
      DATA       HPARA( 23 )/'ETTL7   '/, HFMT( 23 )/'(A)'/
      DATA       HPARA( 24 )/'ETTL8   '/, HFMT( 24 )/'(A)'/
      DATA       HPARA( 25 )/'TIME    '/, HFMT( 25 )/'(I16)'/
      DATA       HPARA( 26 )/'UTIM    '/, HFMT( 26 )/'(A)'/
      DATA       HPARA( 27 )/'DATE    '/, HFMT( 27 )/'(A)'/
      DATA       HPARA( 28 )/'TDUR    '/, HFMT( 28 )/'(I16)'/
      DATA       HPARA( 29 )/'AITM1   '/, HFMT( 29 )/'(A)'/
      DATA       HPARA( 30 )/'ASTR1   '/, HFMT( 30 )/'(I16)'/
      DATA       HPARA( 31 )/'AEND1   '/, HFMT( 31 )/'(I16)'/
      DATA       HPARA( 32 )/'AITM2   '/, HFMT( 32 )/'(A)'/
      DATA       HPARA( 33 )/'ASTR2   '/, HFMT( 33 )/'(I16)'/
      DATA       HPARA( 34 )/'AEND2   '/, HFMT( 34 )/'(I16)'/
      DATA       HPARA( 35 )/'AITM3   '/, HFMT( 35 )/'(A)'/
      DATA       HPARA( 36 )/'ASTR3   '/, HFMT( 36 )/'(I16)'/
      DATA       HPARA( 37 )/'AEND3   '/, HFMT( 37 )/'(I16)'/
      DATA       HPARA( 38 )/'DFMT    '/, HFMT( 38 )/'(A)'/
      DATA       HPARA( 39 )/'MISS    '/, HFMT( 39 )/'(E16.7)'/
      DATA       HPARA( 40 )/'DMIN    '/, HFMT( 40 )/'(E16.7)'/
      DATA       HPARA( 41 )/'DMAX    '/, HFMT( 41 )/'(E16.7)'/
      DATA       HPARA( 42 )/'DIVS    '/, HFMT( 42 )/'(E16.7)'/
      DATA       HPARA( 43 )/'DIVL    '/, HFMT( 43 )/'(E16.7)'/
      DATA       HPARA( 44 )/'STYP    '/, HFMT( 44 )/'(I16)'/
      DATA       HPARA( 45 )/'COPTN   '/, HFMT( 45 )/'(A)'/
      DATA       HPARA( 46 )/'IOPTN   '/, HFMT( 46 )/'(I16)'/
      DATA       HPARA( 47 )/'ROPTN   '/, HFMT( 47 )/'(E16.7)'/
      DATA       HPARA( 48 )/'TIME2   '/, HFMT( 48 )/'(I16)'/
      DATA       HPARA( 49 )/'UTIM2   '/, HFMT( 49 )/'(A)'/
      DATA       HPARA( 50 )/'MEMO1   '/, HFMT( 50 )/'(A)'/
      DATA       HPARA( 51 )/'MEMO2   '/, HFMT( 51 )/'(A)'/
      DATA       HPARA( 52 )/'MEMO3   '/, HFMT( 52 )/'(A)'/
      DATA       HPARA( 53 )/'MEMO4   '/, HFMT( 53 )/'(A)'/
      DATA       HPARA( 54 )/'MEMO5   '/, HFMT( 54 )/'(A)'/
      DATA       HPARA( 55 )/'MEMO6   '/, HFMT( 55 )/'(A)'/
      DATA       HPARA( 56 )/'MEMO7   '/, HFMT( 56 )/'(A)'/
      DATA       HPARA( 57 )/'MEMO8   '/, HFMT( 57 )/'(A)'/
      DATA       HPARA( 58 )/'MEMO9   '/, HFMT( 58 )/'(A)'/
      DATA       HPARA( 59 )/'MEMO10  '/, HFMT( 59 )/'(A)'/
      DATA       HPARA( 60 )/'CDATE   '/, HFMT( 60 )/'(A)'/
      DATA       HPARA( 61 )/'CSIGN   '/, HFMT( 61 )/'(A)'/
      DATA       HPARA( 62 )/'MDATE   '/, HFMT( 62 )/'(A)'/
      DATA       HPARA( 63 )/'MSIGN   '/, HFMT( 63 )/'(A)'/
      DATA       HPARA( 64 )/'SIZE    '/, HFMT( 64 )/'(I16)'/
      DATA       IMISS / 39 /
*
      INTEGER    IUNIT
*
*"         < 1. フォーマットの検査 >
*
      READ ( HHEAD( 1 ), HFMT( 1 ), IOSTAT=IOS ) IDFM
      IF ( ( IDFM .NE. IDFM0 ).OR.( IOS .NE. 0 ) ) THEN
         NFMT = LENC ( HHEAD( 1 ) )
         HMSG = 'FORMAT'//HHEAD( 1 )(1:NFMT)//' IS NOT MATCH.'
         CALL MSGDMP('W', 'GHPGET', HMSG )
         CALL GLIGET( 'MSGUNIT', IUNIT )
         WRITE ( IUNIT,* ) HHEAD
*
         IY = -1
      ENDIF
*
*"         < 2. 表から探して読む >
*
      CALL GTPGET( 'MISS', VMISS )
*
      DO 2100 IP = 1, NPARA
         IF ( HP .EQ. HPARA( IP ) ) THEN
*
            IF      ( HFMT( IP )(2:2) .EQ. 'I' ) THEN
               READ ( HHEAD( IP ), HFMT( IP ), IOSTAT=IOS  ) IY
               IF ( IOS .NE. 0 ) IY = 0
            ELSE IF ( HFMT( IP )(2:2) .EQ. 'E' ) THEN
               READ ( HHEAD( IP ), HFMT( IP ), IOSTAT=IOS  ) AY
               IF ( IOS .NE. 0 ) THEN
                 READ ( HHEAD(IMISS),HFMT(IMISS),IOSTAT=IOS ) AY
               ENDIF
            ELSE
               NHP  = LENC ( HP )
               HMSG = 'PARAMETER'''//HP(1:NHP)//''' IS NOT FOR NUMBER.'
               CALL MSGDMP('W', 'GHPGET', HMSG )
               IY = -1
            ENDIF
*
            IX = IY
*
            RETURN
        ENDIF
 2100 CONTINUE
*
*"         < 3. 表にないとき >
*
      NHP  = LENC ( HP )
      HMSG = 'PARAMETER'''//HP(1:NHP)//''' IS NOT DEFINED.'
      CALL MSGDMP('W', 'GHPGET', HMSG )
*
      RETURN
*=====================================================================
*"         << 記述子（数）の設定 >>
*=====================================================================
      ENTRY GHPSET
     M         ( HHEAD ,
     I           HP    , IX     )
*
*"         < 4. 表から探して書く >
*
      IF ( HP .EQ. HPARA( 1 ) ) THEN
         WRITE ( HHEAD( 1 ), HFMT( 1 ) ) IDFM0
         RETURN
      ENDIF
*
      DO 4100 IP = 2, NPARA
         IF ( HP .EQ. HPARA( IP ) ) THEN
*
            IY = IX
            IF       ( HFMT( IP )(2:2) .EQ. 'I' ) THEN
               WRITE ( HHEAD( IP ), HFMT( IP ) ) IY
            ELSE  IF ( HFMT( IP )(2:2) .EQ. 'E' ) THEN
               WRITE ( HHEAD( IP ), HFMT( IP ) ) AY
            ELSE
               NHP  = LENC ( HP )
               HMSG = 'PARAMETER'''//HP(1:NHP)//''' IS NOT FOR NUMBER.'
               CALL MSGDMP('W', 'GHPSET', HMSG )
            ENDIF
*
            RETURN
         ENDIF
 4100 CONTINUE
*
*"         < 5. 表にないとき >
*
      NHP  = LENC ( HP )
      HMSG = 'PARAMETER'''//HP(1:NHP)//''' IS NOT DEFINED.'
      CALL MSGDMP('W', 'GHPSET', HMSG )
*
      RETURN
*=====================================================================
*"         << 記述子（文字）の参照 >>
*=====================================================================
      ENTRY      GHCGET
     I         ( HHEAD , HP    ,
     I           HX              )
*
*"         < 6. フォーマットの検査 >
*
      READ ( HHEAD( 1 ), HFMT( 1 ), IOSTAT=IOS ) IDFM
      IF ( ( IDFM .NE. IDFM0 ).OR.( IOS .NE. 0 ) ) THEN
         NFMT = LENC ( HHEAD( 1 ) )
         HMSG = 'FORMAT'//HHEAD( 1 )(1:NFMT)//' IS NOT MATCH.'
         CALL MSGDMP('W', 'GHCGET', HMSG )
         CALL GLIGET( 'MSGUNIT', IUNIT )
         WRITE ( IUNIT,* ) HHEAD
*
         HX = ' '
      ENDIF
*
*"         < 7. 表から探して読む >
*
      DO 7100 IP = 1, NPARA
         IF ( HP .EQ. HPARA( IP ) ) THEN
            HX = HHEAD( IP )
            RETURN
        ENDIF
 7100 CONTINUE
*
*"         < 8. 表にないとき >
*
      NHP  = LENC ( HP )
      HMSG = 'PARAMETER'''//HP(1:NHP)//''' IS NOT DEFINED.'
      CALL MSGDMP('W', 'GHCGET', HMSG )
*
      RETURN
*=====================================================================
*"         << 記述子（文字）の設定 >>
*=====================================================================
      ENTRY GHCSET
     M         ( HHEAD ,
     I           HP    , HX     )
*
*"         < 9. 表から探して書く >
*
      DO 9100 IP = 1, NPARA
         IF ( HP .EQ. HPARA( IP ) ) THEN
            HHEAD( IP ) = HX
            RETURN
         ENDIF
 9100 CONTINUE
*
*"         < 10. 表にないとき >
*
      NHP  = LENC ( HP )
      HMSG = 'PARAMETER'''//HP(1:NHP)//''' IS NOT DEFINED.'
      CALL MSGDMP('W', 'GHCSET', HMSG )
*
      RETURN
*=====================================================================
*"         << 記述子の書式参照 >>
*=====================================================================
      ENTRY GHPINQ
     I         ( HP    ,
     O           HFM    )
*
      DO 9600 IP = 1, NPARA
         IF ( HP .EQ. HPARA( IP ) ) THEN
            HFM = HFMT( IP )
            RETURN
        ENDIF
 9600 CONTINUE
*
      HFM = ' '
      RETURN
*=====================================================================
*"         << 記述子のクリアー >>
*=====================================================================
      ENTRY GHPCLR
     O         ( HHEAD  )
*
      WRITE ( HHEAD( 1 ), HFMT( 1 ) ) IDFM0
*
      DO 9700 IP = 2, NPARA
         IF       ( HFMT( IP )(2:2) .EQ. 'I' ) THEN
            WRITE ( HHEAD( IP ), HFMT( IP ) ) 0
         ELSE  IF ( HFMT( IP )(2:2) .EQ. 'E' ) THEN
            WRITE ( HHEAD( IP ), HFMT( IP ) ) 0.
         ELSE
            HHEAD( IP ) = ' '
         ENDIF
 9700 CONTINUE
*
      RETURN
*=====================================================================
*"         << 記述子名参照 >>
*=====================================================================
      ENTRY GHNINQ
     I         ( IZ    ,
     O           HP      )
*
      IF ( IZ .GE. 1 .AND. IZ .LE. NPARA ) THEN
         HP = HPARA ( IZ )
      ELSE
         HP = ' '
      ENDIF
*
      RETURN
      END
