C MAIN PROGRAM TO TEST FIXPQF, FIXPNF, FIXPDF, STEPNX, AND ROOTNX. C BROWN'S FUNCTION, ZERO FINDING. C C THIS PROGRAM TESTS THE HOMPACK ROUTINES FIXPQF, FIXPNF, C FIXPDF, STEPNX, AND ROOTNX. C C THE OUTPUT FROM THIS ROUTINE SHOULD BE AS FOLLOWS, WITH THE C EXECUTION TIMES CORRESPONDING TO A DEC AXP 3000/600. C C TESTING FIXPQF C C LAMBDA = 1.00000000 FLAG = 1 6 JACOBIAN EVALUATIONS C EXECUTION TIME(SECS) = 0.106 ARCLEN = 2.693 C 1.00000000E+00 1.00000000E+00 1.00000000E+00 1.00000000E+00 C 1.00000000E+00 C C C TESTING FIXPNF C C LAMBDA = 1.00000000 FLAG = 1 19 JACOBIAN EVALUATIONS C EXECUTION TIME(SECS) = 0.005 ARCLEN = 2.676 C 1.00000000E+00 1.00000000E+00 1.00000000E+00 1.00000000E+00 C 1.00000000E+00 C C C TESTING FIXPDF C C LAMBDA = 1.00000000 FLAG = 1 71 JACOBIAN EVALUATIONS C EXECUTION TIME(SECS) = 0.016 ARCLEN = 2.712 C 1.00000000E+00 1.00000000E+00 1.00000000E+00 1.00000000E+00 C 1.00000000E+00 C C C TESTING STEPNX AND ROOTNX C C LAMBDA = 1.00000000 FLAG = -1 80 JACOBIAN EVALUATIONS C EXECUTION TIME(SECS) = 0.020 ARCLEN = 2.711 C 1.00000000E+00 1.00000000E+00 1.00000000E+00 1.00000000E+00 C 1.00000000E+00 C C PROGRAM TESTF USE REAL_PRECISION, ONLY : R8 USE HOMPACK90, ONLY : FIXPDF, FIXPNF, FIXPQF IMPLICIT NONE INTEGER, PARAMETER:: N=5, NDIMA=5 REAL (KIND=R8):: A(N),ANSAE,ANSRE,ARCAE,ARCRE, & ARCLEN,DTIME,SSPAR(8),Y(N+1) INTEGER:: IFLAG,II,J,NFE,NP1,TIMENEW(8),TIMEOLD(8),TRACE CHARACTER (LEN=6) NAME ! If using a subroutine library of the HOMPACK90 subroutines rather than ! the MODULE HOMPACK90 (as above), then the following INTERFACE ! statements are necessary. ! INTERFACE ! SUBROUTINE FIXPDF(N,Y,IFLAG,ARCTOL,EPS,TRACE,A,NDIMA, ! & NFE,ARCLEN) ! USE REAL_PRECISION ! INTEGER, INTENT(IN)::N,NDIMA,TRACE ! REAL (KIND=R8), DIMENSION(:), INTENT(IN OUT)::A,Y ! INTEGER, INTENT(IN OUT)::IFLAG ! REAL (KIND=R8), INTENT(IN OUT)::ARCTOL,EPS ! INTEGER, INTENT(OUT)::NFE ! REAL (KIND=R8), INTENT(OUT)::ARCLEN ! END SUBROUTINE FIXPDF C ! SUBROUTINE FIXPNF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A, ! & SSPAR,NFE,ARCLEN,POLY_SWITCH) ! USE REAL_PRECISION ! INTEGER, INTENT(IN)::N,TRACE ! REAL (KIND=R8), DIMENSION(:), INTENT(IN OUT)::A,Y ! INTEGER, INTENT(IN OUT)::IFLAG ! REAL (KIND=R8), INTENT(IN OUT)::ANSAE,ANSRE,ARCAE,ARCRE, ! & SSPAR(8) ! INTEGER, INTENT(OUT)::NFE ! REAL (KIND=R8), INTENT(OUT)::ARCLEN ! LOGICAL, INTENT(IN), OPTIONAL::POLY_SWITCH ! END SUBROUTINE FIXPNF C ! SUBROUTINE FIXPQF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A, ! & SSPAR,NFE,ARCLEN) ! USE REAL_PRECISION ! INTEGER, INTENT(IN)::N,TRACE ! REAL (KIND=R8), DIMENSION(:), INTENT(IN OUT)::A,Y ! INTEGER, INTENT(IN OUT)::IFLAG ! REAL (KIND=R8), INTENT(IN OUT)::ANSAE,ANSRE,ARCAE,ARCRE, ! & SSPAR(4) ! INTEGER, INTENT(OUT)::NFE ! REAL (KIND=R8), INTENT(OUT)::ARCLEN ! END SUBROUTINE FIXPQF ! END INTERFACE C C TEST EACH OF THE THREE ALGORITHMS. C DO II=1,3 C C DEFINE ARGUMENTS FOR CALL TO HOMPACK PROCEDURE. C NP1=N+1 ARCRE=0.5D-4 ARCAE=0.5D-4 ANSRE=1.0D-10 ANSAE=1.0D-10 TRACE=0 SSPAR=0.0 IFLAG=-1 Y(2:NP1)=0.0 C C GET CURRENT DATE AND TIME. C CALL DATE_AND_TIME(VALUES=TIMEOLD) C C CALL TO HOMPACK ROUTINE. C IF (II .EQ. 1) THEN NAME='FIXPQF' CALL FIXPQF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A, & SSPAR,NFE,ARCLEN) ELSE IF (II .EQ. 2) THEN NAME='FIXPNF' CALL FIXPNF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A, & SSPAR,NFE,ARCLEN) ELSE NAME='FIXPDF' CALL FIXPDF(N,Y,IFLAG,ARCRE,ANSRE,TRACE,A,NDIMA,NFE,ARCLEN) END IF C C CALCULATE EXECUTION TIME. C CALL DATE_AND_TIME(VALUES=TIMENEW) IF (TIMENEW(8) .LT. TIMEOLD(8)) THEN TIMENEW(8)=TIMENEW(8)+1000 TIMENEW(7)=TIMENEW(7)-1 ENDIF IF (TIMENEW(7) .LT. TIMEOLD(7)) THEN TIMENEW(7)=TIMENEW(7)+60 TIMENEW(6)=TIMENEW(6)-1 ENDIF IF (TIMENEW(6) .LT. TIMEOLD(6)) THEN TIMENEW(6)=TIMENEW(6)+60 TIMENEW(5)=TIMENEW(5)-1 ENDIF IF (TIMENEW(5) .LT. TIMEOLD(5)) TIMENEW(5)=TIMENEW(5)+24 DTIME=DOT_PRODUCT(TIMENEW(5:8)-TIMEOLD(5:8), & (/3600000,60000,1000,1/) )/1000.0 C WRITE (6,45) NAME 45 FORMAT (//,7X,'TESTING',1X,A6) WRITE (6,50) Y(1),IFLAG,NFE,DTIME,ARCLEN,(Y(J),J=2,NP1) 50 FORMAT(/' LAMBDA =',F11.8,' FLAG =',I2,I8,' JACOBIAN ', & 'EVALUATIONS',/,1X,'EXECUTION TIME(SECS) =',F10.3,4X, & 'ARCLEN =',F10.3/(1X,4ES16.8)) END DO C C TEST REVERSE CALL SUBROUTINES STEPNX AND ROOTNX ON THE SAME C PROBLEM. C CALL MAINX STOP END PROGRAM TESTF ! ! SAMPLE USER WRITTEN HOMOTOPY SUBROUTINES FOR TESTING FIXP*F. ! SUBROUTINE F(X,V) C******************************************************************** C C SUBROUTINE F(X,V) -- EVALUATES BROWN'S FUNCTION AT THE POINT C X, AND RETURNS THE VALUE IN V. C C******************************************************************** USE REAL_PRECISION, ONLY : R8 IMPLICIT NONE REAL (KIND=R8), INTENT(IN):: X(:) REAL (KIND=R8), INTENT(OUT):: V(:) INTEGER:: N N=SIZE(X) V(1)=PRODUCT(X) - 1.0 V(2:N)=SUM(X) - (N+1) + X(2:N) RETURN END SUBROUTINE F SUBROUTINE FJAC(X,V,K) C******************************************************************** C C SUBROUTINE FJAC(X,V,K) -- EVALUATES THE K-TH COLUMN OF C THE JACOBIAN MATRIX FOR BROWN'S FUNCTION EVALUATED AT C THE POINT X, RETURNING THE VALUE IN V. C C******************************************************************** USE REAL_PRECISION, ONLY : R8 REAL (KIND=R8), INTENT(IN):: X(:) REAL (KIND=R8), INTENT(OUT):: V(:) INTEGER, INTENT(IN):: K INTEGER:: J,N REAL (KIND=R8):: PROD C N=SIZE(X) PROD=1.0 DO J=1,K-1 PROD=PROD*X(J) END DO DO J=K+1,N PROD=PROD*X(J) END DO V(1)=PROD V(2:N)=1.0 IF (K .GT. 1) V(K)=V(K)+1.0 RETURN END SUBROUTINE FJAC C ********************************************************************** C C THE REST OF THESE SUBROUTINES ARE NOT USED BY PROGRAM TESTF, AND ARE C INCLUDED HERE SIMPLY FOR COMPLETENESS AND AS TEMPLATES FOR THEIR USE. C SUBROUTINE RHO(A,LAMBDA,X,V) USE REAL_PRECISION, ONLY : R8 USE HOMPACK90_GLOBAL REAL (KIND=R8), INTENT(IN):: A(:),X(:) REAL (KIND=R8), INTENT(IN OUT):: LAMBDA REAL (KIND=R8), INTENT(OUT):: V(:) C C EVALUATE RHO(A,LAMBDA,X) AND RETURN IN THE VECTOR V . C C THE FOLLOWING CODE IS SPECIFICALLY FOR THE POLYNOMIAL SYSTEM DRIVER C POLSYS1H , AND SHOULD BE USED VERBATIM WITH POLSYS1H . IF THE USER IS C CALLING FIXP?? OR STEP?? DIRECTLY, HE MUST SUPPLY APPROPRIATE C REPLACEMENT CODE HERE. INTERFACE SUBROUTINE HFUNP(N,A,LAMBDA,X) USE REAL_PRECISION INTEGER, INTENT(IN):: N REAL (KIND=R8), INTENT(IN):: A(2*N),LAMBDA,X(2*N) END SUBROUTINE HFUNP END INTERFACE INTEGER:: J,NPOL C FORCE PREDICTED POINT TO HAVE LAMBDA .GE. 0 . IF (LAMBDA .LT. 0.0) LAMBDA=0.0 NPOL=IPAR(1) ! CALL HFUNP(NPOL,A,LAMBDA,X) DO J=1,2*NPOL V(J)=PAR(IPAR(3 + (4-1)) + (J-1)) END DO C RETURN END SUBROUTINE RHO SUBROUTINE RHOA(A,LAMBDA,X) USE REAL_PRECISION, ONLY : R8 REAL (KIND=R8), INTENT(OUT):: A(:) REAL (KIND=R8), INTENT(IN):: LAMBDA,X(:) C C CALCULATE AND RETURN IN A THE VECTOR Z SUCH THAT C RHO(Z,LAMBDA,X) = 0 . C A(1)=LAMBDA ! INTENT(OUT) VARIABLE MUST BE DEFINED. RETURN END SUBROUTINE RHOA SUBROUTINE RHOJAC(A,LAMBDA,X,V,K) USE REAL_PRECISION, ONLY : R8 USE HOMPACK90_GLOBAL REAL (KIND=R8), INTENT(IN):: A(:),X(:) REAL (KIND=R8), INTENT(IN OUT):: LAMBDA REAL (KIND=R8), INTENT(OUT):: V(:) INTEGER, INTENT(IN):: K C C RETURN IN THE VECTOR V THE KTH COLUMN OF THE JACOBIAN C MATRIX [D RHO/D LAMBDA, D RHO/DX] EVALUATED AT THE POINT C (A, LAMBDA, X). C C THE FOLLOWING CODE IS SPECIFICALLY FOR THE POLYNOMIAL SYSTEM DRIVER C POLSYS1H , AND SHOULD BE USED VERBATIM WITH POLSYS1H . IF THE USER IS C CALLING FIXP?? OR STEP?? DIRECTLY, HE MUST SUPPLY APPROPRIATE C REPLACEMENT CODE HERE. INTERFACE SUBROUTINE HFUNP(N,A,LAMBDA,X) USE REAL_PRECISION INTEGER, INTENT(IN):: N REAL (KIND=R8), INTENT(IN):: A(2*N),LAMBDA,X(2*N) END SUBROUTINE HFUNP END INTERFACE INTEGER:: J,NPOL,N2 NPOL=IPAR(1) N2=2*NPOL IF (K .EQ. 1) THEN C FORCE PREDICTED POINT TO HAVE LAMBDA .GE. 0 . IF (LAMBDA .LT. 0.0) LAMBDA=0.0 ! CALL HFUNP(NPOL,A,LAMBDA,X) DO J=1,N2 V(J)=PAR(IPAR(3 + (6-1)) + (J-1)) END DO RETURN ELSE DO J=1,N2 V(J)=PAR(IPAR(3 + (5-1)) + (J-1) + N2*(K-2)) END DO ENDIF C RETURN END SUBROUTINE RHOJAC SUBROUTINE FJACS(X) USE REAL_PRECISION, ONLY : R8 USE HOMPACK90_GLOBAL REAL (KIND=R8), INTENT(IN):: X(:) C C If MODE = 1, C evaluate the N x N symmetric Jacobian matrix of F(X) at X, and return C the result in packed skyline storage format in QRSPARSE. LENQR is the C length of QRSPARSE, and ROWPOS contains the indices of the diagonal C elements of the Jacobian matrix within QRSPARSE. ROWPOS(N+1) and C ROWPOS(N+2) are set by subroutine FODEDS. The allocatable array COLPOS C is not used by this storage format. C C If MODE = 2, C evaluate the N x N Jacobian matrix of F(X) at X, and return the result C in sparse row storage format in QRSPARSE. LENQR is the length of C QRSPARSE, ROWPOS contains the indices of where each row begins within C QRSPARSE, and COLPOS (of length LENQR) contains the column indices of C the corresponding elements in QRSPARSE. Even if zero, the diagonal C elements of the Jacobian matrix must be stored in QRSPARSE. C RETURN END SUBROUTINE FJACS SUBROUTINE RHOJS(A,LAMBDA,X) USE REAL_PRECISION, ONLY : R8 USE HOMPACK90_GLOBAL REAL (KIND=R8), INTENT(IN):: A(:),LAMBDA,X(:) C C If MODE = 1, C evaluate the N x N symmetric Jacobian matrix of F(X) at X, and return C the result in packed skyline storage format in QRSPARSE. LENQR is the C length of QRSPARSE, and ROWPOS contains the indices of the diagonal C elements of the Jacobian matrix within QRSPARSE. ROWPOS(N+1) and C ROWPOS(N+2) are set by subroutine FODEDS. The allocatable array COLPOS C is not used by this storage format. C C If MODE = 2, C evaluate the N x N Jacobian matrix of F(X) at X, and return the result C in sparse row storage format in QRSPARSE. LENQR is the length of C QRSPARSE, ROWPOS contains the indices of where each row begins within C QRSPARSE, and COLPOS (of length LENQR) contains the column indices of C the corresponding elements in QRSPARSE. Even if zero, the diagonal C elements of the Jacobian matrix must be stored in QRSPARSE. C RETURN END SUBROUTINE RHOJS C ********************************************************************** C C SUBROUTINE TO TEST THE REVERSE CALL SUBROUTINES STEPNX AND C ROOTNX. THE TEST PROBLEM IS BROWN'S FUNCTION, ZERO FINDING. C THE OUTPUT IS SIMILAR TO THAT FROM THE TEST OF FIXPNF, EXCEPT WITH C MORE JACOBIAN EVALUATIONS SINCE THE UNDEFINED FUNCTION OPTION OF C STEPNX IS USED TO FORCE SMALLER STEPS. C SUBROUTINE MAINX USE REAL_PRECISION, ONLY : R8 USE HOMOTOPY IMPLICIT NONE INTEGER, PARAMETER:: N=5, NDIMA=5 REAL (KIND=R8):: A(NDIMA),ABSERR,ALPHA(3*N+3), & ANSAE,ANSRE,ARCAE,ARCRE,ARCLEN,DTIME,GOFW,H,HOLD, & QR(N,N+2),RELERR,RHOLEN,S,SSPAR(8),TZ(N+1),W(N+1), & WP(N+1),Y(N+1),YOLD(N+1),YOLDS(N+1),YP(N+1),YPOLD(N+1) INTEGER:: IFLAG,ITER=0,J,NFE,NFEC=0,NP1,PIVOT(N+1), & TIMENEW(8),TIMEOLD(8),TRACE LOGICAL:: CRASH, START C INTERFACE SUBROUTINE ROOTNX(N,NFE,IFLAG,RELERR,ABSERR,Y,YP,YOLD, & YPOLD,A,GOFW,TZ,W,WP) USE HOMOTOPY USE REAL_PRECISION INTEGER, INTENT(IN):: N INTEGER, INTENT(IN OUT):: NFE,IFLAG REAL (KIND=R8), INTENT(IN):: RELERR,ABSERR REAL (KIND=R8), DIMENSION(:), INTENT(IN):: A REAL (KIND=R8), INTENT(IN OUT):: GOFW REAL (KIND=R8), DIMENSION(:), INTENT(IN OUT):: Y,YP,YOLD,YPOLD, & TZ,W,WP END SUBROUTINE ROOTNX SUBROUTINE STEPNX(N,NFE,IFLAG,START,CRASH,HOLD,H,RELERR, & ABSERR,S,Y,YP,YOLD,YPOLD,A,TZ,W,WP,RHOLEN,SSPAR) USE HOMOTOPY USE REAL_PRECISION INTEGER, INTENT(IN):: N INTEGER, INTENT(IN OUT):: NFE,IFLAG LOGICAL, INTENT(IN OUT):: START,CRASH REAL (KIND=R8), INTENT(IN OUT):: HOLD,H,RELERR,ABSERR,S,RHOLEN, & SSPAR(8) REAL (KIND=R8), DIMENSION(:), INTENT(IN):: A REAL (KIND=R8), DIMENSION(:), INTENT(IN OUT):: Y,YP,YOLD,YPOLD, & TZ,W,WP REAL (KIND=R8), DIMENSION(:), ALLOCATABLE, SAVE:: Z0,Z1 END SUBROUTINE STEPNX SUBROUTINE TANGNF(RHOLEN,Y,YP,YPOLD,A,QR,ALPHA,TZ,PIVOT, & NFE,N,IFLAG) USE REAL_PRECISION REAL (KIND=R8):: RHOLEN INTEGER:: IFLAG,N,NFE REAL (KIND=R8):: A(:),Y(:),YP(N+1),YPOLD(N+1) REAL (KIND=R8):: ALPHA(3*N+3),QR(N,N+2),TZ(N+1) INTEGER:: PIVOT(N+1) END SUBROUTINE TANGNF END INTERFACE C C DEFINE ARGUMENTS FOR CALL TO HOMPACK PROCEDURE. C NP1=N+1 NFE=0 ARCRE=0.5D-4 ARCAE=0.5D-4 ANSRE=1.0D-10 ANSAE=1.0D-10 ABSERR=ARCAE; RELERR=ARCRE TRACE=0 SSPAR=0.0 IFLAG=-1 A=0.0 Y(1:NP1)=0.0 YP(1)=1.0; YP(2:NP1)=0.0 YOLD=Y; YPOLD=YP START=.TRUE. CRASH=.FALSE. HOLD=1.0 H=.1 S=0.0 C C GET CURRENT DATE AND TIME. C CALL DATE_AND_TIME(VALUES=TIMEOLD) C C TRACK CURVE TILL LAMBDA > 1.0 . C TRACK: DO WHILE (Y(1) < 1.0_R8) CALL STEPNX (N,NFE,IFLAG,START,CRASH,HOLD,H,RELERR, & ABSERR,S,Y,YP,YOLD,YPOLD,A,TZ,W,WP,RHOLEN,SSPAR) IF (CRASH) CYCLE TRACK SELECT CASE (IFLAG) CASE (-2:0) IF (TRACE .GT. 0) THEN ITER=ITER+1 WRITE (TRACE,11) ITER,NFE,S,Y(1),Y(2:NP1) 11 FORMAT(/' STEP',I5,3X,'NFE =',I5,3X,'ARC LENGTH =', & F9.4,3X,'LAMBDA =',F7.4,5X,'X VECTOR:'/(1X,6ES12.4)) ENDIF CYCLE TRACK CASE (-12:-10) ! TANGENT VECTOR IF (H > .1_R8) THEN IFLAG = IFLAG - 100 CYCLE TRACK END IF RHOLEN=0.0 CALL TANGNF(RHOLEN,W,WP,YPOLD,A,QR,ALPHA,TZ,PIVOT, & NFEC,N,IFLAG) CASE (-32:-20) ! TANGENT VECTOR AND NEWTON STEP IF (H > .1_R8) THEN IFLAG = IFLAG - 100 CYCLE TRACK END IF RHOLEN=-1.0 CALL TANGNF(RHOLEN,W,WP,YPOLD,A,QR,ALPHA,TZ,PIVOT, & NFEC,N,IFLAG) CASE (4,6,7) WRITE (6,13) IFLAG 13 FORMAT(/' FATAL ERROR OCCURRED DURING TRACKING WITH', & ' FLAG =',I2,//) STOP END SELECT END DO TRACK C C CLEAN UP WORKING STORAGE. IFLAG=IFLAG - 40 CALL STEPNX (N,NFE,IFLAG,START,CRASH,HOLD,H,RELERR, & ABSERR,S,Y,YP,YOLD,YPOLD,A,TZ,W,WP,RHOLEN,SSPAR) C SAVE YOLD FOR ARC LENGTH CALCULATION LATER. YOLDS = YOLD C C FIND POINT ON HOMOTOPY ZERO CURVE SATISFYING C G(Y(S)) = LAMBDA(S) - 1 = 0 . C ABSERR=ANSAE RELERR=ANSRE END_GAME: DO CALL ROOTNX(N,NFE,IFLAG,RELERR,ABSERR,Y,YP,YOLD, & YPOLD,A,GOFW,TZ,W,WP) SELECT CASE (IFLAG) CASE (-42:-10) ! G(W) GOFW = W(1) - 1.0 CASE (-52:-50) ! TANGENT VECTOR AND NEWTON STEP RHOLEN=-1.0 CALL TANGNF(RHOLEN,W,WP,YPOLD,A,QR,ALPHA,TZ,PIVOT, & NFEC,N,IFLAG) CASE (-2:0, 4, 6, 7) EXIT END_GAME END SELECT END DO END_GAME C CALCULATE FINAL ARC LENGTH. W = Y - YOLDS ARCLEN = S - HOLD + SQRT(DOT_PRODUCT(W,W)) C C CALCULATE EXECUTION TIME. C CALL DATE_AND_TIME(VALUES=TIMENEW) IF (TIMENEW(8) .LT. TIMEOLD(8)) THEN TIMENEW(8)=TIMENEW(8)+1000 TIMENEW(7)=TIMENEW(7)-1 ENDIF IF (TIMENEW(7) .LT. TIMEOLD(7)) THEN TIMENEW(7)=TIMENEW(7)+60 TIMENEW(6)=TIMENEW(6)-1 ENDIF IF (TIMENEW(6) .LT. TIMEOLD(6)) THEN TIMENEW(6)=TIMENEW(6)+60 TIMENEW(5)=TIMENEW(5)-1 ENDIF IF (TIMENEW(5) .LT. TIMEOLD(5)) TIMENEW(5)=TIMENEW(5)+24 DTIME=DOT_PRODUCT(TIMENEW(5:8)-TIMEOLD(5:8), & (/3600000,60000,1000,1/) )/1000.0 C WRITE (6,45) 45 FORMAT (//,7X,'TESTING STEPNX AND ROOTNX') WRITE (6,50) Y(1),IFLAG,NFE,DTIME,ARCLEN,(Y(J),J=2,NP1) 50 FORMAT(/' LAMBDA =',F11.8,' FLAG =',I3,I8,' JACOBIAN ', & 'EVALUATIONS',/,1X,'EXECUTION TIME(SECS) =',F10.3,4X, & 'ARCLEN =',F10.3/(1X,4ES16.8)) RETURN END SUBROUTINE MAINX