NLSL: varyc.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

varyc.f90
Go to the documentation of this file.
1 c NLSL Version 1.5 beta 11/24/95
2 c----------------------------------------------------------------------
3 c =========================
4 c subroutine VARYC
5 c =========================
6 c
7 c vary <name> { minimum <minval> maximum <maxval> scale <accuracy>
8 c fdstep <step> }
9 c
10 c name : name of the parameter to be varied
11 c Vary parameter individually for each spectrum in
12 c a series
13 c minval : Minimum permissible value for parameter
14 c maxval : Maximum permissible value for parameter
15 c scale : Factor by which to scale search vector for this parameter
16 c step : Relative step size for forward-differences approximation
17 c
18 c NOTE: Minimum and maximum ARE NOT YET IMPLEMENTED
19 c
20 c
21 c Special rules:
22 c
23 c (1) Spectrum parameters may only be varied for all sites associated with
24 c a given spectrum. These include:
25 c PSI -- tilt angle
26 c PHASE -- spectral phase (absorption vs. dispersion)
27 c LB -- gaussian inhomogeneous broadening (orientation-independent)
28 c
29 c (2) Note that B0, also a spectrum parameter may not be varied at all,
30 c but it may be a series variable.
31 c
32 c (3) GIB2 may only be varied for a PSI series or for a MOMD calculation
33
34 c Other rules that will be implemented:
35 c
36 c Shifting is disabled if the average g-value is allowed to float
37 c
38 c----------------------------------------------------------------------
39 subroutine varyc( line )
40 c
41 use nlsdim
42 use eprprm
43 c use prmeqv
44 use parcom
45 use lpnam
46 use stdio
47 c
48 implicit none
49 character*80 line
50 c
51 integer i,ibd,ix,ix2,lth
52 double precision fval,prmn,prmx,prsc,step
53 character token*30,prmID*9
54 logical gib2OK
55 c
56 integer NKEYWD
57 parameter(nkeywd=4)
58 c
59 double precision ONE,ZERO
60 parameter(one=1.0d0,zero=0.0d0)
61 c
62 integer ipfind,indtkn,itrim
63 logical ftoken
64 external ftoken,ipfind,indtkn,itrim
65 character*8 keywrd(nkeywd)
66 data keywrd /'MINIMUM','MAXIMUM','SCALE','FDSTEP'/
67 c
68 c -------------------------------
69 c Get the name of the parameter
70 c -------------------------------
71 call gettkn(line,token,lth)
72 lth=min(lth,6)
73 c
74 if (lth.le.0) then
75 write(luttyo,1004)
76 return
77 end if
78 c
79 call touppr(token,lth)
80 c
81 1 ix=ipfind(token,lth)
82 c
83 c ---------------------------------------
84 c Check whether parameter may be varied
85 c ---------------------------------------
86 if (ix.eq.0 .or. ix.gt.nvprm) then
87 write(luttyo,1002) token(:lth)
88 return
89 end if
90 c
91 if (ix.lt.-100) then
92 prmid=alias2( -99-(iwxx+ix) )
93 else if (ix.lt.0) then
94 prmid=alias1( 1-(iwxx+ix) )
95 else
96 prmid=parnam(ix)
97 end if
98 c
99 c --- Get secondary index
100 c
101 ix2=indtkn( line )
102 c
103 c --------------------------------------------------
104 c GIB2 may only be varied for MOMD calculations or
105 c if PSI is the series variable.
106 c --------------------------------------------------
107 if (ix.eq.igib2) then
108 gib2ok=iser.eq.ipsi
109 if (ix2.le.0) then
110 do i=1,nsite
111 gib2ok=gib2ok .or. (iparm(inort,i).gt.1)
112 end do
113 else
114 gib2ok=gib2ok .or. (iparm(inort,ix2).gt.1)
115 end if
116 c
117 if (.not. gib2ok) then
118 write(luttyo,1006)
119 return
120 end if
121 end if
122 c
123 c -------------
124 c set defaults
125 c -------------
126 prmn=zero
127 prmx=zero
128 prsc=one
129 step=1.0d-6
130 ibd=0
131 c
132 c --------------------
133 c Look for a keyword
134 c --------------------
135 14 call gettkn(line,token,lth)
136 lth=min(lth,8)
137 c
138 c ------------------------------------------------
139 c No more tokens: vary the last parameter and exit
140 c ------------------------------------------------
141 if (lth.eq.0) then
142 call addprm(ix,ix2,ibd,prmn,prmx,prsc,step,prmid)
143 return
144 end if
145 c
146 c --------------------
147 c Check keyword list
148 c --------------------
149 call touppr(token,lth)
150 do i=1,nkeywd
151 if (token(:lth).eq.keywrd(i)(:lth)) goto 16
152 end do
153 c
154 c ----------------------------------------------------------------
155 c Word was not recognized: add last parameter specified
156 c and treat present token as a possible new parameter name
157 c ----------------------------------------------------------------
158 call addprm(ix,ix2,ibd,prmn,prmx,prsc,step,prmid)
159 go to 1
160 c
161 c ----------------------------------------------------------------
162 c Keyword found: convert next token and assign appropriate value
163 c ----------------------------------------------------------------
164 16 call gettkn(line,token,lth)
165 c *** No value given
166 if (lth.eq.0) then
167 write(luttyo,1003) keywrd(i)(:itrim(keywrd(i)))
168 return
169 end if
170 c
171 if (ftoken(token,lth,fval)) then
172 c *** MINIMUM keyword
173 if (i.eq.1) then
174 prmn=fval
175 if (mod(ibd,2).eq.0) ibd=ibd+1
176 c *** MAXIMUM keyword
177 else if (i.eq.2) then
178 prmx=fval
179 ibd=ibd+2
180 c *** SCALE keyword
181 else if (i.eq.3) then
182 prsc=fval
183 c *** FDSTEP keyword
184 else if (i.eq.4) then
185 step=fval
186 end if
187 c *** Illegal real value
188 else
189 write(luttyo,1001) token(:lth)
190 end if
191 c
192 go to 14
193 c
194 c ###### format statements ########################################
195 c
196 1001 format('*** Real value expected: ''',a,''' ***')
197 1002 format('*** ''',a,''' is not a variable parameter ***')
198 1003 format('*** No value given for ''',a,''' ***')
199 1004 format('*** Parameter name expected ***')
200 1006 format('*** GIB2 may only be varied for a series of PSI angles',
201 # ' ***')
202
203 end
nlsdim::nvprm
integer, parameter nvprm
Definition: nlsdim.f90:57
varyc
subroutine varyc(line)
Definition: varyc.f90:40
eprprm::igib2
integer, parameter igib2
Definition: eprprm.f90:92
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
eprprm::ipsi
integer, parameter ipsi
Definition: eprprm.f90:92
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
parcom::nsite
integer, save nsite
Definition: parcom.f90:62
parcom::iparm
integer, dimension(niprm, mxsite), target, save iparm
Definition: parcom.f90:60
eprprm::iwxx
integer, parameter iwxx
Definition: eprprm.f90:92
lpnam
Definition: lpnam.f90:18
parcom::iser
integer, save iser
Definition: parcom.f90:62
stdio::luttyo
integer, parameter luttyo
Definition: stdio.f90:29
eprprm::inort
integer, parameter inort
Definition: eprprm.f90:101
eprprm
Definition: eprprm.f90:51
nlsdim
Definition: nlsdim.f90:36
lpnam::parnam
character *6, dimension(nfprm), save parnam
Definition: lpnam.f90:27
addprm
subroutine addprm(ix, ix2, ibd, prmn, prmx, prsc, step, ident)
Add a parameter to list of parameters being varied for nonlinear least-squares. Also maintain the lis...
Definition: addprm.f90:54
lpnam::alias2
character *6, dimension(nalias), save alias2
Definition: lpnam.f90:51