NLSL: fixc.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

fixc.f90
Go to the documentation of this file.
1 c NLSL Version 1.5 beta 11/25/95
2 c----------------------------------------------------------------------
3 c =========================
4 c subroutine FIXC
5 c =========================
6 c
7 c Removes the named parameter(s) from the list of variable parameters.
8 c
9 c fix all | <name> { ( <index> | * ) } {, <name>...}
10 c
11 c name : name of the parameter to be removed
12 c index : optional site/series index
13 c * : specifies all indices
14 c----------------------------------------------------------------------
15 subroutine fixc(line)
16 c
17 use nlsdim
18 use eprprm
19 c use prmeqv
20 use parcom
21 use lpnam
22 use stdio
23 c
24 implicit none
25 character*80 line
26 c
27 integer i,ibd,ix,ix2,j,lth
28 double precision fval,prmn,prmx,prsc,step
29 character token*30,prmID*9
30 c
31 integer ipfind,indtkn
32 logical ftoken
33 external ftoken,ipfind,indtkn
34 c
35 c----------------------------------------------------------------------
36 c Get the name of the parameter
37 c----------------------------------------------------------------------
38 1 call gettkn(line,token,lth)
39 lth=min(lth,6)
40 if (lth.le.0) return
41 c
42 call touppr(token,lth)
43 if (token(:lth).eq.'ALL') then
44 if (nprm.gt.0) then
45 write(luout,1001)
46 if (luout.ne.luttyo) write(luttyo,1001)
47 end if
48 c
49 do i=1,nfprm
50 do j=1,mxsite
51 ixx(i,j)=0
52 end do
53 end do
54 nprm=0
55 return
56 end if
57 c
58 ix=ipfind(token,lth)
59 c
60 c----------------------------------------------------------------------
61 c Check whether parameter may be varied
62 c----------------------------------------------------------------------
63 if (ix.eq.0 .or. ix.gt.nvprm) then
64 write(luttyo,1002) token(:lth)
65 return
66 end if
67 c
68 if (ix.lt.-100) then
69 prmid=alias2( -99-(iwxx+ix) )
70 else if (ix.lt.0) then
71 prmid=alias1( 1-(iwxx+ix) )
72 else
73 prmid=parnam(ix)
74 end if
75 c
76 c --- Get secondary index
77 c
78 ix2=indtkn( line )
79 c
80 call rmvprm(ix,ix2,prmid)
81 go to 1
82 c
83 c ###### format statements ########################################
84 c
85 1001 format('*** All variable parameters have been fixed ***')
86 1002 format('*** ''',a,''' is not a variable parameter ***')
87 end
nlsdim::nvprm
integer, parameter nvprm
Definition: nlsdim.f90:57
stdio::luout
integer, save luout
Definition: stdio.f90:32
lpnam::alias1
character *6, dimension(nalias), save alias1
Definition: lpnam.f90:45
stdio
Definition: stdio.f90:26
touppr
subroutine touppr(string, lth)
Definition: strutl2.f90:22
parcom
Definition: parcom.f90:42
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
fixc
subroutine fixc(line)
Definition: fixc.f90:16
parcom::nprm
integer, save nprm
Definition: parcom.f90:62
nlsdim::mxsite
integer, parameter mxsite
Definition: nlsdim.f90:39
eprprm::iwxx
integer, parameter iwxx
Definition: eprprm.f90:92
lpnam
Definition: lpnam.f90:18
stdio::luttyo
integer, parameter luttyo
Definition: stdio.f90:29
eprprm
Definition: eprprm.f90:51
nlsdim
Definition: nlsdim.f90:36
rmvprm
subroutine rmvprm(ix, ix2, ident)
Definition: rmvprm.f90:25
parcom::ixx
integer, dimension(nfprm, mxsite), save ixx
Definition: parcom.f90:62
lpnam::parnam
character *6, dimension(nfprm), save parnam
Definition: lpnam.f90:27
nlsdim::nfprm
integer, parameter nfprm
Definition: nlsdim.f90:57
lpnam::alias2
character *6, dimension(nalias), save alias2
Definition: lpnam.f90:51