1 | SUBROUTINE PSVOIGT(DX,SIG,GAM,FUNC,DFDX,DFDS,DFDG) |
---|
2 | |
---|
3 | !PURPOSE: Compute function & derivatives pseudovoigt |
---|
4 | !pseudo Voigt P.Tompson, D.E. Cox & J.B. Hastings (1987). J. Appl. Cryst.,20,79-83 |
---|
5 | |
---|
6 | INCLUDE '../INCLDS/COPYRIGT.FOR' |
---|
7 | |
---|
8 | !PSEUDOCODE: |
---|
9 | |
---|
10 | !CALLING ARGUMENTS: |
---|
11 | |
---|
12 | REAL*4 DX !Delta-x from center |
---|
13 | REAL*4 SIG !Gaussian variance |
---|
14 | REAL*4 GAM !Lorentzian FWHM |
---|
15 | REAL*4 FUNC !Value of pseudo-Voigt at DX |
---|
16 | REAL*4 DFDX !dF/dx |
---|
17 | REAL*4 DFDS !dF/ds |
---|
18 | REAL*4 DFDG !dF/dg |
---|
19 | |
---|
20 | !INCLUDE STATEMENTS: |
---|
21 | |
---|
22 | !LOCAL VARIABLES: |
---|
23 | |
---|
24 | REAL*4 COFG(6),COFL(6) !Linear combination coeffs |
---|
25 | REAL*4 ACOFG(7),ACOFL(7) |
---|
26 | REAL*4 GNORM !Gaussian Normalization constant |
---|
27 | REAL*4 COFT(6),COFN(3) |
---|
28 | REAL*4 EPS !Are values different |
---|
29 | ! Local variables saved between calls |
---|
30 | REAL*4 prev_sig,prev_gam |
---|
31 | REAL*4 eta,fwhm,frac,dsdg,dsdl,sumhm,dedf,sqsg |
---|
32 | save eta,fwhm,frac,prev_sig,prev_gam,dsdg,dsdl,sumhm, |
---|
33 | 1 dedf,sqsg |
---|
34 | |
---|
35 | !SUBROUTINES CALLED: |
---|
36 | |
---|
37 | !FUNCTION DEFINITIONS: |
---|
38 | |
---|
39 | !DATA STATEMENTS: |
---|
40 | |
---|
41 | DATA STOFW/2.35482005/ !2*SQRT(2LN2) |
---|
42 | DATA SQ2PI/2.506628275/ !SQRT(2PI) |
---|
43 | DATA COFT/1.0,2.69269,2.42843,4.47163,0.07842,1.0/ |
---|
44 | DATA COFN/1.36603,-0.47719,0.11116/ |
---|
45 | DATA prev_sig/-1.0/ |
---|
46 | DATA prev_gam/-1.0/ |
---|
47 | DATA eps/1.0e-10/ !Threshold for recalculation |
---|
48 | |
---|
49 | !CODE: |
---|
50 | |
---|
51 | ! Check for repeat call |
---|
52 | if (abs(prev_sig-sig) .gt. eps .or. |
---|
53 | 1 (abs(prev_gam-gam).gt.eps)) then !need to recalculate |
---|
54 | prev_sig = sig |
---|
55 | prev_gam = gam |
---|
56 | SQSG = MAX(SQRT(SIG),0.001) |
---|
57 | FWHG = STOFW*SQSG |
---|
58 | PGL = FWHG**5 |
---|
59 | SUMHM = PGL |
---|
60 | DSDL = 0.0 |
---|
61 | DSDG = 0.0 |
---|
62 | DO ITRM=1,5 |
---|
63 | PGL = PGL/FWHG |
---|
64 | DSDL = DSDL+FLOAT(ITRM)*COFT(ITRM+1)*PGL |
---|
65 | DSDG = DSDG+FLOAT(6-ITRM)*COFT(ITRM)*PGL |
---|
66 | PGL = PGL*GAM |
---|
67 | SUMHM = SUMHM+COFT(ITRM+1)*PGL |
---|
68 | END DO |
---|
69 | FWHM = EXP(0.2*LOG(SUMHM)) |
---|
70 | FRAC = GAM/FWHM |
---|
71 | DEDF = 0.0 |
---|
72 | PF = 1.0 |
---|
73 | ETA = 0.0 |
---|
74 | DO ITRM=1,3 |
---|
75 | DEDF = DEDF+FLOAT(ITRM)*COFN(ITRM)*PF |
---|
76 | PF = PF*FRAC |
---|
77 | ETA = ETA+COFN(ITRM)*PF |
---|
78 | END DO |
---|
79 | end if !end of recalculation step |
---|
80 | CALL LORENTZ(DX,FWHM,TL,DTLDT,DTLDFW) |
---|
81 | SIGP = (FWHM/STOFW)**2 |
---|
82 | EX = MAX(-20.0,-0.5*DX**2/SIGP) |
---|
83 | TG = STOFW*EXP(EX)/(SQ2PI*FWHM) |
---|
84 | FUNC = ETA*TL+(1.0-ETA)*TG |
---|
85 | |
---|
86 | TS = -2.0*(1.0-ETA)*TG*(EX+0.5)/FWHM |
---|
87 | DFDX = ETA*DTLDT-(1.0-ETA)*TG*DX/SIGP |
---|
88 | |
---|
89 | DFWDG = 0.2*DSDG*FWHM/SUMHM |
---|
90 | DFRDG = -FRAC*DFWDG/FWHM |
---|
91 | DFDS = DEDF*DFRDG*(TL-TG)+(ETA*DTLDFW+TS)*DFWDG |
---|
92 | DFDS = 0.5*DFDS*STOFW/SQSG |
---|
93 | |
---|
94 | DFWDL = 0.2*DSDL*FWHM/SUMHM |
---|
95 | DFRDL = (1.0-FRAC*DFWDL)/FWHM |
---|
96 | DFDG = DEDF*DFRDL*(TL-TG)+(ETA*DTLDFW+TS)*DFWDL |
---|
97 | |
---|
98 | RETURN |
---|
99 | END |
---|
100 | |
---|
101 | SUBROUTINE PSVOIGT2(DX,SIG,GAM,FUNC,DFDX,DFDS,DFDG) |
---|
102 | |
---|
103 | !PURPOSE: Compute function & derivatives pseudovoigt - unfinished; |
---|
104 | ! no derivatives |
---|
105 | !pseudo Voigt W.I.F. David, J. Appl. Cryst. 19, 63-64 (1986) |
---|
106 | |
---|
107 | INCLUDE '../INCLDS/COPYRIGT.FOR' |
---|
108 | |
---|
109 | !PSEUDOCODE: |
---|
110 | |
---|
111 | !CALLING ARGUMENTS: |
---|
112 | |
---|
113 | REAL*4 DX !Delta-x from center |
---|
114 | REAL*4 SIG !Gaussian variance |
---|
115 | REAL*4 GAM !Lorentzian FWHM |
---|
116 | REAL*4 FUNC !Value of pseudo-Voigt at DX |
---|
117 | REAL*4 DFDX !dF/dx |
---|
118 | REAL*4 DFDS !dF/ds |
---|
119 | REAL*4 DFDG !dF/dg |
---|
120 | |
---|
121 | !INCLUDE STATEMENTS: |
---|
122 | |
---|
123 | !LOCAL VARIABLES: |
---|
124 | |
---|
125 | REAL*4 GNORM !Gaussian Normalization constant |
---|
126 | REAL*4 COFEG(7),COFEL(7),COFGG(6),COFGL(6) |
---|
127 | |
---|
128 | !SUBROUTINES CALLED: |
---|
129 | |
---|
130 | !FUNCTION DEFINITIONS: |
---|
131 | |
---|
132 | !DATA STATEMENTS: |
---|
133 | |
---|
134 | DATA STOFW/2.35482005/ !2*SQRT(2LN2) |
---|
135 | DATA SQ2PI/2.506628275/ !SQRT(2PI) |
---|
136 | DATA ITYPE/1/ |
---|
137 | DATA COFEG/0.00268,0.75458,2.88898,-3.85144,-.55765,3.03824, |
---|
138 | 1 -1.27539/ |
---|
139 | DATA COFEL/1.35248,0.41168,-2.18731,6.42452,-10.29036,6.88093, |
---|
140 | 1 -1.59194/ |
---|
141 | DATA COFGG/-.50734,-.22744,1.63804,-2.28532,1.31943,0.0/ |
---|
142 | DATA COFGL/-.99725,1.14594,2.56150,-6.52088,5.82647,-1.91086/ |
---|
143 | |
---|
144 | !CODE: |
---|
145 | |
---|
146 | SQSG = MAX(SQRT(SIG),0.001) |
---|
147 | FWHG = STOFW*SQSG |
---|
148 | FW = FWHG+GAM |
---|
149 | R1 = FWHG/FW |
---|
150 | R17 = R1 |
---|
151 | R2 = GAM/FWHG |
---|
152 | R27 = R2 |
---|
153 | DSDL = 0.0 |
---|
154 | DSDG = 0.0 |
---|
155 | ETAG = 0.0 |
---|
156 | ETAL = 0.0 |
---|
157 | DO ITRM=1,7 |
---|
158 | ETAG = ETAG+R17*COFEG(ITRM) |
---|
159 | ETAL = ETAL+R27*COFEL(ITRM) |
---|
160 | R17 = R17*R1 |
---|
161 | R27 = R27*R2 |
---|
162 | END DO |
---|
163 | WG = 1.0 |
---|
164 | WL = 1.0 |
---|
165 | R16 = R1 |
---|
166 | R26 = R2 |
---|
167 | DO ITRM=1,6 |
---|
168 | WG = WG+R26*COFGG(ITRM) |
---|
169 | WL = WL+R16*COFGL(ITRM) |
---|
170 | R16 = R16*R1 |
---|
171 | R26 = R26*R2 |
---|
172 | END DO |
---|
173 | CALL LORENTZ(DX,WL,TL,DTLDT,DTLDFW) |
---|
174 | SIGP = (WG/STOFW)**2 |
---|
175 | EX = MAX(-20.0,-0.5*DX**2/SIGP) |
---|
176 | TG = STOFW*EXP(EX)/(SQ2PI*FWHM) |
---|
177 | FUNC = ETAL*TL+ETAG*TG |
---|
178 | |
---|
179 | ! Unfinished - no derivatives |
---|
180 | |
---|
181 | RETURN |
---|
182 | END |
---|