| 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 | DATA ITYPE/1/ |
|---|
| 40 | |
|---|
| 41 | !CODE: |
|---|
| 42 | |
|---|
| 43 | SQSG = MAX(SQRT(SIG),0.001) |
|---|
| 44 | FWHG = STOFW*SQSG |
|---|
| 45 | PGL = FWHG**5 |
|---|
| 46 | SUMHM = PGL |
|---|
| 47 | DSDL = 0.0 |
|---|
| 48 | DSDG = 0.0 |
|---|
| 49 | DO ITRM=1,5 |
|---|
| 50 | PGL = PGL/FWHG |
|---|
| 51 | DSDL = DSDL+FLOAT(ITRM)*COFT(ITRM+1)*PGL |
|---|
| 52 | DSDG = DSDG+FLOAT(6-ITRM)*COFT(ITRM)*PGL |
|---|
| 53 | PGL = PGL*GAM |
|---|
| 54 | SUMHM = SUMHM+COFT(ITRM+1)*PGL |
|---|
| 55 | END DO |
|---|
| 56 | FWHM = EXP(0.2*LOG(SUMHM)) |
|---|
| 57 | FRAC = GAM/FWHM |
|---|
| 58 | DEDF = 0.0 |
|---|
| 59 | PF = 1.0 |
|---|
| 60 | ETA = 0.0 |
|---|
| 61 | DO ITRM=1,3 |
|---|
| 62 | DEDF = DEDF+FLOAT(ITRM)*COFN(ITRM)*PF |
|---|
| 63 | PF = PF*FRAC |
|---|
| 64 | ETA = ETA+COFN(ITRM)*PF |
|---|
| 65 | END DO |
|---|
| 66 | CALL LORENTZ(DX,FWHM,TL,DTLDT,DTLDFW) |
|---|
| 67 | SIGP = (FWHM/STOFW)**2 |
|---|
| 68 | EX = MAX(-20.0,-0.5*DX**2/SIGP) |
|---|
| 69 | TG = STOFW*EXP(EX)/(SQ2PI*FWHM) |
|---|
| 70 | FUNC = ETA*TL+(1.0-ETA)*TG |
|---|
| 71 | |
|---|
| 72 | TS = -2.0*(1.0-ETA)*TG*(EX+0.5)/FWHM |
|---|
| 73 | DFDX = ETA*DTLDT-(1.0-ETA)*TG*DX/SIGP |
|---|
| 74 | |
|---|
| 75 | DFWDG = 0.2*DSDG*FWHM/SUMHM |
|---|
| 76 | DFRDG = -FRAC*DFWDG/FWHM |
|---|
| 77 | DFDS = DEDF*DFRDG*(TL-TG)+(ETA*DTLDFW+TS)*DFWDG |
|---|
| 78 | DFDS = 0.5*DFDS*STOFW/SQSG |
|---|
| 79 | |
|---|
| 80 | DFWDL = 0.2*DSDL*FWHM/SUMHM |
|---|
| 81 | DFRDL = (1.0-FRAC*DFWDL)/FWHM |
|---|
| 82 | DFDG = DEDF*DFRDL*(TL-TG)+(ETA*DTLDFW+TS)*DFWDL |
|---|
| 83 | |
|---|
| 84 | RETURN |
|---|
| 85 | END |
|---|
