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 | |
---|
29 | !SUBROUTINES CALLED: |
---|
30 | |
---|
31 | !FUNCTION DEFINITIONS: |
---|
32 | |
---|
33 | !DATA STATEMENTS: |
---|
34 | |
---|
35 | DATA STOFW/2.35482005/ !2*SQRT(2LN2) |
---|
36 | DATA SQ2PI/2.506628275/ !SQRT(2PI) |
---|
37 | DATA COFT/1.0,2.69269,2.42843,4.47163,0.07842,1.0/ |
---|
38 | DATA COFN/1.36603,-0.47719,0.11116/ |
---|
39 | |
---|
40 | !CODE: |
---|
41 | |
---|
42 | SQSG = MAX(SQRT(SIG),0.001) |
---|
43 | FWHG = STOFW*SQSG |
---|
44 | PGL = FWHG**5 |
---|
45 | SUMHM = PGL |
---|
46 | DSDL = 0.0 |
---|
47 | DSDG = 0.0 |
---|
48 | DO ITRM=1,5 |
---|
49 | PGL = PGL/FWHG |
---|
50 | DSDL = DSDL+FLOAT(ITRM)*COFT(ITRM+1)*PGL |
---|
51 | DSDG = DSDG+FLOAT(6-ITRM)*COFT(ITRM)*PGL |
---|
52 | PGL = PGL*GAM |
---|
53 | SUMHM = SUMHM+COFT(ITRM+1)*PGL |
---|
54 | END DO |
---|
55 | FWHM = EXP(0.2*LOG(SUMHM)) |
---|
56 | FRAC = GAM/FWHM |
---|
57 | DEDF = 0.0 |
---|
58 | PF = 1.0 |
---|
59 | ETA = 0.0 |
---|
60 | DO ITRM=1,3 |
---|
61 | DEDF = DEDF+FLOAT(ITRM)*COFN(ITRM)*PF |
---|
62 | PF = PF*FRAC |
---|
63 | ETA = ETA+COFN(ITRM)*PF |
---|
64 | END DO |
---|
65 | CALL LORENTZ(DX,FWHM,TL,DTLDT,DTLDFW) |
---|
66 | SIGP = (FWHM/STOFW)**2 |
---|
67 | EX = MAX(-20.0,-0.5*DX**2/SIGP) |
---|
68 | TG = STOFW*EXP(EX)/(SQ2PI*FWHM) |
---|
69 | FUNC = ETA*TL+(1.0-ETA)*TG |
---|
70 | |
---|
71 | TS = -2.0*(1.0-ETA)*TG*(EX+0.5)/FWHM |
---|
72 | DFDX = ETA*DTLDT-(1.0-ETA)*TG*DX/SIGP |
---|
73 | |
---|
74 | DFWDG = 0.2*DSDG*FWHM/SUMHM |
---|
75 | DFRDG = -FRAC*DFWDG/FWHM |
---|
76 | DFDS = DEDF*DFRDG*(TL-TG)+(ETA*DTLDFW+TS)*DFWDG |
---|
77 | DFDS = 0.5*DFDS*STOFW/SQSG |
---|
78 | |
---|
79 | DFWDL = 0.2*DSDL*FWHM/SUMHM |
---|
80 | DFRDL = (1.0-FRAC*DFWDL)/FWHM |
---|
81 | DFDG = DEDF*DFRDL*(TL-TG)+(ETA*DTLDFW+TS)*DFWDL |
---|
82 | |
---|
83 | RETURN |
---|
84 | END |
---|
85 | |
---|
86 | SUBROUTINE PSVOIGT2(DX,SIG,GAM,FUNC,DFDX,DFDS,DFDG) |
---|
87 | |
---|
88 | !PURPOSE: Compute function & derivatives pseudovoigt - unfinished; |
---|
89 | ! no derivatives |
---|
90 | !pseudo Voigt W.I.F. David, J. Appl. Cryst. 19, 63-64 (1986) |
---|
91 | |
---|
92 | INCLUDE '../INCLDS/COPYRIGT.FOR' |
---|
93 | |
---|
94 | !PSEUDOCODE: |
---|
95 | |
---|
96 | !CALLING ARGUMENTS: |
---|
97 | |
---|
98 | REAL*4 DX !Delta-x from center |
---|
99 | REAL*4 SIG !Gaussian variance |
---|
100 | REAL*4 GAM !Lorentzian FWHM |
---|
101 | REAL*4 FUNC !Value of pseudo-Voigt at DX |
---|
102 | REAL*4 DFDX !dF/dx |
---|
103 | REAL*4 DFDS !dF/ds |
---|
104 | REAL*4 DFDG !dF/dg |
---|
105 | |
---|
106 | !INCLUDE STATEMENTS: |
---|
107 | |
---|
108 | !LOCAL VARIABLES: |
---|
109 | |
---|
110 | REAL*4 GNORM !Gaussian Normalization constant |
---|
111 | REAL*4 COFEG(7),COFEL(7),COFGG(6),COFGL(6) |
---|
112 | |
---|
113 | !SUBROUTINES CALLED: |
---|
114 | |
---|
115 | !FUNCTION DEFINITIONS: |
---|
116 | |
---|
117 | !DATA STATEMENTS: |
---|
118 | |
---|
119 | DATA STOFW/2.35482005/ !2*SQRT(2LN2) |
---|
120 | DATA SQ2PI/2.506628275/ !SQRT(2PI) |
---|
121 | DATA ITYPE/1/ |
---|
122 | DATA COFEG/0.00268,0.75458,2.88898,-3.85144,-.55765,3.03824, |
---|
123 | 1 -1.27539/ |
---|
124 | DATA COFEL/1.35248,0.41168,-2.18731,6.42452,-10.29036,6.88093, |
---|
125 | 1 -1.59194/ |
---|
126 | DATA COFGG/-.50734,-.22744,1.63804,-2.28532,1.31943,0.0/ |
---|
127 | DATA COFGL/-.99725,1.14594,2.56150,-6.52088,5.82647,-1.91086/ |
---|
128 | |
---|
129 | !CODE: |
---|
130 | |
---|
131 | SQSG = MAX(SQRT(SIG),0.001) |
---|
132 | FWHG = STOFW*SQSG |
---|
133 | FW = FWHG+GAM |
---|
134 | R1 = FWHG/FW |
---|
135 | R17 = R1 |
---|
136 | R2 = GAM/FWHG |
---|
137 | R27 = R2 |
---|
138 | DSDL = 0.0 |
---|
139 | DSDG = 0.0 |
---|
140 | ETAG = 0.0 |
---|
141 | ETAL = 0.0 |
---|
142 | DO ITRM=1,7 |
---|
143 | ETAG = ETAG+R17*COFEG(ITRM) |
---|
144 | ETAL = ETAL+R27*COFEL(ITRM) |
---|
145 | R17 = R17*R1 |
---|
146 | R27 = R27*R2 |
---|
147 | END DO |
---|
148 | WG = 1.0 |
---|
149 | WL = 1.0 |
---|
150 | R16 = R1 |
---|
151 | R26 = R2 |
---|
152 | DO ITRM=1,6 |
---|
153 | WG = WG+R26*COFGG(ITRM) |
---|
154 | WL = WL+R16*COFGL(ITRM) |
---|
155 | R16 = R16*R1 |
---|
156 | R26 = R26*R2 |
---|
157 | END DO |
---|
158 | CALL LORENTZ(DX,WL,TL,DTLDT,DTLDFW) |
---|
159 | SIGP = (WG/STOFW)**2 |
---|
160 | EX = MAX(-20.0,-0.5*DX**2/SIGP) |
---|
161 | TG = STOFW*EXP(EX)/(SQ2PI*FWHM) |
---|
162 | FUNC = ETAL*TL+ETAG*TG |
---|
163 | |
---|
164 | ! Unfinished - no derivatives |
---|
165 | |
---|
166 | RETURN |
---|
167 | END |
---|