c-------------------------------------------------------------------------
c
c	GENSCR.FOR
c
c	This routine generates a subroutine interface to the screen
c	entry routine. InFile contains the name of the input file that
c	is read by this routine.
c
c	It is assumed that logical units 20, 21, 22 and 23 are free
c	when this routine is called.
c
c
c	The input file looks like this:
c
c	Horizontal length, Vertical length
c
c	Number of text strings
c
c	Row, column, video attributes ( NORMAL, REVERSE, INTENSE, BLINK )
c	Text
c
c	.
c	.
c	.
c
c	Number of fields
c
c	Variable type ( INTEGER, REAL, CHARACTER, LABEL, DATE, MENU )
c	Field length ( for reals, n.m   n=length, m=number of dec places )
c	Field Justification ( LEFT, RIGHT, CENTER, OR NONE )
c	Limits ( for numeric ) or "NULL (NOT )ALLOWED" ( for character or
c	  data   or blank ( for label )
c	Row, column, videl attributes ( NORMAL, REVERSE, INTENSE, BLINK )
c	First line of help text ( or blank if none )
c	Second line of help text ( or blank if none )
c	.
c	.
c	.
c
c
c
c	This routine will process the input file ( logical unit 20 ) and
c	write 2 output files
c
c
c     1  ) A file ( logical unit 21 ) containing data statements for
c	   the various tables used
c
c
c	2) A file ( logical unit 22 ) containing the following:
c
c	   FORTRAN parameter values ( i.e. parameter NI=#, ... )
c
c	   Character variable type declarations
c
c		character*1 Text(#)
c		character*1 Help(#)
c		character*1 Char(#)
c
c	   Other variable type declarations
c
c	   A copy of file 1
c
c	   The routine body
c
c		entry Clear
c		entry TextDsply
c		entry DataDsply
c		entry Edit
c
c-------------------------------------------------------------------------
c
	subroutine GenScr( InFile, OutFile )

	integer*2 MaxFields
	parameter (MaxFields = 250)

c--
c Screen table variables
c--
	integer*2 NI, NR, NC, NT, NFparm

	integer*2 IText, P1Text, P2Text, LText, RText, CText, AText

	integer*2 IntMin, IntMax, Isprs, IsprsVal

	real RealMin, RealMax, Rsprs, RsprsVal

	integer*2 P1Char, P2Char
	integer*2 IsNullOkChar

	integer*2 P1Help, P2Help, L1Help, P3Help, P4Help, L2Help,
     1   MaxHelp

	integer*2 FieldType, FieldElement, FieldJustify, FieldLength,
     1   FieldRow, FieldCol, FieldAttribute


c--
c For variable names
c--
	integer*2 VarType(MaxFields), StrLength(MaxFields)


c--
c For Screen help line
c--
	character*80 Menu


c--
c For formats
c--
	character*7 Format



c--
c For parse
c--
	integer*2 DimPntr, Pntr(2,10),
     1   WordLength(10), NumWords, ParseError

	character*82 InpLine
	character*80 Line, Line2
	character*1 Blank, Quote

c


c--
c For data files
c--
	character*10 InFile, DataFile, OutFile, ObjFle
	character*3 ObjFileExt
	integer*2 InLun, DataLun, OutLun
	character*20 Name
	integer*2 LN


c--
c For auxilary file
c--
	character*5 AuxFile
	integer*2 AuxLun
	character*32 FldName(MaxFields), PureName
	character*9 SysName
	character*4 PureSysName
	integer*2 MaxDim, ThisElement



c--
c Other variables
c--
	integer*2 ErrCode
	character*5 ScreenName
	character*1 SinglQuote
	integer*2 HorzLength, VertLength
	real RealNum
	integer*2 Display, L, LL, I, I1, NF
	logical*1 OldVer

c--
c Functions
c--
	integer*2 SysLun, Length
	character*3 ObjExt

c--
c Data statements
c--

	data DimPntr /10/
	data Blank /' '/, Quote /'"'/
	data InLun, DataLun, OutLun /20,21,22/
	data AuxLun /23/


c--
c Begin routine
c--

c--
c Initialize general variables
c--
	SinglQuote = char(39)
	Display = SysLun( 'Display' )

c--
c Get the routine name as the first five characters of the
c output file name ( not including the extension )
c--
c   >> Set up parse separator to be a period
c--
	call Parse( OutFile, Blank, Quote, '.',
     1   DimPntr, Pntr, WordLength, NumWords, ParseError )

	Name = ' '
	Name(1:5) = OutFile( Pntr(1,1):Pntr(2,1) )
	LN = Length( Name )
	if( LN .eq. 0 ) LN = 1

	ScreenName = Name(1:5)
	call CvtToUpCase( ScreenName )

	AuxFile = Name(1:5)

c--
c Get data file name as a temporary name
c--
	call CTmpNam( 'DTA', DataFile )


c--
c Open input file
c--
	call OpenSeq( InLun, InFile, 'Old', ErrCode )


c--
c Open output data file
c--
	call OpenSeq( DataLun, DataFile, 'Unknown', ErrCode )

c--
c Open auxilary file and write declarations
c--
	call DelFil( AuxFile//'.aux', ErrCode )
	call OpenSeq( AuxLun, AuxFile//'.aux', 'Unknown', ErrCode )

	write( AuxLun, 701 )
701	format( /,/,'c---', /, 'c  variable declarations', /,
     1    /,6x, 'integer*2 FirstFld, LastFld',
     1    /,6x, 'integer*2 Row, Col, CurField, TermKeys(30)',
     1    /,6x, 'integer*2 NumberOfFields',
     1    /,6x, 'integer*2 LastKey, FieldNumber',
     1    /,6x, 'logical*1 Next, Previous, Exit, Refresh, Valid', / )


c--
c Read version number info
c--
	read( InLun,4 ) InpLine
4	format(a)

c---
c Check for old version of .scr file, if version is less than 3.XX tell
c user to rebuld with fpaint and try again.

	call ChkVersion( InpLine, 3.00, OldVer )
	if( OldVer ) then
	  stop '[Old version screen file! - Rebuild with Fpaint]'
	end if


c--
c Read in horizontal length and vertical length
c--
	read( InLun, 5 ) HorzLength, VertLength
5	format(i2,1x,i2,/)


c--
c Read Menu Line
c--
	read( InLun, 6 ) Menu
6	format(a,/)
	if( Length(Menu) .lt. 80 ) then
	  do 7 I = Length(Menu)+1 , 80
	    Menu(I:I) = ' '
7	  continue
	end if


c--
c Initialize text variables
c--
	P1Text = 0
	P2Text = 0

c


c--
c Process all text strings
c--
	read( InLun, 10 ) NT
10	format(i3)

	write(Display,11)
11	format(1x,' ')

	do 1000 I = 1 , NT

	  write(Display,12) I
12	  format( 1x, 'Processing text field ', I3 )

	  call CsrUp(1)

	  read( InLun, 20 ) Line
20	  format(/,a)

	  call Parse( Line, Blank, Quote, ',:',
     1   DimPntr, Pntr, WordLength, NumWords, ParseError )

	  call GetInteger( Line(Pntr(1,1):Pntr(2,1)), RText )
	  call GetInteger( Line(Pntr(1,3):Pntr(2,3)), CText )

	  AText = 0
	  do  100 I1 = 5, NumWords, 2
	    if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'NORMAL' ) then
c	      do nothing
	    else if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'REVERSE' ) then
	      AText = AText + 1
	    else if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'INTENSE' ) then
	      AText = AText + 2
	    else if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'BLINK' ) then
	      AText = AText + 4
	    else if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'LINE' ) then
	      AText = AText + 8
	    else
	      call CsrDown(2)
	      write(Display,99)
99	      format(1x,'Unknown text display attribute encountered')
	      call CsrDown(1)
	    end if
100	  continue

	  read( InLun, 35 ) InpLine
35	  format(a)

	  call Parse( InpLine, Blank, Quote, ',:',
     1   DimPntr, Pntr, WordLength, NumWords, ParseError )

	  Line = ' '
	  Line = InpLine( Pntr(1,1):Pntr(2,1) )

	  LText = WordLength(1)
	  P1Text = P2Text+1
	  P2Text = P1Text + LText - 1
	  IText = IText + 1

	  write( DataLun, 40 ) IText, P1Text, LText, RText, CText, AText
40	  format(/,'      data (TextTable(I,',I3,'),I=1,5) /',
     1    I5,',',I2,',',I2,',',I2,',',I2,'/' )

	  call StrData( DataLun, 'Text',Line, LText, P1Text, P2Text )

1000	continue


c--
c Initialize field variables
c--
	P1Help = 0
	P2Help = 0
	P3Help = 0
	P4Help = 0
	P1Char = 0
	P2Char = 0
	NF = 0
	NI = 0
	NR = 0
	NC = 0

c--
c Now, process all field information
c--
	read( InLun, 1005 ) NF
1005	format(/,i3)

	call CsrDown(1)

	write( Display, 1010 )
1010	format( 1x, ' ' )

	do 2000 I = 1 , NF

	write( Display,1011 ) I
1011	format( 1x, 'Processing data field ', I3 )

	  call CsrUp(1)
c


c--
c Field type
c--
	  read( InLun, 1020 ) Line
1020	  format(/,a)

	  call CvtToUpCase( Line )

	  call Parse( Line, Blank, Quote, ',:',
     1   DimPntr, Pntr, WordLength, NumWords, ParseError )

	  if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'INTEGER' ) then
	    FieldType = 1
	    NI = NI + 1
	    FieldElement = NI
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'REAL' ) then
	    FieldType = 2
	    NR = NR + 1
	    FieldElement = NR
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'CHARACTER' ) then
	    FieldType = 3
	    NC = NC + 1
	    FieldElement = NC
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'LABEL' ) then
	    FieldType = 4
	    NC = NC + 1
	    FieldElement = NC
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'DATE' ) then
	    FieldType = 5
	    NC = NC + 1
	    FieldElement = NC
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'MENU' ) then
	    FieldType = 6
	    NC = NC + 1
	    FieldElement = NC
	  else
	    call CsrDown(2)
	    write( Display,5000 )
5000	    format( 1x,'Unknown field type encountered' )
	    call CsrDown(1)

	  end if

	  VarType(I) = FieldType

c--
c Read field name
c--
	read( InLun,4 ) FldName(I)


c--
c Field length ( Get length and build format )
c--
	  read( Inlun, 1030 ) Line
1030	  format(a)

c ---     when getting field length, ignore decimal part of length
c ---     for all but real type ( FieldType = 2 ).

c	  if( FieldType .eq. 2 ) then

c	    call Parse( Line, Blank, Quote, ' ',
c    1       DimPntr, Pntr, WordLength, NumWords, ParseError )

c	  else

c ---                        this will get rid of the decimal part
c ---                                        v
c	    call Parse( Line, Blank, Quote, '.',
c    1       DimPntr, Pntr, WordLength, NumWords, ParseError )

c	  end if

	  L = Length(Line)
	  if( L .lt. 2 ) L = 2
	  call GetReal( Line(2:L), RealNum )
	  FieldLength = int( RealNum )

	  StrLength(I) = FieldLength

	  call UpDtArrayInfo( I, FldName(I), VarType(I), StrLength(I) )



	  Format = ' '
	  Format = Line
c

c--
c Field Justification
c--
	  read( InLun, 1055 ) Line
1055	  format(a)

	  call CvtToUpCase( Line )

	  call Parse( Line, Blank, Quote, ' ',
     1     DimPntr, Pntr, WordLength, NumWords, ParseError )


	  if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'NONE' ) then
	    FieldJustify = 0
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'LEFT' ) then
	    FieldJustify = 1
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'RIGHT' ) then
	    FieldJustify = 2
	  else if( Line(Pntr(1,1):Pntr(2,1)) .eq. 'CENTER' ) then
	    FieldJustify = 3
	  end if


c--
c Limits ( for numeric ) or Null entry status
c--
	  read( InLun, 1056 ) Line
1056	  format(a)

	  call CvtToUpCase( Line )

	  call Parse( Line, Blank, Quote, ',:/',
     1   DimPntr, Pntr, WordLength, NumWords, ParseError )

	  if( FieldType .eq. 4 ) then
	    IsNullOkChar = 0

	  else if( FieldType .eq. 1 ) then
	    call GetInteger( Line(Pntr(1,1):Pntr(2,1)), IntMin )
	    call GetInteger( Line(Pntr(1,3):Pntr(2,3)), IntMax )
	    if( NumWords .ge. 7 ) then
	    if( Line(Pntr(1,5):Pntr(2,5)) .eq. 'SUPPRESS' ) then
	      call GetInteger( Line(Pntr(1,7):Pntr(2,7)) , IsprsVal )
	      Isprs = 1
	      if( NumWords .eq. 9 ) then
	        if( Line(Pntr(1,9):Pntr(2,9)) .eq. 'ILLEGAL' ) Isprs=2
	      end if
	    else
	      Isprs = 0
	      IsprsVal = 0
	    end if
	    else
	      Isprs = 0
	      IsprsVal = 0
	    end if

	  else if( FieldType .eq. 2 ) then
	    call GetReal( Line(Pntr(1,1):Pntr(2,1)), RealMin )
	    call GetReal( Line(Pntr(1,3):Pntr(2,3)), RealMax )
	    if( NumWords .ge. 7 ) then
	    if( Line(Pntr(1,5):Pntr(2,5)) .eq. 'SUPPRESS' ) then
	      call GetReal( Line(Pntr(1,7):Pntr(2,7)) , RsprsVal )
	      Rsprs = 1.0
	      if( NumWords .eq. 9 ) then
	        if( Line(Pntr(1,9):Pntr(2,9)) .eq. 'ILLEGAL' ) Rsprs=2.0
	      end if
	    else
	      Rsprs = 0.0
	      RsprsVal = 0.0
	    end if
	    else
	      Rsprs = 0.0
	      RsprsVal = 0.0
	    end if

	  else
	    if( Line( Pntr(1,2):Pntr(2,2) ) .eq. 'NOT' ) then
	      IsNullOkChar = 0
	    else
	      IsNullOkChar = 1
	    end	if
	  end if
c


c--
c Row, column, display attributes
c--

	  read( InLun, 1080 ) Line
1080	  format(a)

	  call CvtToUpCase( Line )

	  call Parse( Line, Blank, Quote, ',:',
     1   DimPntr, Pntr, WordLength, NumWords, ParseError )

	  call GetInteger( Line(Pntr(1,1):Pntr(2,1)), FieldRow )
	  call GetInteger( Line(Pntr(1,3):Pntr(2,3)), FieldCol )

	  FieldAttribute = 0
	  do  1100 I1 = 5, NumWords, 2
	    if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'NORMAL' ) then
c	      do nothing
	    else if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'REVERSE' ) then
	      FieldAttribute = FieldAttribute + 1
	    else if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'INTENSE' ) then
	      FieldAttribute = FieldAttribute + 2
	    else if( Line(Pntr(1,I1):Pntr(2,I1)) .eq. 'BLINK' ) then
	      FieldAttribute = FieldAttribute + 4
	    else
	      call CsrDown(2)
	      write( Display,5001 )
5001	      format( 1x,'Unknown field display attribute encountered' )
	      call CsrDown(1)

	    end if
1100	  continue

c--
c Write field table to data file
c--

	  write( DataLun, 1110 ) I, FieldType, FieldElement,
     1    FieldJustify, FieldLength, FieldRow, FieldCol,
     1    FieldAttribute

1110	  format( /,'      data (FldTable(I,',i5,'),I=1,7) / ',
     1    i1,',',i5,',',i1,',',i2,',',i2,',',i2,',',i1,' /' )

	  if( FieldType .eq. 1 ) then
	    write( DataLun, 1115 ) FieldElement, IntMin, IntMax,
     1      Isprs, IsprsVal
1115 	    format( '      data (IntArray(I,',i5,'),I=2,5) / ',/,
     1      '     1   ',i12,',',i12,',',I1,',',I12,' /' )
	  end if

	  if( FieldType .eq. 2 ) then
	    write( DataLun, 1116 ) FieldElement, RealMin, RealMax,
     1      Rsprs, RsprsVal
1116 	    format( '      data (RealArray(I,',i5,'),I=2,5) /',/,
     1      '     1   ',g14.6,',',g14.6,',',f3.1,',',g14.6,' /' )
	  end if
c


	  if( FieldType .eq. 3 .or. FieldType .eq. 4 .or.
     1        FieldType .eq. 5 .or. FieldType .eq. 6 ) then

 	    P1Char = P2Char + 1
	    P2Char = P1Char + FieldLength - 1
	    write( DataLun, 1120 ) FieldElement, P1Char,
     1      IsNullOkChar
1120	    format( '      data (CharTable(I,',i5,'),I=1,2) / ',
     1      i5,',',i1,' /' )

	  end if

c--
c Help text
c--
	  read( InLun, 1130 ) Line
1130	  format(a)

	  L1Help = Length( Line )
	  if( L1Help .gt. 0 ) then
	    P1Help = MaxHelp + 1
	    P2Help = P1Help + L1Help - 1
	    MaxHelp = P2Help
	  else
	    P1Help = 0
	    P2Help = 0
	  end if

	  read( InLun, 1130 ) Line2

	  L2Help = Length( Line2 )
	  if( L2Help .gt. 0 ) then
	    P3Help = MaxHelp + 1
	    P4Help = P3Help + L2Help - 1
	    MaxHelp = P4Help
	  else
	    P3Help = 0
	    P4Help = 0
	  end if

c--
c write help info
c--
	  write( DataLun, 1140 ) I, P1Help, L1Help, P3Help, L2Help
1140	  format( '      data (HelpTable(I,',i5,'),I=1,4) / ',
     1    i5,',',i5,',',i5,',',i5,' /' )

c
	  if( P1Help .gt. 0 ) then
	    call StrData( DataLun,'Help',Line,L1Help,P1Help,P2Help )
	  end if

	  if( P3Help .gt. 0 ) then
	    call StrData( DataLun,'Help',Line2,L2Help,P3Help,P4Help )
	  end if


c--
c Write format data
c--
	write( DataLun, 1210 ) I, SinglQuote, Format, SinglQuote
1210	format( '      data Formats(',i5,') / ', a1, a7, a1, '/' )



2000	continue


c==========================================================================
c
c	Write Field declarations

	do 3900 I = 1 , NF

c---
c write the type declarations to the auxillary file

	  call GetMaxDim( I, FldName(I), MaxDim, PureName,
     1      ThisElement )

	  if( VarType(I) .eq. 1 ) then

	    if( MaxDim .eq. 0 ) then
	      write( AuxLun, 4100 ) FldName(I)(1:Length(FldName(I)))
4100	      format( 6x, 'integer*2 ', a )
	    else if( MaxDim .eq. ThisElement ) then
	      write( AuxLun, 4101 ) PureName(1:Length(PureName)),
     1          MaxDim
4101	      format( 6x, 'integer*2 ', a, '(', i3, ')' )
	    end if

	  else if( VarType(I) .eq. 2 ) then

	    if( MaxDim .eq. 0 ) then
	      write( AuxLun, 4105 ) FldName(I)(1:Length(FldName(I)))
4105	      format( 6x, 'real ', a )
	    else if( MaxDim .eq. ThisElement ) then
	      write( AuxLun, 4106 ) PureName(1:Length(PureName)),
     1          MaxDim
4106	      format( 6x, 'real ', a, '(', i3, ')' )
	    end if

	  else

	    if( MaxDim .eq. 0 ) then
	      write( AuxLun, 4110 ) StrLength(I),
     1          FldName(I)(1:Length(FldName(I)))
4110	      format( 6x, 'character* ', i2, ' ', a )
	    else if( MaxDim .eq. ThisElement ) then
	      write( AuxLun, 4111 ) StrLength(I),
     1          PureName(1:Length(PureName)), MaxDim
4111	      format( 6x, 'character* ', i2, ' ', a, '(', i3, ')' )
	    end if

	  end if

3900	continue


	call CsrDown(2)

c---
c Write the standard termkeys definition
	write( AuxLun, 715 )
715	format( /, 'c---', /, 'c Normal termination on F1 key'
     1                     /, 'c immediate termination on F2 key'
     1          /, 6x, 'data TermKeys/ 1, 141, 1, 142, 26*0 /' )

c---
c Write the defaults

	write( AuxLun, 7020 )
7020	format( /, 'c---', /, 'c Default variable initialization' )
  
	do 7061 I = 1 , NF

	  if( VarType(I).eq.1 ) then

	    write( AuxLun, 7030 ) FldName(I)(1:Length(FldName(I)))
7030	    format( 6x, 'data ', a, ' /0/' )

	  else if( VarType(I).eq.2 ) then

	    write( AuxLun, 7040 ) FldName(I)(1:Length(FldName(I)))
7040	    format( 6x, 'data ', a, ' /0.0/' )

	  else if( VarType(I).eq.5 ) then

	    write( AuxLun, 7050 ) FldName(I)(1:Length(FldName(I))),
     1        char(39), char(39)
7050	    format( 6x, 'data ', a, ' /',a1,' ',a1,'/' )

	  else

	    write( AuxLun, 7060 ) FldName(I)(1:Length(FldName(I))),
     1        char(39), char(39)
7060	    format( 6x, 'data ', a, ' /',a1,' ',a1,'/' )

	  end if

7061	continue

c---
c Write variable initialization

	write( AuxLun, 7001 )
7001	format( /, 'c---', /, 'c Screen origin',
     1          /, 6x, 'data Row, Col / 1, 1 /' )

	write( AuxLun, 7002 )
7002	format( /, 'c---', /, 'c TTY initialization',
     1          /, 6x, 'call TTYinit',
     1          /, 6x, 'call EchoOff',
     1          /, 6x, 'call KpdOn' )

	write( AuxLun, 7010 )
7010	format( /, 'c---', /, 'c Starting edit field',
     1          /, 6x, 'CurField = 1' )

c---
c write the screen calls to the auxillary file


	write( AuxLun, 720 )
720	format( /,'c---',/,'c Total number of screen parameters' )

	write( AuxLun, 730 ) NF
730	format( /, 6x, 'NumberOfFields = ',i3 )

	write( AuxLun, 735 )

735	format( /,'c---',/,'c Default limits',//,
     1          6x, 'FirstFld = 1',/,
     1          6x, 'LastFld = NumberOfFields',/ )

	write( AuxLun, 740 )
740	format( /, 'c---', /,'c Clear the screen region' )

	write( AuxLun, 750 ) Name(1:LN)
750	format( /, 1x, '10', 5x, 'call ',a,'Clear( Row, Col )' )

	write( AuxLun, 760 )
760	format( /, 'c---', /,'c Display the Text fields' )

	write( AuxLun, 770 ) Name(1:LN)
770	format( /, 6x, 'call ', a,
     1    'TextDsp( Row, Col )' )

	write( AuxLun, 780 )
780	format( /, 'c---', /,'c Display the Data fields' )

	write( AuxLun, 790 ) Name(1:LN)
790	format( /, 6x, 'call ', a,
     1    'DataDsp( Row, Col, FirstFld, LastFld' )

c -- Write the parameters
	if( NF .gt. 0 ) call WrtParms( AuxLun, NF, FldName, 0 )

	write( AuxLun, 810 )
810	format( 5x, '1 )', / )

	write( AuxLun, 820 )
820	format( /, 'c---', /,'c Edit the Data fields' )

	write( AuxLun, 830 ) Name(1:LN)
830	format( /, 1x, '20', 5x, 'call ',a,
     1   'Edit( Row, Col, FirstFld, LastFld, CurField, TermKeys' )

c -- Write the parameters
	if( NF .gt. 0 ) call WrtParms( AuxLun, NF, FldName, 0 )

	write( AuxLun, 850 )
850	format( 5x, '1, Next, Previous, Exit, Refresh, LastKey )',/,/ )

c -- Write the logic processing
	write( AuxLun, 7070 )
7070	format( /, 6x, 'if( Refresh ) then',
     1          /, 10x, 'goto 10',
     1          /, 6x, 'else if( Next ) then',
     1          /, 10x, 'CurField = 1',
     1          /, 10x, 'goto 20',
     1          /, 6x, 'else if( Previous ) then',
     1          /, 10x, 'CurField = NumberOfFields',
     1          /, 10x, 'goto 20',
     1          /, 6x, 'else if( .not. Exit ) then',
     1          /, 10x, 'goto 20',
     1          /, 6x, 'end if', / )


	write( AuxLun, 811 )
811	format( /, 'c---', /,'c Validate the Data fields' )

	write( AuxLun, 812 ) Name(1:LN)
812	format( /, 6x, 'call ',a,'Validate( FirstFld, LastFld' )

c -- Write the parameters
	if( NF .gt. 0 ) then
	  call WrtParms( AuxLun, NF, FldName, 0 )
	  write( AuxLun, 813 )
813	  format( 5x, '1, Valid, FieldNumber )', / )
	else
	  write( AuxLun, 814 )
814	  format( 5x, '1 Valid, FieldNumber )', / )
	end if

c -- Write the logic processing
	write( AuxLun, 7080 )
7080	format( 6x, 'if( .not. Valid ) then',
     1          /, 10x, 'CurField = FieldNumber',
     1          /, 10x, 'goto 20',
     1          /, 6x, 'end if', / )


	write( AuxLun, 860 )
860	format( 6x, 'call TTYinit', /,
     1          6x, 'call EchoOn', /,
     1          6x, 'call KpdOff', //,
     1          6x, 'End' )

	close( AuxLun )
	close( unit=InLun )
	close( unit=DataLun )
c


c--
c Now open the output file and write all information
c--
	call DelFil( OutFile, ErrCode )
	ObjFileExt = ObjExt(0)
	ObjFle = AuxFile // '.' // ObjFileExt
	call DelFil( ObjFle, ErrCode )
	call OpenSeq( OutLun, OutFile, 'Unknown', ErrCode )

c--
c subroutine header
c--
	Name(LN+1:LN+7) = 'Package'
	write( OutLun, 2001 )Name(1:LN+7)
2001	format( '      subroutine ',a,// )


c--
c FORTRAN Parameter statements
c--
	NFparm = NF
	if( NF .eq. 0 ) NFparm = 1
	if( NI .eq. 0 ) NI = 1
	if( NR .eq. 0 ) NR = 1
	if( NC .eq. 0 ) NC = 1
	if( NT .eq. 0 ) NT = 1

	if( P2Text .lt. 1 ) P2Text = 1
	if( P2Char .lt. 1 ) P2Char = 1
	if( MaxHelp .lt. 1 ) MaxHelp = 1

	write( OutLun, 2009 )
2009	format(
     1    '      integer*2 NF, NI, NR, NC, NT, NdimT, NdimC',
     1    /,'      integer*2 NdimH, IEle, L, I',/ )


	write( OutLun, 2010 ) NFparm, NI, NR, NC, NT
2010	format( '      parameter ( NF=',i3,',NI=',i3,',NR=',i3,',NC=',
     1   i3,',NT=',i3,' )' )

	write( OutLun, 2011 ) P2Text, P2Char, MaxHelp
2011	format( '      parameter ( NdimT=',i5,',NdimC=',i5,
     1   ',NdimH=',i5,' )',/ )



c--
c Parameter declarations
c--
	write( OutLun, 6105 )
6105	format( '      integer*2 Row, Col, StartField,',
     1   ' TermKeys(30), LastKey',/,
     1   '      integer*2 First, Last',/,
     1   '      logical*1 Next, Previous, Exit, Refresh',/,
     1   '      character*80 ScrHelpLine',/,
     1   '      integer*2 FieldNumber',/,
     1   '      logical*1 Valid',/ )

	do 7000 I = 1 , NF

c---
c write the type declarations to the output file

	  call GetMaxDim( I, FldName(I), MaxDim, PureName,
     1      ThisElement )

	  call BldSysName( I, FldName(I), SysName, PureSysName )

	  if( VarType(I) .eq. 1 ) then

	    if( MaxDim .eq. 0 ) then
	      write( OutLun, 4100 ) SysName(1:Length(SysName))
	    else if( MaxDim .eq. ThisElement ) then
	      write( OutLun, 4101 ) PureSysName(1:Length(PureSysName)),
     1          MaxDim
	    end if

	  else if( VarType(I) .eq. 2 ) then

	    if( MaxDim .eq. 0 ) then
	      write( OutLun, 4105 ) SysName(1:Length(SysName))
	    else if( MaxDim .eq. ThisElement ) then
	      write( OutLun, 4106 ) PureSysName(1:Length(PureSysName)),
     1          MaxDim
	    end if

	  else

	    if( MaxDim .eq. 0 ) then
	      write( OutLun, 4110 ) StrLength(I),
     1          SysName(1:Length(SysName))
	    else if( MaxDim .eq. ThisElement ) then
	      write( OutLun, 4111 ) StrLength(I),
     1          PureSysName(1:Length(PureSysName)), MaxDim
	    end if

	  end if

7000	continue
c


c--
c Character workspace variable declarations
c--
	write( OutLun, 2020 )
2020	format( /,'      character*1 Text(NdimT)' )

	write( OutLun, 2030 )
2030	format( '      character*1 Char(NdimC)' )

	write( OutLun, 2040 )
2040	format( '      character*1 Help(NdimH)' )


c--
c Format array
c--
	write( OutLun, 2045 )
2045	format( /,'      character*7 Formats(NF)' )


c--
c Table variable declarations
c--
	write( OutLun, 2050 )
2050	format( /,'      integer*2 TextTable(5,NT), FldTable(7,NF),',
     1   ' IntArray(5,NI)',/,
     1   '      integer*2 CharTable(2,NC), HelpTable(4,NF)',/,
     1   '      real RealArray(5,NR) ',/ )


c--
c Write screen help line value as a data statement
c--
	write( OutLun, 2060 ) SinglQuote, Menu(1:40), SinglQuote,
     1   SinglQuote, Menu(41:80), SinglQuote
2060	format(
     1   '      data ScrHelpLine(1:40) /',/,
     1   '     1   ',a1,a40,a1,'/',/
     1   '      data ScrHelpLine(41:80) /',/,
     1   '     1   ',a1,a40,a1,'/',/ )


c--
c Copy data file into output file at this point
c--

	call OpenSeq( DataLun, DataFile, 'Old', ErrCode )

3000	continue
	read( DataLun, 3010, end=3100 ) Line
3010	format(a)
	if( Length(Line) .gt. 0 ) then
	  write( OutLun, 3010 ) Line(1:Length(Line))
	else
	  write( OutLun, 3011 )
3011	  format( ' ' )
	end if
	goto 3000
3100	continue
c


c--
c clear entry
c--
	Name(LN+1:LN+5) = 'Clear'
	write( OutLun, 10000 ) Name(1:LN+5)
10000	format( //,'      entry ',a,'( Row, Col )' )

	write( OutLun, 10010 ) HorzLength, VertLength
10010	format( //,'      call ClearScrn( Row, Col, ',i2,', ',i2,' )',
     1   //, '      return',/ )
c


c--
c Text Display entry
c--
	Name(LN+1:LN+7) = 'TextDsp'
	write( OutLun, 10011 ) Name(1:LN+7)
10011	format( //,'      entry ',a,'( Row, Col )' )

c--
c write call to the display text routine
c--


	write( OutLun, 10012 )
10012	format( /, '      call DsplyText( Row, Col,',/,
     1   '     1   NT, TextTable, NdimT, Text )' )

c--
c return
c--
	write( OutLun, 10013 )
10013	format( /,'      return' )



c--
c Data Display entry
c--

	write( OutLun, 11001 ) Name(1:LN)
11001	format( /, 6x, 'entry ', a,
     1    'DataDsp( Row, Col, First, Last' )

c -- Write the parameters
	if( NF .gt. 0 ) call WrtSysParms( OutLun, NF, FldName, 0 )

	write( OutLun, 11002 )
11002	format( 5x, '1 )', / )


c--
c Write the assignments
c--
	do 12000 I = 1 , NF

	  call BldSysName( I, FldName(I), SysName, PureSysName )

	  LL = Length( SysName )

	  write( OutLun, 12006 )
12006	  format(' ')

	  if( VarType(I) .eq. 1 ) then
	    write( OutLun, 12110 ) I, SysName(1:LL)
12110	    format( '      IntArray(1,FldTable(2,',i3,')) = ', a )

	  else if( VarType(I) .eq. 2 ) then
	    write( OutLun, 12120 ) I, SysName(1:LL)
12120	    format( '      RealArray(1,FldTable(2,',i3,')) = ', a )

	  else
	    write( OutLun, 12130 ) I
12130	    format( '      IEle = FldTable(2,',i3,')' )
	    write( OutLun, 12135 ) I
12135	    format( '      L = FldTable(4,',i3,')' )
	    write( OutLun, 12140 ) SysName(1:LL)
12140	    format(
     1      '      call ANtoA1( ', a, /, 5x, '1  ',
     1      ', NdimC, Char, CharTable(1,IEle), L )' )
	  end if

12000	continue
c


c--
c write call to the display data routine
c--

	write( OutLun, 13000 )
13000	format( /, '      call DsplyData( Row, Col, First, Last,',/,
     1   '     1   NF, FldTable,',/,
     1   '     1   NI, IntArray, NR, RealArray, NC, CharTable,',
     1   ' NdimC, Char,',/,
     1   '     1   Formats )' )

c--
c return
c--
	write( OutLun, 13010 )
13010	format( /,'      return' )


c--
c Data validation entry
c--

	write( OutLun, 21001 ) Name(1:LN)
21001	format( /, 6x, 'entry ',a,'Validate( First, Last' )

c -- Write the parameters
	if( NF .gt. 0 ) then
	  call WrtSysParms( OutLun, NF, FldName, 0 )
	  write( OutLun, 21002 )
21002	  format( 5x, '1, Valid, FieldNumber )', / )
	else
	  write( OutLun, 21003 )
21003	  format( 5x, '1, Valid, FieldNumber )', / )
	end if



c--
c Write the assignments
c--
	do 22000 I = 1 , NF

	  call BldSysName( I, FldName(I), SysName, PureSysName )

	  LL = Length( SysName )

	  write( OutLun, 22007 )
22007	  format(' ')

	  if( VarType(I) .eq. 1 ) then
	    write( OutLun, 22110 ) I, SysName(1:LL)
22110	    format( '      IntArray(1,FldTable(2,',i3,')) = ', a )

	  else if( VarType(I) .eq. 2 ) then
	    write( OutLun, 22120 ) I, SysName(1:LL)
22120	    format( '      RealArray(1,FldTable(2,',i3,')) = ', a )

	  else
	    write( OutLun, 22130 ) I
22130	    format( '      IEle = FldTable(2,',i3,')' )
	    write( OutLun, 22135 ) I
22135	    format( '      L = FldTable(4,',i3,')' )
	    write( OutLun, 22140 ) SysName(1:LL)
22140	    format(
     1      '      call ANtoA1( ',a, /, 5x, '1  ',
     1      ', NdimC, Char, CharTable(1,IEle), L )' )
	  end if

22000	continue
c


c--
c write call to the Validate data routine
c--

	write( OutLun, 23000 ) SinglQuote, ScreenName,
     1    SinglQuote

23000	format( /, '      call VldWholeScreen( First, Last,',
     1   ' NF, FldTable,',/,
     1   '     1   NI, IntArray, NR, RealArray, NC, CharTable,',
     1   ' NdimC, Char,',/,
     1   '     1   ', a1, a, a1, ', Valid, FieldNumber )' )

c--
c return
c--
	write( OutLun, 23010 )
23010	format( /,'      return' )


c--
c Edit entry
c--

	write( OutLun, 3001 ) Name(1:LN)
3001	format( /, 6x, 'entry ',a,
     1   'Edit( Row, Col, First, Last, StartField, TermKeys' )

c -- Write the parameters
	if( NF .gt. 0 ) call WrtSysParms( OutLun, NF, FldName, 0 )

	write( OutLun, 3005 )
3005	format( 5x, '1, Next, Previous, Exit, Refresh, LastKey )',/ )


c--
c Write the assignments
c--
	do 4000 I = 1 , NF

	  call BldSysName( I, FldName(I), SysName, PureSysName )

	  LL = Length( SysName )

	  write( OutLun, 3006 )
3006	  format(' ')

	  if( VarType(I) .eq. 1 ) then
	    write( OutLun, 3110 ) I, SysName(1:LL)
3110	    format( '      IntArray(1,FldTable(2,',i3,')) = ', a )

	  else if( VarType(I) .eq. 2 ) then
	    write( OutLun, 3120 ) I, SysName(1:LL)
3120	    format( '      RealArray(1,FldTable(2,',i3,')) = ', a )

	  else
	    write( OutLun, 3130 ) I
3130	    format( '      IEle = FldTable(2,',i3,')' )
	    write( OutLun, 3135 ) I
3135	    format( '      L = FldTable(4,',i3,')' )
	    write( OutLun, 3140 ) SysName(1:LL)
3140	    format(
     1      '      call ANtoA1( ',a, /, 5x, '1  ',
     1      ', NdimC, Char, CharTable(1,IEle), L )' )


	  end if

4000	continue


c--
c write call to the general screen edit routine
c--

	write( OutLun, 8000 ) SinglQuote, ScreenName,
     1    SinglQuote
8000	format( /, '      call EditScrn( ', a1, a, a1,
     1   ', Row, Col, First, Last, StartField,',/,
     1   '     1   ScrHelpLine, TermKeys, NF, FldTable,',/,
     1   '     1   NI, IntArray, NR, RealArray, NC, CharTable,',
     1   ' NdimC, Char,',/,
     1   '     1   Formats, HelpTable, NdimH, Help, ',
     1   'Next, Previous, Exit,',
     1   /,'     1   Refresh, LastKey )' )
c


c--
c Now, write the reverse assignments
c--
	do 9000 I = 1 , NF

	  call BldSysName( I, FldName(I), SysName, PureSysName )

	  LL = Length( SysName )

	  write( OutLun, 8015 )
8015	  format(' ')

	  if( VarType(I) .eq. 1 ) then
	    write( OutLun, 8110 ) SysName(1:LL), I
8110	    format( '      ', a, ' = IntArray(1,FldTable(2,',i3,'))' )

	  else if( VarType(I) .eq. 2 ) then
	    write( OutLun, 8120 ) SysName(1:LL), I
8120	    format( '      ', a, ' = RealArray(1,FldTable(2,',i3,'))' )

c--
c don't include label types ( they are input only )
c--
	  else if( VarType(I) .ne. 4 ) then
	    write( OutLun, 8130 ) I
8130	    format( '      IEle = FldTable(2,',i3,')' )
	    write( OutLun, 8135 ) I
8135	    format( '      L = FldTable(4,',i3,')' )
	    write( OutLun, 8140 ) SysName(1:LL)
8140	    format(
     1      '      call A1toAN( NdimC, Char, CharTable(1,IEle), L, ',
     1      /, 5x, '1  ', a,' )' )


	  end if

9000	continue


c--
c return
c--
	write( OutLun, 9010 )
9010	format( /, '      return',/,'      end' )


	if( NF .gt. 0 ) then

c--
c Write the variable name to index function
c--

	  Name(LN+1:LN+3) = 'Ind'
	  write( OutLun, 9100 ) Name(1:LN+3)
9100	  format( //,'      integer*2 function ',a,'( Name )' )

	  write( OutLun, 9200 ) NF
9200	  format( /,'      integer*2 I', /,
     1      '      character*(*) Name', /,
     1      '      character*32 LocName', /,
     1      '      character*32 FldName(',i3,')' )

	  do 9300 I = 1 , NF
	    call CvtToUpCase( FldName(I) )
	    L = Length( FldName(I) )
	    write( OutLun, 9250 ) I, char(39), FldName(I)(1:L), char(39)
9250	    format( '      data FldName(',i3,') /',a1,a,a1,'/' )
9300	  continue

	  write( OutLun, 9400 ) NF, Name(1:LN+3), Name(1:LN+3)
9400	  format( /, '      LocName = Name', /,
     1      '      call CvtToUpCase( LocName )', /,
     1      '      do 100 I = 1 , ', i3, /,
     1      '        if( FldName(I) .eq. LocName ) then', /,
     1      '          ', a, ' = I', /,
     1      '          return', /
     1      '        end if', /,
     1      '100   continue', //,
     1      '      ', a, ' = 0', //,
     1      '      end' )

	end if

	close( unit=OutLun )
	close( unit=DataLun, status='delete' )

	end
c

	subroutine StrData( Unit, VarName, String, Lnth, P1, P2 )

	character*(*) VarName, String
	integer*2 Unit, Lnth, P1, P2, N, I1, I2, I, J

	character*1 SngQuote

	integer*2 Length

	SngQuote = char(39)

c--
c change single quotes to reverse single quotes
	do 5 I = 1 , Length(String)
	  if( String(I:I) .eq. SngQuote ) String(I:I) = '`'
5	continue


	write( Unit, 10 ) VarName, P1, P2
10	format( '      data (',a,'(I),I=',i5,',',i5,') /' )

	if( Lnth .ne. 1 ) then

	  N = ( Lnth-1 ) / 15
	  I1 = 1
	  I2 = 15
	  do 100 I = 1 , N
	    write( Unit, 20 ) ( SngQuote,String(J:J),SngQuote,J=I1,I2 )
20	    format( '     1   ',15(3a1,',') )
	    I1 = I1 + 15
	    I2 = I2 + 15
100	  continue

	  I2 = I2 - 15 + mod( Lnth-1,15 )
	  if( I2 .ge. I1 ) then
	    write( Unit, 20 ) ( SngQuote,String(J:J),SngQuote,J=I1,I2 )
	  end if

	end if

	write( Unit,110 ) SngQuote,String(Lnth:Lnth),SngQuote
110	format( '     1   ',3a1,' /' )

	return
	end


	subroutine BuildVarName( Prefix, Int, Name )

	character*1 Prefix
	integer*2 Int
	character*4 Name

	character*3 Tmp

	write( Tmp, 10 ) Int
10 	format( i3 )

	call LeftJustify( Tmp )
	Name(1:1) = Prefix
	Name(2:4) = Tmp(1:3)

	return
	end



	subroutine WrtParms( Unit, NF, FldName, CommaControl )

c--
c if CommaControl = 1 then suppress first comma in parm list
c--

	integer*2 Unit, NF, CommaControl
	character*32 FldName(NF)

	character*72 Buffer
	integer*2 I
	logical*1 WriteIt, NoComma

	integer*2 MaxDim, Element
	character*32 PureName

	integer*2 Length

	Buffer = '     1  '
	I = 1

795	continue

	  if( I .eq. 1 .and. CommaControl .eq. 1 ) then
	    NoComma = .true.
	  else
	    NoComma = .false.
	  end if

	  call GetMaxDim( I, FldName(I), MaxDim, PureName, Element )
	  if( MaxDim .eq. 0 ) then
	    call BldParmLine( NoComma, FldName(I), Buffer, WriteIt )
	  else if( MaxDim .eq. Element ) then
	    call BldParmLine( NoComma, PureName, Buffer, WriteIt )
	  end if

	  if( WriteIt ) then
	    write( Unit, 800 ) Buffer(1:Length(Buffer))
800	    format( a )
	    Buffer = '     1  '
	  else
	    I = I + 1
	  end if
	if( I .gt. NF ) goto 805

	goto 795

805	write( Unit, 800 ) Buffer(1:Length(Buffer))

	end


	subroutine WrtSysParms( Unit, NF, FldName, CommaControl )

c--
c if CommaControl = 1 then suppress first comma in parm list
c--

	integer*2 Unit, NF, CommaControl
	character*32 FldName(NF)

	character*9 SysName
	character*4 PureSysName

	character*72 Buffer
	integer*2 I
	logical*1 WriteIt, NoComma

	integer*2 MaxDim, Element
	character*32 PureName

	integer*2 Length

	Buffer = '     1  '
	I = 1

795	continue

	  if( I .eq. 1 .and. CommaControl .eq. 1 ) then
	    NoComma = .true.
	  else
	    NoComma = .false.
	  end if

	  call BldSysName( I, FldName(I), SysName, PureSysName )

	  call GetMaxDim( I, FldName(I), MaxDim, PureName, Element )
	  if( MaxDim .eq. 0 ) then
	    call BldParmLine( NoComma, SysName, Buffer, WriteIt )
	  else if( MaxDim .eq. Element ) then
	    call BldParmLine( NoComma, PureSysName, Buffer, WriteIt )
	  end if

	  if( WriteIt ) then
	    write( Unit, 800 ) Buffer(1:Length(Buffer))
800	    format( a )
	    Buffer = '     1  '
	  else
	    I = I + 1
	  end if
	if( I .gt. NF ) goto 805

	goto 795

805	write( Unit, 800 ) Buffer(1:Length(Buffer))

	end


	subroutine BldParmLine( NoComma, FldName, Buffer, WriteIt )

	character*(*) FldName
	character*72 Buffer
	logical*1 NoComma, WriteIt

	integer*2 L1, L2, Length

	L1 = Length( FldName )
	L2 = Length( Buffer )

	if( L1+L2+2 .gt. 72 ) then
	  WriteIt = .true.
	else
	  WriteIt = .false.
	  if( NoComma ) then
	    Buffer = Buffer(1:L2) // '  ' // FldName
	  else
	    Buffer = Buffer(1:L2) // ', ' // FldName
	  end if
	end if

	end


	subroutine UpDtArrayInfo( II, ThisName, Type, Lenth )

c--
c parameters

	integer*2 II, Type, Lenth
	character*32 ThisName

	integer*2 Max, ThisElement
	character*32 ThisPureName

c--
c locals

	integer*2 MaxFields
	parameter ( MaxFields=250 )

	integer*2 NumArrays, MaxDim(MaxFields),
     1    Index, I, Element, ArrayType(MaxFields),
     1    ArrayLenth(MaxFields)
	character*32 Name, PureName, ArrayNames(MaxFields)
	logical*1 NotAnArray, InList

c--
c functions

	integer*2 SysLun, Length


	data NumArrays /0/


c--
c see if Name is an array

	Name = ThisName

	call CvtToUpCase( Name )

	call CheckIfArray( II, Name, NotAnArray, PureName, Element )

	if( NotAnArray ) return

c--
c Name is an array, see if already in the list

	InList = .false.
	do 20 I = 1 , NumArrays
	  if( PureName .eq. ArrayNames(I) ) then
	    InList = .true.
	    Index = I
	    goto 30
	  end if
20	continue
30	continue

	if( InList ) then
	  if( Type .ne. ArrayType(Index) ) call TypeMismatch( Name )
	  if( Element .gt. MaxDim(Index) ) MaxDim(Index) = Element

c -- if type is a character the check for length consistency
	  if( Type .ge. 3 .and. Type .le. 6 ) then
	    if( Lenth .ne. ArrayLenth(Index) ) call LenthMismatch(Name)
	  end if

	else
	  NumArrays = NumArrays + 1
	  if( NumArrays .gt. MaxFields ) call TooManyFields( Name )
	  ArrayNames(NumArrays) = PureName
	  MaxDim(NumArrays) = Element
	  ArrayType(NumArrays) = Type
	  ArrayLenth(NumArrays) = Lenth
	end if

	return



	entry GetMaxDim( II, ThisName, Max, ThisPureName,
     1    ThisElement )


c--
c see if Name is an array

	Name = ThisName

	call CvtToUpCase( Name )

	call CheckIfArray( II, Name, NotAnArray, PureName,
     1    ThisElement )

	if( NotAnArray ) then
	  Max = 0
	  ThisPureName = ' '
	  ThisElement = 0
	  return
	end if

c--
c Name is an array, find position in the list

	InList = .false.
	do 40 I = 1 , NumArrays
	  if( PureName .eq. ArrayNames(I) ) then
	    InList = .true.
	    Index = I
	    goto 50
	  end if
40	continue
50	continue

	if( InList ) then
	  Max = MaxDim(Index)
	  ThisPureName = ThisName( 1 : Length(PureName) )
	else
	  call NotFound( Name )
	end if

	return

	end


	subroutine BldSysName( II, ThisName, SysName, PureSysName )

c--
c parameters

	integer*2 II
	character*32 ThisName
	character*9 SysName
	character*4 PureSysName

c--
c locals

	integer*2 MaxFields
	parameter ( MaxFields=250 )

	integer*2 NumVars, Index, I, Element, L1, L2
	character*32 Name, FldNames(MaxFields), PureName
	logical*1 InList, NotAnArray

	character*1 Prefix
	character*3 Tmp

c--
c functions

	integer*2 Length


	data NumVars /0/

c--
c Up case Name

	Name = ThisName

	call CvtToUpCase( Name )

c--
c Get Pure name ( no subscripts )

	call CheckIfArray( II, Name, NotAnArray, PureName,
     1    Element )

	if( NotAnArray ) then
	  Prefix = 'S'
	  PureName = Name
	  Element = 0
	else
	  Prefix = 'V'
	end if

c--
c Search list

	InList = .false.
	do 20 I = 1 , NumVars
	  if( PureName .eq. FldNames(I) ) then
	    InList = .true.
	    Index = I
	    goto 30
	  end if
20	continue
30	continue

	if( .not. InList ) then
	  NumVars = Numvars + 1
	  if( NumVars .gt. MaxFields ) call TooManyFields( Name )
	  FldNames(NumVars) = PureName
	  Index = NumVars
	end if

	write( Tmp, 10 ) Index
10 	format( i3 )

	call LeftJustify( Tmp )
	PureSysName(1:1) = Prefix
	PureSysName(2:4) = Tmp(1:3)

	L1 = Length( PureSysName )

	if( Element .gt. 0 ) then
	  write( Tmp, 10 ) Element
	  call LeftJustify( Tmp )
	  L2 = Length( Tmp )
	  SysName = PureSysName(1:L1) // '(' // Tmp(1:L2) // ')'
	else
	  SysName = PureSysName
	end if

	return

	end


	subroutine FieldErrors

	character*32 Name
	integer*2 Display, SysLun

	return


	entry TooManyFields( Name )

	Display = SysLun( 'Display' )


	call ClrScr
	write( Display, 50 ) Name
50	format(1x,'Too many fields - current name is ', a )

	stop '[Abort]'


	entry TypeMismatch( Name )

	Display = SysLun( 'Display' )


	call ClrScr
	write( Display, 55 ) Name
55	format(1x,'Field type in conflict with previous declaration',
     1	  /, 1x, 'Current name is ', a )

	stop '[Abort]'


	entry LenthMismatch( Name )

	Display = SysLun( 'Display' )


	call ClrScr
	write( Display, 56 ) Name
56	format(1x,'Field length in conflict with previous declaration',
     1	  /, 1x, 'Current name is ', a )

	stop '[Abort]'


	entry NotFound( Name )

	Display = SysLun( 'Display' )


	call ClrScr
	write( Display, 60 ) Name
60	format(1x, 'Field name not in list - current name is ', a )

	stop '[Abort]'



	end


	subroutine CheckIfArray( I, Name, NotAnArray, PureName, 
     1    Element )

c--
c parameters

	integer*2 I, Element
	character*32 Name, PureName
	logical*1 NotAnArray

c--
c For parse

	integer*2 DimPntr
	parameter ( DimPntr=4 )

	integer*2 Pntr(2,DimPntr), WordLength(DimPntr), NumWords,
     1    ParseError

c--
c locals

	integer*2 Display
	logical*1 SyntaxError

c--
c functions

	integer*2 SysLun, Length
	logical*1 ValidInt


	Display = SysLun( 'Display' )

	NotAnArray = .true.

	call Parse( Name, char(0), char(0), '()',
     1   DimPntr, Pntr, WordLength, NumWords, ParseError )

	if( NumWords .eq. 1 ) return

	if( NumWords .ne. 4 ) then
	  SyntaxError = .true.
	else if( Name( Pntr(1,2):Pntr(2,2) ) .ne. '(' ) then
	  SyntaxError = .true.
	else if( Name( Pntr(1,4):Pntr(2,4) ) .ne. ')' ) then
	  SyntaxError = .true.
	else if( .not. ValidInt( Name(Pntr(1,3):Pntr(2,3)) ) ) then
	  SyntaxError = .true.
	else
	  SyntaxError = .false.
	end if

	if( SyntaxError ) then
	  call ClrScr
	  write( Display, 10 ) I, Name(1:Length(Name))
10	  format(1x,'Syntax error in array name for field ', I3,/,
     1      1x,'Name is "', a, '"', / )
	  stop '[Abort]'
	end if

	NotAnArray = .false.

	PureName = Name(Pntr(1,1):Pntr(2,1))

c--
c get array element

	call GetInteger( Name(Pntr(1,3):Pntr(2,3)), Element )

	end
