*"表題 ヘッダー読み書き 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