*"表題 ヘッダー形式変換 GTOOL3(GHPTRN)
*
*"履歴 90/08/21 沼口  敦
*"     99/12/02 竹広真一  メッセージ出力番号を DCL より取得
*
*"      IDFM=9009→9010
*
**********************************************************************
*"         << ヘッダー形式変換 >>
**********************************************************************
      SUBROUTINE GHPTRN
     M         ( HHEAD  )
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HHEAD (NDC)*(NCC)       !" ヘッダー
*
      CHARACTER  HHEAD0(NDC)*(NCC)       !" ヘッダー
      INTEGER    IX                      !" 記述子の内容：数
      REAL       AX                      !" 記述子の内容：数
      CHARACTER  HX         *(NCC)       !" 記述子の内容：文字
*
      CHARACTER  HPARA ( NDC )*8
      CHARACTER  HFMT  ( NDC )*8
      CHARACTER  HPAR1 ( NDC )*8
      CHARACTER  HFM1  ( NDC )*8
*
*
      INTEGER    IUNIT
      CHARACTER  HMSG*50
*
      INTEGER    IDFM0                       !"   フォーマットid
      DATA       IDFM0 /9010/
      INTEGER    IDFM1                       !" 旧フォーマットid
      DATA       IDFM1 /9009/
*
      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 )/'OPTN1   '/, HFMT( 45 )/'(A)'/
      DATA       HPARA( 46 )/'OPTN2   '/, HFMT( 46 )/'(A)'/
      DATA       HPARA( 47 )/'OPTN3   '/, HFMT( 47 )/'(A)'/
      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       HPAR1(  1 )/'IDFM    '/, HFM1(  1 )/'(I10)'/
      DATA       HPAR1(  2 )/'DSET    '/, HFM1(  2 )/'(A)'/
      DATA       HPAR1(  3 )/'ITEM    '/, HFM1(  3 )/'(A)'/
      DATA       HPAR1(  4 )/'EDIT1   '/, HFM1(  4 )/'(A)'/
      DATA       HPAR1(  5 )/'EDIT2   '/, HFM1(  5 )/'(A)'/
      DATA       HPAR1(  6 )/'EDIT3   '/, HFM1(  6 )/'(A)'/
      DATA       HPAR1(  7 )/'EDIT4   '/, HFM1(  7 )/'(A)'/
      DATA       HPAR1(  8 )/'EDIT5   '/, HFM1(  8 )/'(A)'/
      DATA       HPAR1(  9 )/'EDIT6   '/, HFM1(  9 )/'(A)'/
      DATA       HPAR1( 10 )/'EDIT7   '/, HFM1( 10 )/'(A)'/
      DATA       HPAR1( 11 )/'EDIT8   '/, HFM1( 11 )/'(A)'/
      DATA       HPAR1( 12 )/'FNUM    '/, HFM1( 12 )/'(I10)'/
      DATA       HPAR1( 13 )/'DNUM    '/, HFM1( 13 )/'(I10)'/
      DATA       HPAR1( 14 )/'TITL1   '/, HFM1( 14 )/'(A)'/
      DATA       HPAR1( 15 )/'TITL2   '/, HFM1( 15 )/'(A)'/
      DATA       HPAR1( 16 )/'UNIT    '/, HFM1( 16 )/'(A)'/
      DATA       HPAR1( 17 )/'ETTL1   '/, HFM1( 17 )/'(A)'/
      DATA       HPAR1( 18 )/'ETTL2   '/, HFM1( 18 )/'(A)'/
      DATA       HPAR1( 19 )/'ETTL3   '/, HFM1( 19 )/'(A)'/
      DATA       HPAR1( 20 )/'ETTL4   '/, HFM1( 20 )/'(A)'/
      DATA       HPAR1( 21 )/'ETTL5   '/, HFM1( 21 )/'(A)'/
      DATA       HPAR1( 22 )/'ETTL6   '/, HFM1( 22 )/'(A)'/
      DATA       HPAR1( 23 )/'ETTL7   '/, HFM1( 23 )/'(A)'/
      DATA       HPAR1( 24 )/'ETTL8   '/, HFM1( 24 )/'(A)'/
      DATA       HPAR1( 25 )/'TIME    '/, HFM1( 25 )/'(I10)'/
      DATA       HPAR1( 26 )/'UTIM    '/, HFM1( 26 )/'(A)'/
      DATA       HPAR1( 27 )/'DATE    '/, HFM1( 27 )/'(A)'/
      DATA       HPAR1( 28 )/'TDUR    '/, HFM1( 28 )/'(I10)'/
      DATA       HPAR1( 29 )/'AITM1   '/, HFM1( 29 )/'(A)'/
      DATA       HPAR1( 30 )/'ASTR1   '/, HFM1( 30 )/'(I10)'/
      DATA       HPAR1( 31 )/'AEND1   '/, HFM1( 31 )/'(I10)'/
      DATA       HPAR1( 32 )/'AITM2   '/, HFM1( 32 )/'(A)'/
      DATA       HPAR1( 33 )/'ASTR2   '/, HFM1( 33 )/'(I10)'/
      DATA       HPAR1( 34 )/'AEND2   '/, HFM1( 34 )/'(I10)'/
      DATA       HPAR1( 35 )/'AITM3   '/, HFM1( 35 )/'(A)'/
      DATA       HPAR1( 36 )/'ASTR3   '/, HFM1( 36 )/'(I10)'/
      DATA       HPAR1( 37 )/'AEND3   '/, HFM1( 37 )/'(I10)'/
      DATA       HPAR1( 38 )/'DFMT    '/, HFM1( 38 )/'(A)'/
      DATA       HPAR1( 39 )/'MISS    '/, HFM1( 39 )/'(E15.7)'/
      DATA       HPAR1( 40 )/'DMIN    '/, HFM1( 40 )/'(E15.7)'/
      DATA       HPAR1( 41 )/'DMAX    '/, HFM1( 41 )/'(E15.7)'/
      DATA       HPAR1( 42 )/'DIVS    '/, HFM1( 42 )/'(E15.7)'/
      DATA       HPAR1( 43 )/'DIVL    '/, HFM1( 43 )/'(E15.7)'/
      DATA       HPAR1( 44 )/'STYP    '/, HFM1( 44 )/'(I10)'/
      DATA       HPAR1( 45 )/'OPTN1   '/, HFM1( 45 )/'(A)'/
      DATA       HPAR1( 46 )/'OPTN2   '/, HFM1( 46 )/'(A)'/
      DATA       HPAR1( 47 )/'OPTN3   '/, HFM1( 47 )/'(A)'/
      DATA       HPAR1( 48 )/'GALA1   '/, HFM1( 48 )/'(A)'/
      DATA       HPAR1( 49 )/'GALA2   '/, HFM1( 49 )/'(A)'/
      DATA       HPAR1( 50 )/'MEMO1   '/, HFM1( 50 )/'(A)'/
      DATA       HPAR1( 51 )/'MEMO2   '/, HFM1( 51 )/'(A)'/
      DATA       HPAR1( 52 )/'MEMO3   '/, HFM1( 52 )/'(A)'/
      DATA       HPAR1( 53 )/'MEMO4   '/, HFM1( 53 )/'(A)'/
      DATA       HPAR1( 54 )/'MEMO5   '/, HFM1( 54 )/'(A)'/
      DATA       HPAR1( 55 )/'MEMO6   '/, HFM1( 55 )/'(A)'/
      DATA       HPAR1( 56 )/'MEMO7   '/, HFM1( 56 )/'(A)'/
      DATA       HPAR1( 57 )/'MEMO8   '/, HFM1( 57 )/'(A)'/
      DATA       HPAR1( 58 )/'MEMO9   '/, HFM1( 58 )/'(A)'/
      DATA       HPAR1( 59 )/'MEMO10  '/, HFM1( 59 )/'(A)'/
      DATA       HPAR1( 60 )/'CDATE   '/, HFM1( 60 )/'(A)'/
      DATA       HPAR1( 61 )/'CSIGN   '/, HFM1( 61 )/'(A)'/
      DATA       HPAR1( 62 )/'MDATE   '/, HFM1( 62 )/'(A)'/
      DATA       HPAR1( 63 )/'MSIGN   '/, HFM1( 63 )/'(A)'/
      DATA       HPAR1( 64 )/'SIZE    '/, HFM1( 64 )/'(I10)'/
*
*"         < 1. フォーマットの検査 >
*
      READ ( HHEAD( 1 ), HFMT( 1 ), IOSTAT=IOS0 ) IDFMX
      READ ( HHEAD( 1 ), HFM1( 1 ), IOSTAT=IOS1 ) IDFMY
      IF      ( (IDFMX .EQ. IDFM0 ).AND.( IOS0 .EQ. 0 ) ) THEN
*"                   < new format >
         RETURN
      ELSE IF ( (IDFMY .NE. IDFM1 ).OR.( IOS1 .NE. 0 ) ) THEN
         NFMT = LENC ( HHEAD( 1 ) )
         HMSG = 'FORMAT'//HHEAD( 1 )(1:NFMT)//' IS NOT MATCH.'
         CALL MSGDMP('W', 'GHPTRN', HMSG )
         CALL GLIGET( 'MSGUNIT', IUNIT )
         WRITE ( IUNIT,* ) HHEAD
      ENDIF
*
*"         < 2. 表から探して読む >
*
      CALL GTPGET( 'MISS', VMISS )
*
      WRITE ( HHEAD0( 1 ), HFMT( 1 ) ) IDFM0
      DO 2100 IP1 = 2, NPARA
*
         IF      ( HFMT( IP1 )(2:2) .EQ. 'I' ) THEN
            READ ( HHEAD( IP1 ), HFM1( IP1 ), IOSTAT=IOS  ) IX
            IF ( IOS .NE. 0 ) IX = 0
         ELSE IF ( HFMT( IP1 )(2:2) .EQ. 'E' ) THEN
            READ ( HHEAD( IP1 ), HFM1( IP1 ), IOSTAT=IOS  ) AX
            IF ( IOS .NE. 0 ) AX = VMISS
         ELSE
            HX = HHEAD( IP1 )
         ENDIF
*
         DO 2110 IP0 = 2, NPARA
            IF ( HPARA( IP0 ) .EQ. HPAR1( IP1 ) ) THEN
*
               IF       ( HFMT( IP0 )(2:2) .EQ. 'I' ) THEN
                  WRITE ( HHEAD0( IP0 ), HFMT( IP0 ) ) IX
               ELSE  IF ( HFMT( IP0 )(2:2) .EQ. 'E' ) THEN
                  WRITE ( HHEAD0( IP0 ), HFMT( IP0 ) ) AX
               ELSE
                  HHEAD0( IP0 )  = HX
               ENDIF
            ENDIF
*
 2110    CONTINUE
 2100 CONTINUE
*
      CALL GHCOPY ( HHEAD0, HHEAD  )
*
      RETURN
      END
