168 lines
6.2 KiB
Fortran
168 lines
6.2 KiB
Fortran
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
MODULE TRANSFORMS
|
||
|
|
!
|
||
|
|
USE ACCURACY_REAL
|
||
|
|
!
|
||
|
|
CONTAINS
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
SUBROUTINE KK(TR,NS,X,U_INP,UR_INF,U_OUT)
|
||
|
|
!
|
||
|
|
! This subroutine computes the Kramers-Kronig transform
|
||
|
|
!
|
||
|
|
! U_OUT(X) = KK( I_INP(X) )
|
||
|
|
!
|
||
|
|
! with U_INP(X) = UR(X)/UI(X)
|
||
|
|
! U_OUT(X) = UI(X)/UR(X)
|
||
|
|
!
|
||
|
|
! The convention here is that UR(X) is an even function of X and that
|
||
|
|
! UI(X) is an odd function of X
|
||
|
|
!
|
||
|
|
! In this case, we have the Kramers-Kronig relations:
|
||
|
|
!
|
||
|
|
! _ _
|
||
|
|
! | / + inf |
|
||
|
|
! 2 | | X' UI(X') - X UI(X) |
|
||
|
|
! UR(X) = ---- P | | ------------------- dX' | + UR(+ inf)
|
||
|
|
! pi | | X'^2 - X^2 |
|
||
|
|
! |_ / 0 _|
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! _ _
|
||
|
|
! | / + inf |
|
||
|
|
! 2X | | UR(X') - UR(X) |
|
||
|
|
! UI(X) = - ---- P | | -------------------- dX' |
|
||
|
|
! pi | | X'^2 - X^2 |
|
||
|
|
! |_ / 0 _|
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! where the Cauchy' principal part P[ ] can be removed
|
||
|
|
! as the integrand is no longer singular at X' = X
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * TR : type of transformation
|
||
|
|
! TR = 'R2I' --> UI = KK(UR)
|
||
|
|
! TR = 'I2R' --> UR = KK(UI)
|
||
|
|
! * NS : size of arrays of X, UR and UI
|
||
|
|
! * X : argument array of UR/UI
|
||
|
|
! * U_INP : input array
|
||
|
|
! * UR_INF : value of UR(X) for X --> + inf
|
||
|
|
!
|
||
|
|
! Output variables :
|
||
|
|
!
|
||
|
|
! * U_OUT : output array
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Author : D. Sébilleau
|
||
|
|
!
|
||
|
|
! Last modified : 4 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE DIMENSION_CODE, ONLY : NSIZE
|
||
|
|
USE REAL_NUMBERS, ONLY : ZERO,ONE,TWO,HALF
|
||
|
|
USE PI_ETC, ONLY : PI
|
||
|
|
USE INTEGRATION, ONLY : INTEGR_L
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP) :: X(NS),U_INP(NS),U_OUT(NS)
|
||
|
|
REAL (WP) :: UR_INF
|
||
|
|
REAL (WP) :: ADD,COEF,H
|
||
|
|
REAL (WP) :: I1,C,R1,R2
|
||
|
|
REAL (WP) :: F0(NSIZE),G1(NSIZE)
|
||
|
|
!
|
||
|
|
INTEGER :: NS
|
||
|
|
INTEGER :: J,ID,NSIZE1,K
|
||
|
|
INTEGER :: LOGF
|
||
|
|
!
|
||
|
|
CHARACTER (LEN = 3) :: TR
|
||
|
|
!
|
||
|
|
LOGF=6 !
|
||
|
|
!
|
||
|
|
ID=0 !
|
||
|
|
!
|
||
|
|
! Integration bound
|
||
|
|
!
|
||
|
|
NSIZE1=NS !
|
||
|
|
!
|
||
|
|
! Checking for the dimensioning
|
||
|
|
!
|
||
|
|
IF(NS > NSIZE) THEN !
|
||
|
|
WRITE(LOGF,10) !
|
||
|
|
STOP !
|
||
|
|
ENDIF !
|
||
|
|
!
|
||
|
|
H=X(2)-X(1) ! step
|
||
|
|
!
|
||
|
|
! Initialization
|
||
|
|
!
|
||
|
|
DO J=1,NS !
|
||
|
|
IF(TR == 'R2I') THEN !
|
||
|
|
F0(J)=U_INP(J) !
|
||
|
|
ELSE IF(TR == 'I2R') THEN !
|
||
|
|
F0(J)=X(J)*U_INP(J) !
|
||
|
|
END IF !
|
||
|
|
G1(J)=ZERO !
|
||
|
|
END DO !
|
||
|
|
!
|
||
|
|
! Case-dependent sign
|
||
|
|
!
|
||
|
|
IF(TR == 'R2I') THEN !
|
||
|
|
COEF=+TWO/PI !
|
||
|
|
ADD=ZERO !
|
||
|
|
ELSE IF(TR == 'I2R') THEN !
|
||
|
|
COEF=-TWO/PI !
|
||
|
|
ADD=UR_INF !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
! Loop over omega
|
||
|
|
!
|
||
|
|
DO J=1,NS !
|
||
|
|
!
|
||
|
|
IF(TR == 'R2I') THEN !
|
||
|
|
C=X(J) !
|
||
|
|
ELSE IF(TR == 'I2R') THEN !
|
||
|
|
C=ONE !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
! Computing the integrand functions
|
||
|
|
!
|
||
|
|
DO K=2,NS-1 !
|
||
|
|
IF(K /= J) THEN !
|
||
|
|
G1(K)=(F0(K)-F0(J)) / & !
|
||
|
|
(X(K)*X(K)-X(J)*X(J)) !
|
||
|
|
END IF !
|
||
|
|
END DO !
|
||
|
|
R1=(X(1)-X(2))/(X(3)-X(2)) !
|
||
|
|
R2=(X(NS)-X(NS-1))/(X(NS-2)-X(NS-1)) !
|
||
|
|
G1(1)=G1(2)+R1*(G1(3)-G1(2)) !
|
||
|
|
G1(NS)=G1(NS-1)+R2*(G1(NS-2)-G1(NS-1)) !
|
||
|
|
IF( (J /= 1) .AND. (J /= NS) ) THEN !
|
||
|
|
G1(J)=HALF*(G1(J-1)+G1(J+1)) !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
! Computing the integrals with Lagrange method
|
||
|
|
!
|
||
|
|
CALL INTEGR_L(G1,H,NS,NSIZE1,I1,ID) !
|
||
|
|
!
|
||
|
|
! Result of transform
|
||
|
|
!
|
||
|
|
U_OUT(J)=ADD - C * COEF * I1 !
|
||
|
|
END DO !
|
||
|
|
!
|
||
|
|
! Format
|
||
|
|
!
|
||
|
|
10 FORMAT(//,5X,'<<<<< Size > NSIZE >>>>>', & !
|
||
|
|
/,5X,'<<<<< Increase NSIZE >>>>>',//) !
|
||
|
|
!
|
||
|
|
END SUBROUTINE KK
|
||
|
|
!
|
||
|
|
!
|
||
|
|
END MODULE TRANSFORMS
|