! !======================================================================= ! 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