NLSL: rmvprm.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

rmvprm.f90
Go to the documentation of this file.
1 c Version 1.3 11/23/93
2 c----------------------------------------------------------------------
3 c =========================
4 c subroutine RMVPRM
5 c =========================
6 c
7 c Remove a parameter from the list of parameters being varied for nonlinear
8 c least-squares. Also maintain the lists of
9 c (1) ixst : secondary parameter index (for multiple sites/spectra)
10 c (2) ibnd : boundary flag for variable parameter
11 c (3) prmin : minimum for variable parameter
12 c (4) prmax : maximum for variable parameter
13 c (5) prscl : desired accuracy for given parameter
14 c (6) xfdstp : Size of forward-differences step
15 c (7) tag : Name of the parameter (character*9)
16 c (8) ixx : index of each element in the fparm array into the x vector
17 c
18 c Notes:
19 c
20 c ix2= -1 means remove all occurrences of the parmeter in the variable list
21 c ix2= 0 means remove the parameter only if it applies for all sites
22 c
23 c----------------------------------------------------------------------
24 subroutine rmvprm(ix,ix2,ident)
25 c
26 use nlsdim
27 use parcom
28 use eprprm
29 use stdio
30 c
31 implicit none
32 integer ix,ix2
33 logical match
34 character ident*30,tmptag*9
35 c
36 integer i,ixa,j,j1,l
37 c
38 integer itrim
39 logical tcheck
40 external itrim,tcheck
41 c
42 c######################################################################
43 c
44 match = .false.
45 ixa=abs(mod(ix,100))
46 if (nprm.eq.0) go to 5
47 c
48 if (ix2.le.0) then
49 tmptag=ident
50 else
51 write (tmptag,1000) ident(:itrim(ident)),ix2
52 end if
53 c
54 c----------------------------------------------------------------------
55 c Loop through the list of parameters being varied (it's in sort order)
56 c----------------------------------------------------------------------
57 do i=1,nprm
58 if (ixpr(i).gt.ixa) go to 5
59 if (ixpr(i).eq.ixa) then
60 if (ixst(i).gt.ix2.and. ix2.gt.0) go to 5
61 if (ixst(i).eq.ix2 .or. ix2.eq.-1) then
62 c
63 c------------------------------------------------------------------------
64 c Parameter found: first, make sure it matches the specified symmetry.
65 c If it does, delete it and move up any elements below it in the list.
66 c------------------------------------------------------------------------
67 if ( .not.tcheck(ix,ix2,ident,0) ) go to 5
68 c
69 match=.true.
70 if (ixst(i).le.0) then
71 do l=1,mxsite
72 ixx(ixpr(i),l)=0
73 end do
74 else
75 ixx(ixpr(i),ixst(i))=0
76 end if
77 c
78 do j=i,nprm-1
79 j1=j+1
80 ixpr(j)=ixpr(j1)
81 ixst(j)=ixst(j1)
82 prmin(j)=prmin(j1)
83 prmax(j)=prmax(j1)
84 prscl(j)=prscl(j1)
85 xfdstp(j)=xfdstp(j1)
86 ibnd(j)=ibnd(j1)
87 tag(j)=tag(j1)
88 c
89 if (ixst(j).le.0) then
90 do l=1,mxsite
91 ixx(ixpr(j),l)=j
92 end do
93 else
94 ixx(ixpr(j),ixst(j))=j
95 end if
96 end do
97 c
98 nprm=nprm-1
99 write (luttyo,1002) tmptag(:itrim(tmptag)),nprm
100 c
101 end if
102 end if
103 c
104 end do
105 c
106 5 if (.not.match) write (luttyo,1001) tmptag(:itrim(tmptag))
107 return
108 c
109 c #### format statements ###########################################
110 c
111 1000 format(a,'(',i1,')')
112 1001 format('*** Parameter ''',a,''' is not being varied ***')
113 1002 format('*** Parameter ''',a,''' fixed: ',
114 #i3,' variable parameters ***')
115 end
116
117
parcom::ixst
integer, dimension(mxvar), save ixst
Definition: parcom.f90:62
stdio
Definition: stdio.f90:26
parcom
Definition: parcom.f90:42
parcom::xfdstp
double precision, dimension(mxvar), save xfdstp
Definition: parcom.f90:56
parcom::ixpr
integer, dimension(mxvar), save ixpr
Definition: parcom.f90:62
parcom::nprm
integer, save nprm
Definition: parcom.f90:62
parcom::prmin
double precision, dimension(mxvar), save prmin
Definition: parcom.f90:56
nlsdim::mxsite
integer, parameter mxsite
Definition: nlsdim.f90:39
parcom::prmax
double precision, dimension(mxvar), save prmax
Definition: parcom.f90:56
stdio::luttyo
integer, parameter luttyo
Definition: stdio.f90:29
parcom::ibnd
integer, dimension(mxvar), save ibnd
Definition: parcom.f90:62
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
parcom::tag
character *9, dimension(mxjcol), save tag
Definition: parcom.f90:67
parcom::prscl
double precision, dimension(mxvar), save prscl
Definition: parcom.f90:56