*"表題 ヘッダー形式変換 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