NLSL: tensym.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

tensym.f90
Go to the documentation of this file.
1 c Version 1.3.2 5/15/94
2 c----------------------------------------------------------------------
3 c =====================================================
4 c subroutines TOCART, TOSPHR, and TOAXIL, and TCHECK
5 c =====================================================
6 c
7 c These subroutines interconvert among the three possible representations
8 c of the various tensors (in 3-space, including magnetic and diffusion
9 c tensors) used in EPR calculations, namely:
10 c (1) Cartesian representation
11 c (2) Spherical representation
12 c (3) Axial (actually also in Cartesian coordinates)
13 c
14 c The Cartesian representation is the familiar set of (x,y,z) components.
15 c If the Cartesian components of a tensor M are Mx, My, and Mz, then
16 c the "spherical" components M1, M2, and M3 are given by
17 c
18 c M1=(Mx+My+Mz)/3 (isotropic component)
19 c M2=Mz-(Mx+My)/2 (axial component)
20 c M3=Mx-My (rhombic component)
21 c
22 c Note that these components differ from the "true" second-order
23 c spherical tensor components, M(0,0), M(2,0), and M(2,2), respectively,
24 c by constant factors. They are expressed in this form so that they may
25 c be more directly correlated with experimental ESR spectra. These
26 c transformations are carried out by the TOSPHR routine.
27 c
28 c The third representation, "axial" is really in Cartesian coordinates
29 c as well, but affords the user the option of maintaining axial tensor
30 c symmetry while varying the Cartesian components.
31 c
32 c The transformation from spherical to cartesian components, the inverse
33 c of that given above, is carried out by TOCART and given by
34 c
35 c Mx=M1 - M2/3 + M3/2
36 c My=M1 - M2/3 - M3/2
37 c Mz=M1 + 2*M2/3
38 c----------------------------------------------------------------------
39 subroutine tocart( t, iflg )
40 c
41 use symdef
42 c
43 implicit none
44 double precision TWO,THREE,t(3),t1,t2,t3
45 integer x,y,z,iflg
46 c
47 parameter(two=2.0d0,three=3.0d0,x=1,y=2,z=3)
48 c
49 if (iflg.eq.cartesian) return
50 if (iflg.eq.axial) then
51 t(y)=t(x)
52 else if (iflg.eq.spherical) then
53 t1=t(x)
54 t2=t(y)
55 t3=t(z)
56 t(x)=t1 - t2/three + t3/two
57 t(y)=t1 - t2/three - t3/two
58 t(z)=t1 + two*t2/three
59 end if
60 return
61 end
62 c
63 c- tosphr -----------------------------------------------------------------
64 c
65 subroutine tosphr( t, iflg )
66 c
67 use symdef
68 c
69 implicit none
70 double precision TWO,THREE,t(3),tx,ty,tz
71 integer iflg
72 c
73 parameter(two=2.0d0,three=3.0d0)
74 c
75 if (iflg.eq.spherical) return
76 if (iflg.eq.axial) then
77 tx=t(1)
78 ty=t(1)
79 tz=t(3)
80 else if (iflg.eq.cartesian) then
81 tx=t(1)
82 ty=t(2)
83 tz=t(3)
84 end if
85 t(1)=(tx+ty+tz)/three
86 t(2)=tz-(tx+ty)/two
87 t(3)=(tx-ty)
88 return
89 end
90 c
91 c- toaxil -----------------------------------------------------------------
92 c
93 subroutine toaxil( t, iflg )
94 c
95 use symdef
96 c
97 implicit none
98 double precision t(3)
99 integer x,y,z,iflg
100 c
101 double precision TWO,ZERO
102 parameter(two=2.0d0,zero=0.0d0)
103 c
104 if (iflg.eq.axial) return
105 if (iflg.eq.spherical) call tocart( t,iflg )
106 t(1)=(t(1)+t(2))/two
107 t(2)=zero
108 return
109 end
110 c
111 c----------------------------------------------------------------------
112 c =========================
113 c function TCHECK
114 c =========================
115 c
116 c Checks whether the component of the g, A, or R (T) tensors specified
117 c by the ix index is consistent with the previous setting of the tensor
118 c mode flags. (igflg, iaflg, and irflg) TCHECK returns .true. if
119 c it is consistent (or if ix does not specify one of these tensors)
120 c and .false. if an inconsistency is detected.
121 c
122 c If a nonzero logical unit number is specified, any error messages will
123 c be directed to that unit.
124 c
125 c ix specifies tensor symmetry in the following way:
126 c ix < -100: axial mode
127 c -100 < ix < 0 : spherical mode
128 c ix > 0 : cartesian mode
129 c
130 c Mode flag = 0 indicates that mode has not yet been set
131 c 1 indicates that Cartesian mode has been set
132 c 2 indicates that spherical mode has been set
133 c 3 indicates that axial mode has been set
134 c
135 c----------------------------------------------------------------------
136 c
137 function tcheck(ix,ix2,ident,lumsg)
138 c
139 use nlsdim
140 use eprprm
141 use parcom
142 use lpnam
143 use stdio
144 use symdef
145 c
146 implicit none
147 logical tcheck
148 c
149 integer ispec,ix,ix2,ixa,ixf,jx,jx1,jx2,lu1,lu2,lumsg,mflag
150 character ident*9
151 c
152 logical symmsg
153 external symmsg
154 c......................................................................
155 c
156 c lu1 and lu2 are used to avoid redundant error messages when
157 c ix2 specifies a range of sites
158 c
159 lu1=lumsg
160 lu2=lumsg
161 c
162 if (ix .gt.0) ispec=cartesian
163 if (ix.gt.-100 .and. ix.lt.0) ispec=spherical
164 if (ix.lt.-100) ispec=axial
165 c
166 ixa=abs(mod(ix,100))
167 ixf=(ixa-iwxx)/3
168 c
169 c --- Return .true. for all parameters that have no aliases
170 c and for index out-of-bounds
171 c
172 tcheck = .true.
173 if (ixa.lt.iwxx .or. ixf.gt.mxsph-1 .or. ix2.gt.mxsite) return
174 c
175 if (ix2.le.0) then
176 jx1=1
177 jx2=mxsite
178 else
179 jx1=ix2
180 jx2=ix2
181 end if
182 c
183 do jx=jx1,jx2
184 mflag=iparm(iiwflg+ixf,jx)
185 c
186 c ------------------------------
187 c Check if mode is not yet set
188 c ------------------------------
189 c
190 if (mflag.eq.0) then
191 if (lu1.ne.0) then
192 write (lu1,1003) symstr(ispec),ident(1:1)
193 lu1=0
194 end if
195 c
196 c --------------------------------------------------------------------
197 c Check if tensors are specified as Cartesian when another mode is set
198 c --------------------------------------------------------------------
199 c
200 else if (ispec.eq.cartesian .and.
201 # (mflag.eq.spherical .or. mflag.eq.axial)) then
202 tcheck=symmsg(lu2,ident,jx,symstr(mflag))
203 c
204 c --------------------------------------------------------------------
205 c Check if tensors are specified as spherical when another mode is set
206 c --------------------------------------------------------------------
207 c
208 else if (ispec.eq.spherical .and.
209 # (mflag.eq.cartesian .or. mflag.eq.axial)) then
210 tcheck=symmsg(lu2,ident,jx,symstr(mflag))
211
212 c --------------------------------------------------------------------
213 c Check if tensors are specified as axial when another mode is set
214 c --------------------------------------------------------------------
215 c
216 else if (ispec.eq.axial .and.
217 # (mflag.eq.cartesian .or. mflag.eq.spherical)) then
218 tcheck=symmsg(lu2,ident,jx,symstr(mflag))
219 end if
220 c
221 c --------------------------------------------------------------------
222 c Set tensor mode flags according to type of tensor that has been
223 c specified
224 c --------------------------------------------------------------------
225 c
226 iparm(iiwflg+ixf,jx)=ispec
227 c
228 end do
229 return
230 c
231 c ### format statements ########################################
232 c
233 1003 format(' *** ',a,'form assumed for ',a,' tensor ***')
234 end
235
236
237
238 function symmsg( lu, ident, jx, form )
239 c
240 use stdio
241 c
242 implicit none
243 integer lu,jx
244 character ident*9,form*10
245 logical symmsg
246 c
247 integer itrim
248 external itrim
249 c
250 if (lu.ne.0) then
251 write (lu,1004) ident(:itrim(ident)),jx,form
252 if (lu.ne.luttyo) write (luttyo,1004) ident(:itrim(ident)),
253 # jx,form
254 end if
255 lu=0
256 symmsg=.false.
257 return
258 1004 format(' *** Cannot modify ''',a,'(',i1,')'': ',a,'form',
259 # ' has been specified ***')
260 end
261
262
263
264 function isaxial( t, iflg )
265 c
266 use rnddbl
267 use symdef
268 c
269 implicit none
270 double precision t(3)
271 integer iflg
272 logical isaxial
273 c
274 isaxial = (iflg.eq.axial) .or.
275 # (iflg.eq.spherical .and. abs(t(3)).lt.rndoff) .or.
276 # (iflg.eq.cartesian .and. abs(t(1)-t(2)).lt.rndoff)
277 return
278 end
279
280
281 function isrhomb( t, iflg )
282 c
283 use rnddbl
284 use symdef
285 c
286 implicit none
287 double precision t(3)
288 integer iflg
289 logical isrhomb
290 c
291 isrhomb = (iflg.eq.cartesian .and.
292 # abs(t(1)-t(2)).lt.rndoff .and.
293 # abs(t(2)-t(3)).lt.rndoff .and.
294 # abs(t(1)-t(3)).lt.rndoff ) .or.
295 # (iflg.eq.spherical .and.
296 # abs(t(2)).gt.rndoff .and.
297 # abs(t(3)).gt.rndoff )
298 return
299 end
300
301 function isisotr( t, iflg )
302 c
303 use rnddbl
304 use symdef
305 c
306 implicit none
307 double precision t(3)
308 integer iflg
309 logical isisotr
310 c
311 isisotr = (iflg.eq.cartesian .and.
312 # abs(t(1)-t(2)).lt.rndoff .and.
313 # abs(t(2)-t(3)).lt.rndoff ) .or.
314 # (iflg.eq.spherical .and.
315 # abs(t(2)).lt.rndoff .and.
316 # abs(t(3)).lt.rndoff ) .or.
317 # (iflg.eq.axial .and.
318 # abs(t(1)-t(3)).lt.rndoff)
319 return
320 end
321
isrhomb
logical function isrhomb(t, iflg)
Definition: tensym.f90:282
isaxial
logical function isaxial(t, iflg)
Definition: tensym.f90:265
isisotr
logical function isisotr(t, iflg)
Definition: tensym.f90:302
eprprm::iiwflg
integer, parameter iiwflg
Definition: eprprm.f90:101
toaxil
subroutine toaxil(t, iflg)
Definition: tensym.f90:94
tocart
subroutine tocart(t, iflg)
Definition: tensym.f90:40
stdio
Definition: stdio.f90:26
symdef::axial
integer, parameter axial
Definition: symdef.f90:14
symdef::cartesian
integer, parameter cartesian
Definition: symdef.f90:14
parcom
Definition: parcom.f90:42
tcheck
logical function tcheck(ix, ix2, ident, lumsg)
Definition: tensym.f90:138
parcom::iparm
integer, dimension(niprm, mxsite), target, save iparm
Definition: parcom.f90:60
lpnam::symstr
character *10, dimension(nsymtr), save symstr
Definition: lpnam.f90:57
nlsdim::mxsite
integer, parameter mxsite
Definition: nlsdim.f90:39
eprprm::iwxx
integer, parameter iwxx
Definition: eprprm.f90:92
nlsdim::mxsph
integer, parameter mxsph
Definition: nlsdim.f90:39
symmsg
logical function symmsg(lu, ident, jx, form)
Definition: tensym.f90:239
lpnam
Definition: lpnam.f90:18
stdio::luttyo
integer, parameter luttyo
Definition: stdio.f90:29
rnddbl
Definition: rnddbl.f90:77
eprprm
Definition: eprprm.f90:51
nlsdim
Definition: nlsdim.f90:36
symdef::spherical
integer, parameter spherical
Definition: symdef.f90:14
tosphr
subroutine tosphr(t, iflg)
Definition: tensym.f90:66
rnddbl::rndoff
double precision, parameter rndoff
Definition: rnddbl.f90:86
symdef
Definition: symdef.f90:11