* PACKAGE GTSKELTON   !" gtcreate ¤Īskelton
************************************************************************
      PROGRAM GTSKLT
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)
#else
#include         "gzsize.F"
#endif
*
      CHARACTER  HHEAD(NDC)*(NCC)
      CHARACTER  HHFLD*(NCC)
      CHARACTER  HDATE*(NCC)
      CHARACTER  HSIGN*(NCC)
      CHARACTER  HTITL*(NCC)
*
      CHARACTER  HFILE( 1 )        *(NFILN)
      DATA       HFILE / ' ' /
      DATA       IFILE / 50 /
      CHARACTER  HNUL *3
      PARAMETER  ( RUNDEF=-999., IUNDEF=-999, HNUL='NUL')
      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*HNUL /
      REAL       DIVS , DIVL
      REAL       DMIN , DMAX
      REAL       DMISS, ROPTN
      DATA       DIVS , DIVL, DMIN, DMAX, DMISS, ROPTN / 6*RUNDEF /
      INTEGER    TIME
      INTEGER    TDUR
      DATA       TIME, TDUR  / 2*IUNDEF /
      CHARACTER  UTIM   *(NCC)
      CHARACTER  DATE   *(NCC)
      DATA       UTIM, DATE  / 2*HNUL /
      INTEGER    FNUM
      INTEGER    DNUM
      DATA       FNUM, DNUM  / 2*IUNDEF /
      CHARACTER  AITM1  *(NCC)
      CHARACTER  AITM2  *(NCC)
      CHARACTER  AITM3  *(NCC)
      DATA       AITM1, AITM2, AITM3 / 3*HNUL /
      INTEGER    ASTR1  
      INTEGER    ASTR2  
      INTEGER    ASTR3
      DATA       ASTR1, ASTR2, ASTR3 / 3*IUNDEF /
      INTEGER    AEND1  
      INTEGER    AEND2  
      INTEGER    AEND3
      DATA       AEND1, AEND2, AEND3 / 3*IUNDEF /
      INTEGER    STYP
      DATA       STYP  / IUNDEF /
      INTEGER    IOPTN 
      DATA       IOPTN / IUNDEF /
      CHARACTER  COPTN  *(NCC)
      DATA       COPTN / HNUL  /
      LOGICAL    GRESET
      DATA       GRESET / .FALSE. /
      LOGICAL    HELP
      DATA       HELP   / .FALSE. /
*
      NAMELIST  /OPTION/ ITEM, UNIT, TITLE, DSET, EDIT, ETTL,
     &                   DIVS, DIVL, DMIN, DMAX, DMISS, STYP,
     &                   TIME, TDUR, UTIM, DATE, FNUM, DNUM,
     &                   AITM1, AITM2, AITM3,
     &                   ASTR1, ASTR2, ASTR3,
     &                   AEND1, AEND2, AEND3,
     &                   ROPTN, IOPTN, COPTN, GRESET, HFILE, 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 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, 'ASTR1', 1    )      
      CALL GHPSET ( HHEAD, 'AEND1', 1    )      
      CALL GHPSET ( HHEAD, 'ASTR2', 1    )      
      CALL GHPSET ( HHEAD, 'AEND2', 1    )      
      CALL GHPSET ( HHEAD, 'ASTR3', 1    )      
      CALL GHPSET ( HHEAD, 'AEND3', 1    )      
      CALL GHPSET ( HHEAD, 'MISS', VMISS )
      CALL GHRSGP ( HHEAD  )
      CALL GHCSET ( HHEAD, 'DFMT', 'UR4' )
      CALL GUQNOW ( HDATE )
      CALL GTCGET ( 'MYSIGN', HSIGN )
      CALL GHCSET ( HHEAD , 'CDATE' , HDATE )
      CALL GHCSET ( HHEAD , 'CSIGN' , HSIGN )
*
      IF ( HFILE(1) .NE. ' ' ) THEN
         IF ( HFILE(1) .EQ. '-' ) THEN
            IFILE = 5
         ELSE
            OPEN ( IFILE, FILE=HFILE(1), 
     &           ACCESS='SEQUENTIAL',FORM='FORMATTED' )
         ENDIF
*
         CALL    RDTXT
     I         ( IFILE ,
     M           HHEAD  )
      ENDIF
*
      IF ( ITEM .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'ITEM', ITEM )
      ENDIF
      IF ( UNIT .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'UNIT', UNIT )
      ENDIF
      IF ( TITLE .NE. HNUL ) THEN
         CALL GHCSTS( HHEAD, 'TITL', TITLE )
      ENDIF
      IF ( DSET .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'DSET', DSET )
      ENDIF
      IF (  ( EDIT .NE. ' ' ).AND.( EDIT .NE. HNUL )  ) THEN
         CALL GHEADD ( HHEAD, EDIT, ETTL )
      ENDIF
      IF ( DIVS .NE. RUNDEF ) THEN
         CALL GHPSET( HHEAD, 'DIVS', DIVS )
      ENDIF
      IF ( DIVL .NE. RUNDEF ) THEN
         CALL GHPSET( HHEAD, 'DIVL', DIVL )
      ENDIF
      IF ( DMIN .NE. RUNDEF ) THEN
         CALL GHPSET( HHEAD, 'DMIN', DMIN )
      ENDIF
      IF ( DMAX .NE. RUNDEF ) THEN
         CALL GHPSET( HHEAD, 'DMAX', DMAX )
      ENDIF
      IF ( DMISS .NE. RUNDEF ) THEN
         CALL GHPSET( HHEAD, 'MISS', DMISS )
      ENDIF
      IF ( TIME  .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'TIME', TIME )
      ENDIF
      IF ( TDUR  .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'TDUR', TDUR )
      ENDIF
      IF ( UTIM  .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'UTIM', UTIM )
      ENDIF
      IF ( DATE  .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'DATE', DATE )
      ENDIF
      IF ( FNUM .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'FNUM', FNUM )
      ENDIF
      IF ( DNUM .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'DNUM', DNUM )
      ENDIF
      IF ( AITM1 .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'AITM1', AITM1 )
      ENDIF
      IF ( AITM2 .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'AITM2', AITM2 )
      ENDIF
      IF ( AITM3 .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'AITM3', AITM3 )
      ENDIF
      IF ( ASTR1 .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'ASTR1', ASTR1 )
      ENDIF
      IF ( ASTR2 .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'ASTR2', ASTR2 )
      ENDIF
      IF ( ASTR3 .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'ASTR3', ASTR3 )
      ENDIF
      IF ( AEND1 .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'AEND1', AEND1 )
      ENDIF
      IF ( AEND2 .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'AEND2', AEND2 )
      ENDIF
      IF ( AEND3 .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'AEND3', AEND3 )
      ENDIF
      IF ( ROPTN .NE. RUNDEF ) THEN
         CALL GHPSET( HHEAD, 'ROPTN', ROPTN )
      ENDIF
      IF ( STYP .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'STYP', STYP )
      ENDIF
      IF ( IOPTN .NE. IUNDEF ) THEN
         CALL GHPSET( HHEAD, 'IOPTN', IOPTN )
      ENDIF
      IF ( COPTN .NE. HNUL ) THEN
         CALL GHCSET( HHEAD, 'COPTN', COPTN )
      ENDIF
*
      DO 1200 IP = 1, NDC-1
         CALL GHNINQ( IP, HHFLD )
         IF ( HHFLD.EQ.'TITL1' ) THEN
            HTITL = HHEAD(IP)
         ELSE IF ( HHFLD.EQ.'TITL2' ) THEN
            HHFLD = 'TITLE'
            WRITE ( 6,1620 )  HHFLD, HTITL//HHEAD(IP)
         ELSE
            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 )
 1620    FORMAT( ' ', A16, ': ', A32 )
 1200 CONTINUE
*
      STOP
      END
***********************************************************************
      SUBROUTINE RDTXT
     I         ( IFILE ,
     M           HHEAD  )
*
      CHARACTER  HHEAD ( * )*(*)
*
      
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)
#else
#include         "gzsize.F"
#endif
      PARAMETER (NBUF=255)
      CHARACTER  HBUF*(NBUF), HXX*(NBUF)
      CHARACTER  HP*(NCC), HX*(NCC)
      CHARACTER  HFMT*(NCC)
      LOGICAL    LCHRN
*
  100 CONTINUE 
      READ ( IFILE,'(A)',IOSTAT=IEOS ) HBUF
      IF ( IEOS .NE. 0 ) THEN
         RETURN
      ENDIF
      IF ( HBUF(1:1) .EQ. '#' ) THEN
         GOTO 100
      ENDIF
*
      IDX = 0
*
 1100 CONTINUE
*
         IL   = LENB(HBUF)
         LENH = LEN(HBUF)
         IF ( .NOT.LCHRN(HBUF(IL+1:IL+1)) ) THEN
*
            IC = INDEX(HBUF,':')
            IF ( IC.GT.IL .AND. IC.LT.LENH ) THEN
               HP  = HBUF(IL+1:IC-1)
               ILX = LENB(HBUF(IC+1:LENH))+IC
               HXX = HBUF(ILX+1:LENH)
               HX  = HXX
               IF ( HP .EQ. 'TITLE' ) THEN
                  CALL GHCSTS(HHEAD,'TITL',HXX)
               ELSE IF ( HP .NE. 'SIZE' ) THEN
                  CALL GHPINQ(HP,HFMT)
                  IF ( HFMT .NE. '(A)' ) THEN
                     CALL CRADJ(HX)
                  ENDIF
                  CALL GHCSET(HHEAD,HP,HX)
               ENDIF
            ENDIF
*
 1200       CONTINUE 
               READ ( IFILE,'(A)',END=9000 ) HBUF
            IF ( HBUF(1:1) .EQ. '#' ) THEN
               GOTO 1200
            ENDIF
*
      GOTO 1100
         ENDIF
*
 9000 CONTINUE
      RETURN
      END
********************************************************************
      LOGICAL FUNCTION   LCHRN(C)
      CHARACTER  C
      LOGICAL    LCHRD
*
      LCHRN = LCHRD(C) .OR. (C.EQ.'-') .OR. (C.EQ.'.')
*
      RETURN
      END
