NLSL: parc.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

parc.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 PARC
5 c =========================
6 c
7 c Prints out a list of parameter values on the given logical unit
8 c number.
9 c
10 c----------------------------------------------------------------------
11 subroutine parc( line )
12 c
13 use nlsdim
14 use eprprm
15 use expdat
16 use parcom
17 use lpnam
18 use stdio
19 use rnddbl
20 use symdef
21 use mtsdef
22 c
23 implicit none
24 character line*80,hdr*4,shdr*4,fileID*30
25 c
26 integer i,ioerr,isym,jx,lth,lu,ntmp,npotn
27 c
28 integer itrim
29 external itrim
30 c
31 character*2 nonbr(3)
32 data nonbr/ 'l', 'xy', 'zz'/
33 c
34 c......................................................................
35 c
36 call gettkn(line,fileid,lth)
37 c
38 c----------------------------------------------------------------------
39 c No name specified: output to terminal
40 c----------------------------------------------------------------------
41 if (lth.eq.0) then
42 lu=luttyo
43 hdr=' '
44 shdr=' '
45 else
46 c
47 c ------------------------------------------------
48 c Set output of "let" commands to specified file
49 c ------------------------------------------------
50 open(ludisk,file=fileid(:lth),status='unknown',
51 # access='sequential',form='formatted',iostat=ioerr)
52 if (ioerr.ne.0) then
53 write (luout,3000) fileid(:lth)
54 return
55 end if
56 lu=ludisk
57 hdr='let '
58 shdr='c '
59 end if
60 c
61 c --------------------
62 c Series command
63 c --------------------
64 if (iser.ne.0) then
65 write(lu,1023) parnam(iser)(:itrim(parnam(iser))),
66 # (serval(i),i=1,nser)
67 else
68 write(lu,2023) shdr
69 end if
70 c
71 ntmp=max0(nser,1)
72 write(lu,1024) (hdr,jx,sb0(jx),jx=1,ntmp)
73 write(lu,1021) (hdr,jx,slb(jx),jx=1,ntmp)
74 write(lu,1025) (hdr,jx,spsi(jx),jx=1,ntmp)
75 write(lu,1026) (hdr,jx,sphs(jx),jx=1,ntmp)
76 c
77 write (lu,1018) nsite
78 c
79
80 c ========================================
81 c Loop over site parameters
82 c ========================================
83 do 10 jx=1,nsite
84 write (lu,1019) shdr,jx
85 c
86 c -----------
87 c g-tensor
88 c -----------
89 isym = iparm(iigflg,jx)
90 if (lu.ne.luttyo) write (lu,2002) symstr(isym), 'g'
91 if (isym.eq.axial) then
92 write (lu,2001) hdr,(fparm(igxx+i,jx),i=0,2,2)
93 else if (isym.eq.spherical) then
94 write (lu,1001) hdr,(fparm(igxx+i,jx),i=0,2)
95 else
96 write (lu,1000) hdr,(fparm(igxx+i,jx),i=0,2)
97 end if
98 c
99 c -----------------------------------
100 c Nuclear spin and hyperfine tensor
101 c -----------------------------------
102 if (iparm(iin2,jx).ne.0) then
103 isym=iparm(iiaflg,jx)
104 if (lu.ne.luttyo) write (lu,2002) symstr(isym), 'A'
105 if (isym.eq.axial) then
106 write(lu,2004) hdr,iparm(iin2,jx),(fparm(iaxx+i,jx),i=0,2,2)
107 else if (isym.eq.spherical) then
108 write(lu,1004) hdr,iparm(iin2,jx),(fparm(iaxx+i,jx),i=0,2)
109 else
110 write(lu,1003) hdr,iparm(iin2,jx),(fparm(iaxx+i,jx),i=0,2)
111 end if
112 else
113 write (lu,1002) hdr,iparm(iin2,jx)
114 end if
115 c
116 c -------------------
117 c Linewidth tensor
118 c -------------------
119 isym=iparm(iiwflg,jx)
120 if (lu.ne.luttyo) write (lu,2002) symstr(isym), 'W'
121 if (isym.eq.axial) then
122 write (lu,3003) hdr,(fparm(iwxx+i,jx),i=0,2,2)
123 else if (isym.eq.spherical) then
124 write (lu,3002) hdr,(fparm(iwxx+i,jx),i=0,2)
125 else
126 write (lu,3001) hdr,(fparm(iwxx+i,jx),i=0,2)
127 end if
128 c
129 c -------------------
130 c Diffusion tensor
131 c -------------------
132 isym=iparm(iirflg,jx)
133 if (lu.ne.luttyo) write (lu,2002) symstr(isym), 'R'
134 if (isym.eq.axial) then
135 write(lu,2006) hdr,(fparm(idx+i,jx),i=0,2,2)
136 else if (isym.eq.spherical) then
137 write(lu,1006) hdr,(fparm(idx+i,jx),i=0,2)
138 else
139 write(lu,1005) hdr,(fparm(idx+i,jx),i=0,2)
140 end if
141 c
142 c ------------------------------------------
143 c Gaussian inhomogeneous broadening
144 c ------------------------------------------
145 write (lu,1022) hdr, fparm(igib0,jx), fparm(igib2,jx)
146 c
147 c -------------------------------------------
148 c Non-Brownian rotational model parameters
149 c ------------------------------------------
150 write (lu,1007) hdr,iparm(iipdf,jx)
151 if (iparm(iipdf,jx).eq.1) then
152 do i=0,2
153 write(lu,1008) hdr,nonbr(i+1),nonbr(i+1),iparm(iml+i,jx),
154 # fparm(ipml+i,jx)
155 end do
156 c
157 c -- Anisotropic viscosity
158 c
159 else if (iparm(iipdf,jx).eq.2) then
160 write (lu,1009) hdr,fparm(idjf,jx),fparm(idjfprp,jx)
161 end if
162 c
163 c --- Discrete jump motion
164 if (iparm(iipdf,jx).ne.2 .and. iparm(iist,jx).ne.0 .and.
165 # npotn.gt.0) write (lu,1010) hdr,iparm(iist,jx),fparm(idjf,jx)
166 c
167 c ----------------------
168 c Orienting potential
169 c ----------------------
170 npotn=0
171 do i=0,4
172 if (dabs(fparm(ic20+i,jx)).gt.rndoff) npotn=i+1
173 end do
174 if (npotn.gt.0) then
175 write (lu,1011) hdr,(fparm(ic20+i,jx),i=0,4)
176 if (iparm(inort,jx).gt.0) write (lu,1012) hdr,iparm(inort,jx)
177 end if
178 c
179 c --------------------
180 c Heisenberg exchange
181 c --------------------
182 if (dabs(fparm(ioss,jx)).gt.rndoff)
183 # write (lu,1013) hdr,fparm(ioss,jx)
184 c
185 c -----------------
186 c Diffusion tilt
187 c -----------------
188 if (dabs(fparm(ibed,jx)).gt.rndoff)
189 # write (lu,1014) hdr,fparm(ibed,jx)
190 c
191 c -----------------------------
192 c Basis set and CG parameters
193 c -----------------------------
194 write (lu,1016) hdr,(iparm(ilemx+i,jx),i=0,ntrc-1)
195 write (lu,1017) hdr,iparm(instep,jx),fparm(icgtol,jx),
196 # fparm(ishift,jx),fparm(ishift+1,jx)
197 c
198 10 continue
199 c
200 c
201 return
202 c
203 c######################################################################
204 c
205 1000 format(a,'gxx,gyy,gzz = ',2(f9.6,','),f9.6)
206 1001 format(a,'g1,g2,g3 = ',2(f9.6,','),f9.6)
207 2001 format(a,'gprp,gpll = ',f9.6,',',f9.6)
208 2002 format(a,' ',a)
209 1002 format(a,'in2 =',i2)
210 1003 format(a,'in2,Axx,Ayy,Azz = ',i2,',',2(f7.2,','),f7.2)
211 1004 format(a,'in2,A1,A2,A3 = ',i2,',',2(f7.2,','),f7.2)
212 2004 format(a,'in2,Aprp,Apll = ',i2,',',f7.2,',',f7.2)
213 1005 format(a,'Rx,Ry,Rz = ',2(f8.4,','),f8.4)
214 1006 format(a,'Rbar,N,Nxy = ',2(f8.4,','),f8.4)
215 2006 format(a,'Rprp,Rpll = ',f8.4,',',f8.4)
216 3001 format(a,'Wxx,Wyy,Wzz = ',2(f7.3,','),f7.3)
217 3002 format(a,'W1,W2,W3 = ',2(f7.3,','),f7.3)
218 3003 format(a,'Wprp,Wpll = ',f7.3,',',f7.3)
219 1007 format(a,'ipdf = ',i1)
220 1008 format(a,'m',a2,', pm',a2,' = ',i2,',',g10.3)
221 1009 format(a,'djf,djfprp = ',f7.4,',',f7.4)
222 1010 format(a,'ist,djf =',i3,',',f7.4)
223 1011 format(a,'c20,c22,c40,c42,c44 = ',4(f7.3,','),f7.3)
224 1012 format(a,'nort = ',i3)
225 1013 format(a,'oss = ',f7.4)
226 1014 format(a,'bed =',f7.2)
227 1016 format(a,'lemx,lomx,kmn,kmx,mmn,mmx,ipnmx = ',6(i3,','),i3)
228 1017 format(a,'nstep,cgtol,shiftr,shifti = ',i4,',',2(g10.3,','),g10.3)
229 1018 format(/'sites =',i3)
230 1019 format(/a,' ','*** Parameters for site',i2,' ***'/)
231 1021 format(a,'lb(',i2,')=',f7.3)
232 1022 format(a,'gib0,gib2 =',f7.3,',',f7.3)
233 1023 format('series ',a,' = ',8(g10.3,' '))
234 2023 format(/a,' ','*** No series defined ***'/)
235 1024 format(a,'B0(',i2,')=',f10.3)
236 1025 format(a,'psi(',i2,')=',f8.3)
237 1026 format(a,'phase(',i2,')=',f7.2)
238 3000 format('*** Unable to open file ',a,' for parameter output ***')
239 end
eprprm::iml
integer, parameter iml
Definition: eprprm.f90:101
stdio::luout
integer, save luout
Definition: stdio.f90:32
eprprm::iist
integer, parameter iist
Definition: eprprm.f90:101
eprprm::ipml
integer, parameter ipml
Definition: eprprm.f90:92
eprprm::iiaflg
integer, parameter iiaflg
Definition: eprprm.f90:101
eprprm::idjf
integer, parameter idjf
Definition: eprprm.f90:92
eprprm::ioss
integer, parameter ioss
Definition: eprprm.f90:92
eprprm::igib2
integer, parameter igib2
Definition: eprprm.f90:92
eprprm::iiwflg
integer, parameter iiwflg
Definition: eprprm.f90:101
mtsdef::ntrc
integer, parameter ntrc
Definition: mtsdef.f90:29
eprprm::ibed
integer, parameter ibed
Definition: eprprm.f90:92
eprprm::iaxx
integer, parameter iaxx
Definition: eprprm.f90:92
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
symdef::axial
integer, parameter axial
Definition: symdef.f90:14
parcom
Definition: parcom.f90:42
parcom::serval
double precision, dimension(mxspc), save serval
Definition: parcom.f90:56
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
eprprm::igib0
integer, parameter igib0
Definition: eprprm.f90:92
parcom::nsite
integer, save nsite
Definition: parcom.f90:62
expdat::sphs
double precision, dimension(mxspc), save sphs
Definition: expdat.f90:40
eprprm::iirflg
integer, parameter iirflg
Definition: eprprm.f90:101
eprprm::instep
integer, parameter instep
Definition: eprprm.f90:101
parcom::iparm
integer, dimension(niprm, mxsite), target, save iparm
Definition: parcom.f90:60
eprprm::idx
integer, parameter idx
Definition: eprprm.f90:92
lpnam::symstr
character *10, dimension(nsymtr), save symstr
Definition: lpnam.f90:57
eprprm::iipdf
integer, parameter iipdf
Definition: eprprm.f90:101
parcom::nser
integer, save nser
Definition: parcom.f90:62
eprprm::iwxx
integer, parameter iwxx
Definition: eprprm.f90:92
eprprm::ishift
integer, parameter ishift
Definition: eprprm.f90:92
eprprm::igxx
integer, parameter igxx
Definition: eprprm.f90:92
lpnam
Definition: lpnam.f90:18
eprprm::ic20
integer, parameter ic20
Definition: eprprm.f90:92
parcom::iser
integer, save iser
Definition: parcom.f90:62
stdio::ludisk
integer, parameter ludisk
Definition: stdio.f90:29
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
parc
subroutine parc(line)
Definition: parc.f90:12
eprprm::iigflg
integer, parameter iigflg
Definition: eprprm.f90:101
eprprm::idjfprp
integer, parameter idjfprp
Definition: eprprm.f90:92
nlsdim
Definition: nlsdim.f90:36
expdat::sb0
double precision, dimension(mxspc), save sb0
Definition: expdat.f90:40
mtsdef
Definition: mtsdef.f90:26
eprprm::icgtol
integer, parameter icgtol
Definition: eprprm.f90:92
symdef::spherical
integer, parameter spherical
Definition: symdef.f90:14
expdat::slb
double precision, dimension(mxspc), save slb
Definition: expdat.f90:40
lpnam::parnam
character *6, dimension(nfprm), save parnam
Definition: lpnam.f90:27
rnddbl::rndoff
double precision, parameter rndoff
Definition: rnddbl.f90:86
symdef
Definition: symdef.f90:11
eprprm::iin2
integer, parameter iin2
Definition: eprprm.f90:101