NLSL: helpc.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

helpc.f90
Go to the documentation of this file.
1 c Version 1.2
2 c----------------------------------------------------------------------
3 c =========================
4 c subroutine HELPC
5 c =========================
6 c----------------------------------------------------------------------
7 subroutine helpc(line)
8 c
9 use stdio
10 c
11 implicit none
12 character hlptxt*132,line*80, cat1*30, cat2*30, hlpcat*30
13 integer ioerr,ibar,iblk,lth1,lth2,nlines,LINES
14 logical found1,found2,kywrd1,kywrd2,match1,noncmd
15 parameter(lines=23)
16 c
17 call gettkn( line, cat1, lth1 )
18 call gettkn( line, cat2, lth2 )
19 if (lth1.ne.0) call touppr(cat1,lth1)
20 if (lth2.ne.0) call touppr(cat2,lth2)
21 open (ludisk,file='/home/daveb/bin/nlshlp.txt',
22 # status='old',access='sequential',iostat=ioerr)
23 if (ioerr.ne.0) then
24 write (luttyo,1002)
25 return
26 end if
27 c
28 found1=.false.
29 found2=.false.
30 nlines=0
31 c
32 c Search through lines in the help text file
33 c
34 1 read (ludisk,'(a)',end=4,iostat=ioerr) hlptxt
35 if (ioerr.ne.0) then
36 write (luttyo,1003) hlpcat(:ibar),hlptxt(:iblk)
37 close(ludisk)
38 return
39 end if
40 ibar=1
41 2 if (hlptxt(ibar:ibar).ne.'|'.and.ibar.lt.132) then
42 ibar=ibar+1
43 go to 2
44 end if
45 c
46 kywrd1=hlptxt(1:1).eq.'*'
47 kywrd2=hlptxt(1:1).eq.'>'
48 noncmd=hlptxt(1:1).eq.' '
49 hlpcat=hlptxt(2:ibar-1)
50 hlptxt=hlptxt(ibar+1:)
51 ibar=ibar-2
52 c
53 c Find last nonblank character in help text line
54 c
55 iblk=132
56 3 if (hlptxt(iblk:iblk).eq.' ') then
57 iblk=iblk-1
58 go to 3
59 end if
60 c
61 c If help text entry represents a major category, check the
62 c first keyword specified in the help command (if any) against it
63 c
64 if (kywrd1) then
65 match1=.false.
66 if (lth1.eq.0) then
67 call linchk(nlines)
68 write(luttyo,1000) hlpcat(:ibar),hlptxt(:iblk)
69 else if (cat1(:lth1).eq.hlpcat(:lth1)) then
70 call linchk(nlines)
71 write(luttyo,1000) hlpcat(:ibar),hlptxt(:iblk)
72 match1=.true.
73 found1=.true.
74 end if
75 c
76 c If help text entry represents a subcategory, check the
77 c second keyword specified in the help command (if any) against it
78
79 else if (kywrd2) then
80 if (match1.and.lth2.eq.0) then
81 call linchk(nlines)
82 write(luttyo,1004) hlpcat(:ibar),hlptxt(:iblk)
83 else if (match1.and.cat2(:lth2).eq.hlpcat(:lth2)) then
84 call linchk(nlines)
85 write(luttyo,1004) hlpcat(:ibar),hlptxt(:iblk)
86 found2=.true.
87 end if
88 c
89 else if (noncmd .and. lth1.ne.0) then
90 if (cat1(:lth1).eq.hlpcat(:lth1)) then
91 call linchk(nlines)
92 write(luttyo,1000) hlpcat(:ibar),hlptxt(:iblk)
93 found1=.true.
94 end if
95 end if
96 go to 1
97 c
98 4 if ((lth1.ne.0 .and. .not.found1) .or.
99 # (lth2.ne.0 .and. .not.found2))
100 # write (luttyo,1001) cat1(:lth1),cat2(:lth2)
101 c
102 close(ludisk)
103 return
104 c
105 1000 format(a,t22,a)
106 1001 format('*** No help available for ''',a,' ',a,''' ***')
107 1002 format('*** File ''nlshlp.txt'' not available ***')
108 1003 format('*** Error reading file ''nlshlp.txt'' ***')
109 1004 format(2x,a,t24,a)
110 end
111
112
113 subroutine linchk( nlines )
114 c
115 use stdio
116 c
117 implicit none
118 integer nlines,MXLINES
119 character dummy*1
120 parameter(mxlines=20)
121 c
122 if (luttyo.ne.luttyo) return
123 if (nlines.eq.0) write (luttyo,1001)
124 nlines=nlines+1
125 if (nlines.gt.mxlines) then
126 write (luttyo,1000)
127 read (luttyo,'(a)') dummy
128 nlines=1
129 end if
130 return
131 1000 format('...press <RETURN> to continue...')
132 1001 format(/15x,' *** NLSL on-line help ***'/)
133 end
stdio
Definition: stdio.f90:26
linchk
subroutine linchk(nlines)
Definition: helpc.f90:114
touppr
subroutine touppr(string, lth)
Definition: strutl2.f90:22
gettkn
subroutine gettkn(line, token, lth)
Written for free-form input of parameters for slow-motional calculations. Returns a token consisting ...
Definition: strutl1.f90:75
stdio::ludisk
integer, parameter ludisk
Definition: stdio.f90:29
stdio::luttyo
integer, parameter luttyo
Definition: stdio.f90:29
helpc
subroutine helpc(line)
Definition: helpc.f90:8