NLSL: setspc.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

setspc.f90
Go to the documentation of this file.
1 c NLSL Version 1.5.1 beta 2/3/96
2 c----------------------------------------------------------------------
3 c =========================
4 c subroutine SETSPC
5 c =========================
6 c
7 c This routine sets all the parameters in the fparm and iparm array
8 c (kept in common /parcom/) for the specified site and spectrum
9 c (arguments isite and ispc).
10 c
11 c Certain parameter values are not kept in the fparm and iparm
12 c arrays. In particular, if a series of spectra are to be calculated,
13 c the series variable appropriate for the current spectrum is loaded
14 c into fparm. This routine also sets the spectrum-dependent parameters
15 c from the arrays in common /expdat/. These parameters are not allowed
16 c to vary within a single spectrum, and specifically include the following:
17 c
18 c Floating:
19 c B0
20 c LB
21 c PHASE
22 c PSI
23 c FLDI
24 c DFLD
25 c
26 c Integer:
27 c NFLD
28 c IDERIV
29 c----------------------------------------------------------------------
30 subroutine setspc(isite,ise)
31 c
32 use nlsdim
33 use eprprm
34 use expdat
35 use parcom
36 use basis
37 use errmsg
38 use iterat
39 use rnddbl
40 use stdio
41 use pidef
42 c
43 implicit none
44 integer isite,ise
45 c
46 integer i
47 c
48 c######################################################################
49 c
50 if (ise.le.0 .or. ise.gt.mxspc
51 # .or. isite.le.0 .or. isite.gt.mxsite) return
52 c
53 c --------------------------
54 c Set spectral parameters
55 c --------------------------
56 c
57 fparm(ilb, isite) = slb(ise)
58 fparm(iphase,isite) = sphs(ise)
59 fparm(ipsi, isite) = spsi(ise)
60 fparm(ib0, isite) = sb0(ise)
61 fparm(ifldi, isite) = sbi(ise)-shft(ise)-tmpshft(ise)
62 fparm(idfld, isite) = sdb(ise)
63 iparm(infld, isite) = npts(ise)
64 iparm(iiderv,isite) = idrv(ise)
65 c
66 c --------------------------------------
67 c set the SERIES variable if necessary
68 c --------------------------------------
69 if (iser.gt.0) fparm(iser,isite)=serval(ise)
70 c
71 c ------------------------------------------------------
72 c Set the matrix dimension if using a pruned basis set
73 c ------------------------------------------------------
74 if (basno(isite,ise).gt.0) then
75 iparm(indim,isite) = ltbas( basno(isite,ise) )
76 do i=0,6
77 iparm(ilemx+i,isite) = mts( i+1, basno(isite,ise) )
78 end do
79 end if
80 c
81 c ------------------------------------------------------------
82 c If B0 is zero,
83 c find B0 from the center field of the spectrum of the data,
84 c resetting series value if necessary
85 c If data are not available, report an error.
86 c ------------------------------------------------------------
87 if (sb0(ise).lt.rndoff) then
88 if (ise.le.nspc) then
89 sb0(ise)=sbi(ise)+sdb(ise)*(npts(ise)+1)/2.0d0
90 fparm(ib0,isite)=sb0(ise)
91 if (iser.eq.ib0) serval(ise)=sb0(ise)
92 c
93 write (luout,1000) ise,ise,sb0(ise)
94 if (luttyo.ne.luout) write (luttyo,1000)ise,ise,sb0(ise)
95 else
96 write (luout,1001) ise
97 if (luttyo.ne.luout) write (luttyo,1000) ise
98 end if
99 end if
100 c
101 c ------------------------------------------------------------
102 c Reset negative GIB parameters to absolute values if needed
103 c ------------------------------------------------------------
104 if (fparm(igib0,isite).lt.0.0d0 .or.
105 # ( (iser.eq.ipsi .or.iparm(inort,isite).gt.1).and.
106 # fparm(igib2,isite).lt.0.0d0 ) ) then
107 fparm(igib2,isite)=abs(fparm(igib0,isite)+fparm(igib2,isite))
108 # -abs(fparm(igib0,isite))
109 fparm(igib0,isite)=abs(fparm(igib0,isite))
110 xreset=.true.
111 end if
112
113
114 return
115 c
116 1000 format('*** B0(',i1,') outside range of spectrum ',i1,
117 #': reset to',f8.1)
118 1001 format('*** B0(',i1,') has not been specified ***')
119 c
120 end
stdio::luout
integer, save luout
Definition: stdio.f90:32
iterat
Definition: iterat.f90:11
expdat::sbi
double precision, dimension(mxspc), save sbi
Definition: expdat.f90:40
expdat::sdb
double precision, dimension(mxspc), save sdb
Definition: expdat.f90:40
setspc
subroutine setspc(isite, ise)
Definition: setspc.f90:31
eprprm::igib2
integer, parameter igib2
Definition: eprprm.f90:92
eprprm::ilb
integer, parameter ilb
Definition: eprprm.f90:92
basis::basno
integer, dimension(mxsite, mxspc), save basno
Definition: basis.f90:23
expdat::tmpshft
double precision, dimension(mxspc), save tmpshft
Definition: expdat.f90:40
expdat::shft
double precision, dimension(mxspc), save shft
Definition: expdat.f90:40
stdio
Definition: stdio.f90:26
expdat::spsi
double precision, dimension(mxspc), save spsi
Definition: expdat.f90:40
parcom::fparm
double precision, dimension(nfprm, mxsite), target, save fparm
Definition: parcom.f90:54
basis
Definition: basis.f90:19
eprprm::ipsi
integer, parameter ipsi
Definition: eprprm.f90:92
parcom
Definition: parcom.f90:42
parcom::serval
double precision, dimension(mxspc), save serval
Definition: parcom.f90:56
eprprm::igib0
integer, parameter igib0
Definition: eprprm.f90:92
basis::mts
integer, dimension(9, mxmts), save mts
Definition: basis.f90:23
nlsdim::mxspc
integer, parameter mxspc
Definition: nlsdim.f90:39
eprprm::indim
integer, parameter indim
Definition: eprprm.f90:101
expdat::nspc
integer, save nspc
Definition: expdat.f90:45
expdat::sphs
double precision, dimension(mxspc), save sphs
Definition: expdat.f90:40
parcom::iparm
integer, dimension(niprm, mxsite), target, save iparm
Definition: parcom.f90:60
nlsdim::mxsite
integer, parameter mxsite
Definition: nlsdim.f90:39
eprprm::ib0
integer, parameter ib0
Definition: eprprm.f90:92
eprprm::iphase
integer, parameter iphase
Definition: eprprm.f90:92
expdat::idrv
integer, dimension(mxspc), save idrv
Definition: expdat.f90:45
eprprm::iiderv
integer, parameter iiderv
Definition: eprprm.f90:101
parcom::iser
integer, save iser
Definition: parcom.f90:62
expdat
Definition: expdat.f90:36
stdio::luttyo
integer, parameter luttyo
Definition: stdio.f90:29
rnddbl
Definition: rnddbl.f90:77
eprprm::ilemx
integer, parameter ilemx
Definition: eprprm.f90:101
eprprm::inort
integer, parameter inort
Definition: eprprm.f90:101
eprprm
Definition: eprprm.f90:51
nlsdim
Definition: nlsdim.f90:36
expdat::sb0
double precision, dimension(mxspc), save sb0
Definition: expdat.f90:40
iterat::xreset
logical, save xreset
Definition: iterat.f90:18
eprprm::idfld
integer, parameter idfld
Definition: eprprm.f90:92
expdat::npts
integer, dimension(mxspc), save npts
Definition: expdat.f90:45
expdat::slb
double precision, dimension(mxspc), save slb
Definition: expdat.f90:40
eprprm::infld
integer, parameter infld
Definition: eprprm.f90:101
eprprm::ifldi
integer, parameter ifldi
Definition: eprprm.f90:92
rnddbl::rndoff
double precision, parameter rndoff
Definition: rnddbl.f90:86
basis::ltbas
integer, dimension(mxtdm), save ltbas
Definition: basis.f90:23
pidef
Definition: pidef.f90:12
errmsg
Definition: errmsg.f90:46