* PACKAGE  GTFUNC !" 関数化前処理
***********************************************************************
      PROGRAM GTFUNC
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      CHARACTER  HHEAD( NDC )*(NCC)
*
      CHARACTER  X *(NCC)
      CHARACTER  Y *(NCC)
      CHARACTER  Z *(NCC)
      DATA       X,Y,Z  / 3*' ' /
      CHARACTER  ITEM   *(NCC)
      CHARACTER  UNIT   *(NCC)
      CHARACTER  TITLE  *(NCC*2)
      CHARACTER  DSET   *(NCC)
      CHARACTER  EDIT   *(NCC)
      CHARACTER  ETTL   *(NCC)
      DATA       ITEM, UNIT, TITLE, DSET, EDIT, ETTL / 6*' '/
      LOGICAL    HELP
      DATA       HELP   / .FALSE. /
      CHARACTER  HHFLD  *(NCC)
      CHARACTER  HDATE  *(NCC)
      CHARACTER  HSIGN  *(NCC)
      CHARACTER  HXP ( NDC )*(NCC)
      CHARACTER  HYP ( NDC )*(NCC)
      CHARACTER  HZP ( NDC )*(NCC)
      PARAMETER  ( IMAXD = 1024 )
      REAL       XP( IMAXD )
      REAL       YP( IMAXD )
      REAL       ZP( IMAXD )
*
      NAMELIST  /OPTION/ X, Y, Z,
     &                   ITEM, UNIT, TITLE, DSET, EDIT, ETTL,
     &                   HELP
*
      CALL OPTARG ( 91, 'OPTION', 'HFILE', NOPT, NFILE )
      READ (91,OPTION,IOSTAT=IOS)
      CLOSE(91)
      IF ( IOS.NE.0 .OR. HELP ) THEN
         WRITE(6,OPTION)
         STOP
      ENDIF
*
      CALL GTOPEN
      CALL GTSIZE ( HHEAD, IJKDIM )
*
      CALL GTSIZE ( HXP , IMAXD   )
      CALL GUQAXC
     I            ( X   , 'LOC',
     O              HXP , XP   , CYCLE , IMAXP , IEOD  )
      CALL GTSIZE ( HYP , IMAXD   )
      CALL GUQAXC
     I            ( Y   , 'LOC',
     O              HYP , YP   , CYCLE , JMAXP , IEOD  )
      CALL GTSIZE ( HZP , IMAXD   )
      CALL GUQAXC
     I            ( Z   , 'LOC',
     O              HZP , ZP   , CYCLE , KMAXP , IEOD  )
*
      CALL GHPCLR ( HHEAD )
      CALL GTPGET ( 'MISS', VMISS )
      CALL GHPSET ( HHEAD, 'FNUM', 1     )
      CALL GHPSET ( HHEAD, 'DNUM', 1     )
      CALL GHCSET ( HHEAD, 'UTIM', 'DAY' )
      CALL GHPSET ( HHEAD, 'TDUR', 1     )
      CALL GHPSET ( HHEAD, 'MISS', VMISS )
      CALL GHPSET ( HHEAD, 'DMIN', VMISS )
      CALL GHPSET ( HHEAD, 'DMAX', VMISS )
      CALL GHPSET ( HHEAD, 'DIVS', VMISS )
      CALL GHPSET ( HHEAD, 'DIVL', VMISS )
      CALL GHPSET ( HHEAD, 'STYP', 1     )
      CALL GHCSET ( HHEAD, 'DFMT', 'UR4' )
      CALL GUQNOW ( HDATE )
      CALL GTCGET ( 'MYSIGN', HSIGN )
      CALL GHCSET ( HHEAD , 'CDATE' , HDATE )
      CALL GHCSET ( HHEAD , 'CSIGN' , HSIGN )
*
      CALL GHCSET( HHEAD,  'AITM1', X )
      CALL GHCSET( HHEAD,  'AITM2', Y )
      CALL GHCSET( HHEAD,  'AITM3', Z )
      CALL GHPSET( HHEAD,  'ASTR1', 1 )
      CALL GHPSET( HHEAD,  'AEND1', IMAXP )
      CALL GHPSET( HHEAD,  'ASTR2', 1 )
      CALL GHPSET( HHEAD,  'AEND2', JMAXP )
      CALL GHPSET( HHEAD,  'ASTR3', 1 )
      CALL GHPSET( HHEAD,  'AEND3', KMAXP )
*
      IF ( ITEM .NE. ' ' ) THEN
         CALL GHCSET( HHEAD , 'ITEM', ITEM )
      ENDIF
      IF ( UNIT .NE. ' ' ) THEN
         CALL GHCSET( HHEAD , 'UNIT', UNIT )
      ENDIF
      IF ( TITLE .NE. ' ' ) THEN
         CALL GHCSTS( HHEAD , 'TITL', TITLE )
      ENDIF
      IF ( DSET .NE. ' ' ) THEN
         CALL GHCSET( HHEAD , 'DSET', DSET )
      ENDIF
*
      WRITE (6,*) '/usr/local/bin/jgawk \\'
      WRITE (6,*) '\'BEGIN { pi=atan2(0,-1); r=pi/180.; head=1 }; \\'
      WRITE (6,*) '/^E_O_H/{ head=0; next }; \\'
      WRITE (6,*) 'head==1 { print; next }; \\'
      WRITE (6,*) '        { print FUNC($1,$2,$3) }; \\'
      WRITE (6,*) 'function FUNC(x,y,z) { return x*y } \\'
      WRITE (6,*) '\'<< E_O_F'
*
      DO 1200 IP = 1, NDC-1
         CALL GHNINQ( IP, HHFLD )
         IF ( HHFLD.EQ.'TITL1' ) THEN
            HHFLD = 'TITLE'
            WRITE ( 6,1600 )  HHFLD
         ELSE IF ( HHFLD.NE.'TITL2' ) THEN
            IF ( HHEAD(IP) .NE. ' ' ) THEN
               WRITE ( 6,1610 )  HHFLD, HHEAD(IP)
            ELSE
               WRITE ( 6,1600 )  HHFLD
            ENDIF
         ENDIF
 1600    FORMAT( ' ', A16, ': ' )
 1610    FORMAT( ' ', A16, ': ', A16 )
 1200 CONTINUE
      WRITE (6,*) 'E_O_H'
*
      DO 2100 K = 1, KMAXP
         DO 2100 J = 1, JMAXP
            DO 2100 I = 1, IMAXP
               WRITE (6,*) XP(I), YP(J), ZP(K)
 2100 CONTINUE 
*
      WRITE (6,*) 'E_O_F'
*
      STOP
      END