SUBROUTINE JCONSX ( N, M, K, ITMAX, ALPHA, BETA, GAMMA, & DELTA, X, R, F, I, IEV2, KO, G, H, XC, L ) c*********************************************************************72 C C PURPOSE: C C TO FIND THE CONSTRAINED MAXIMUM OF A FUNCTION OF C SEVERAL VARIABLES BY THE COMPLEX METHOD OF M. J. BOX. C THIS IS THE PRIMARY SUBROUTINE AND COORDINATES THE C SPECIAL PURPOSE SUBROUTINES ( JCEK1, JCENT, JFUNC, C JCONST1). INITIAL GUESSES OF THE INDEPENDENT VARIABLES, C RANDOM NUMBERS, SOLUTION PARAMETERS, DIMENSION LIMITS C AND PRINTER CODE DESIGNATIONS ARE OBTAINED FROM THE MAIN C PROGRAM. FINAL FUNCTION AND INDEPENDENT VARIABLE C VALUES ARE TRANSFERRED TO THE MAIN PROGRAM FOR C PRINTOUT. INTERMEDIATE PRINTOUTS ARE PROVIDED IN THIS C SUBROUTINE. THE USER MUST PROVIDE THE MAIN PROGRAM AND C THE SUBROUTINES THAT SPECIFY THE FUNCTION (JFUNC) AND C CONSTRAINTS (JCNST1). FORMAT CHANGES MAY BE REQUIRED C WITHIN THIS SUBROUTINE DEPENDING ON THE PARTICULAR C PROBLEM UNDER CONSIDERATION. C C USAGE: C C CALL JCONSX(N,M,K,ITMAX,ALPHA,BETA,GAMMA,DELTA,X,R,F, C IT,IEV2,KO,G,H,XC,L) C C SUBROUTINES REQUIRED: C C JCEK1(N,M,K,X,G,H,I,KODE,XC,DELTA,L,K1) C CHECKS ALL POINTS AGAINS EXPLICIT AND IMPLICIT C CONSTRAINTS AND APPLIES CORRECTION IF VIOLATIONS ARE C FOUND. C C JCENT(N,M,K,IEV1,I,XC,X,L,K1) C CALCULATES THE CENTROID OF POINTS. C C JFUNC(N,M,K,X,F,I,L) C SPECIFIES THE OBJECTIVE FUNCTION (USER-SUPPLIED). C C JCNST1(N,M,K,X,G,H,I,L) C SPECIFIES EXPLICIT AND IMPLICIT CONSTRAINT LIMITS C (USER-SUPPLIED). ORDER EXPLICIT CONSTRAINTS FIRST. C C DESCRIPTION OF PARAMETERS: C C N NUMBER OF EXPLICIT INDEPENDENT VARIABLES - DEFINE C IN MAIN PROGRAM. C C M NUMBER OF SETS OF CONSTRAINTS - DEFINE IN MAIN C PROGRAM. C C K NUMBER OF POINTS IN THE COMPLEX - DEFINE IN MAIN C PROGRAM. C C ITMAX MAXIMUM NUMBER OF ITERATIONS - DEFINE IN MAIN C PROGRAM. C C ALPHA REFLECTION FACTOR - DEFINE IN MAIN PROGRAM. C C BETA CONVERGENCE PARAMETER - DEFINE IN MAIN PROGRAM. C C GAMMA CONVERGENCE PARAMETER - DEFINE IN MAIN PROGRAM. C C DELTA EXPLICIT CONSTRAINT VIOLATION CORRECTION - DEFINE C IN MAIN PROGRAM. C C X INDEPENDENT VARIABLES - DEFINE INITIAL VALUES IN C MAIN PROGRAM. C C R RANDOM NUMBERS BETWEEN 0 AND 1 - DEFINE IN MAIN C PROGRAM. C C F OBJECTIVE FUNCTION - DEFINE IN SUBROUTINE JFUNC. C C IT ITERATION INDEX - DEFINED IN SUBROUTINE JCONSX. C C IEV2 INDEX OF POINT WITH MAXIMUM FUNCTION VALUE - C DEFINED IN SUBROUTINE JCONSX. C C IEV1 INDEX OF POINT WITH MINIMUM FUNCTION VALUE - C DEFINED IN SUBROUTINE JCONSX AND JCEX1. C C KO PRINTER UNIT NUMBER - DEFINE IN MAIN PROGRAM. C C G LOWER CONSTRAINT - DEFINE IN SUBROUTINE JCNST1. C C H UPPER CONSTRAINT - DEFINE IN SUBROUTINE JCNST1. C C XC CENTROID - DEFINED IN SUBROUTINE JCENT. C C L TOTAL NUMBER OF INDEPENDENT VARIABLES (EXPLICIT + C IMPLICIT) - DEFINE IN MAIN PROGRAM. C C I PRINT INDEX - DEFINED IN SUBROUTINE JCONSX. C C KODE KEY USED TO DETERMINE IF IMPLICIT CONSTRAINTS ARE C PROVIDED - DEFINED IN SUBROUTINE JCONSX AND JCEX1. C C K1 DO LIMIT - DEFINED IN SUBROUTINE JCONSX. C IMPLICIT NONE INTEGER K INTEGER L INTEGER M INTEGER N REAL ALPHA REAL BETA REAL DELTA REAL F(K) REAL G(M) INTEGER GAMMA REAL H(M) INTEGER I INTEGER ICM INTEGER IEV1 INTEGER IEV2 INTEGER II INTEGER IT INTEGER ITMAX INTEGER J INTEGER JB INTEGER JJ INTEGER K1 INTEGER KO INTEGER KODE INTEGER KOUNT REAL R(K,N) REAL X(K,L) REAL XC(N) IT = 1 WRITE ( KO, 99995 ) IT KODE = 0 IF ( M - N ) 20, 20, 10 10 KODE = 1 20 CONTINUE DO 40 II = 2, K DO 30 J = 1, N X(II,J) = 0.0E+00 30 CONTINUE 40 CONTINUE C C CALCULATE COMPLEX POINTS AND CHECK AGAINST CONSTRAINTS. C DO 60 II = 2, K DO 50 J = 1, N I = II CALL JCNST1 ( N, M, K, X, G, H, I, L ) X(II,J) = G(J) + R(II,J) * ( H(J) - G(J) ) 50 CONTINUE K1 = II CALL JCEK1 ( N, M, K, X, G, H, I, KODE, XC, DELTA, L, K1 ) WRITE ( KO, 99999 ) II, ( X(II,J), J = 1, N ) 60 CONTINUE K1 = K DO 70 I = 1, K CALL JFUNC ( N, M, K, X, F, I, L ) 70 CONTINUE KOUNT = 1 C C FIND POINT WITH LOWEST FUNCTION VALUE. C WRITE ( KO, 99998 ) ( F(I), I = 1, K ) 80 IEV1 = 1 DO 100 ICM = 2, K IF ( F(IEV1) - F(ICM) ) 100, 100, 90 90 IEV1 = ICM 100 CONTINUE C C FIND POINT WITH HIGHEST FUNCTION VALUE. C IEV2 = 1 DO 120 ICM = 2, K IF ( F(IEV2) - F(ICM) ) 110, 110, 120 110 IEV2 = ICM 120 CONTINUE C C CHECK CONVERGENCE CRITERIA. C IF ( F(IEV2) - ( F(IEV1) + BETA ) ) 140, 130, 130 130 KOUNT = 1 GO TO 150 140 KOUNT = KOUNT + 1 IF ( KOUNT - GAMMA ) 150, 240, 240 C C REPLACE POINT WITH LOWEST FUNCTION VALUE. C 150 CALL JCENT ( N, M, K, IEV1, I, XC, X, L, K1 ) DO 160 J = 1, N X(IEV1,J) = ( 1.0E+00 + ALPHA ) & * ( XC(J) ) - ALPHA * ( X(IEV1,J) ) 160 CONTINUE I = IEV1 CALL JCEK1 ( N, M, K, X, G, H, I, KODE, XC, DELTA, L, K1 ) CALL JFUNC ( N, M, K, X, F, I, L ) C C REPLACE NEW POINT IF IT REPEATS AS LOWEST FUNCTION VALUE. C 170 IEV2 = 1 DO 190 ICM = 2, K IF ( F(IEV2) - F(ICM) ) 190, 190, 180 180 IEV2 = ICM 190 CONTINUE IF ( IEV2 - IEV1 ) 220, 200, 220 200 DO 210 JJ = 1, N X(IEV1,JJ) = ( X(IEV1,JJ) + XC(JJ) ) / 2.0E+00 210 CONTINUE I = IEV1 CALL JCEK1 ( N, M, K, X, G, H, I, KODE, XC, DELTA, L, K1 ) CALL JFUNC ( N, M, K, X, F, I, L ) GO TO 170 220 CONTINUE WRITE ( KO, 99997 ) ( X(IEV1,JB), JB = 1, N ) WRITE ( KO, 99998 ) ( F(I), I = 1, K ) WRITE ( KO, 99996 ) ( XC(J), J = 1, N ) IT = IT + 1 IF ( IT - ITMAX ) 230, 230, 240 230 CONTINUE WRITE ( KO, 99995 ) IT GO TO 80 240 RETURN 99999 FORMAT ( 1H , 15X, 21H COORDINATES AT POINT, I4/8(F8.4, 2X) ) 99998 FORMAT ( 1H , 20X, 16H FUNCTION VALUES, /8(F10.4, 2X ) ) 99997 FORMAT ( 1H , 20X, 16H CORRECTED POINT, /8(F8.4, 2X ) ) 99996 FORMAT ( 1H , 21H CENTROID COORDINATES, 2X, 5(F8.4, 2X) ) 99995 FORMAT ( 1H , //10H ITERATION, 4X, I5 ) END SUBROUTINE JCEK1 ( N, M, K, X, G, H, I, KODE, XC, DELTA, L, & K1 ) c*********************************************************************72 C C PURPOSE: C C TO CHECK ALL POINTS AGAINST THE EXPLICIT AND IMPLICIT C CONSTRAINTS AND TO APPLY CORRECTIONS IF VIOLATIONS ARE C FOUND. C C USAGE: C C CALL JCEK1(N,M,K,X,G,H,I,KODE,XC,DELTA,L,K1) C C SUBROUTINES REQUIRED: C C JCENT(N,M,K,IEV1,I,XC,X,L,K1) C JCNST1(N,M,K,X,G,H,I,L) C C DESCRIPTION OF PARAMETERS: C C PREVIOUSLY DEFINED IN SUBROUTINE JCONSX C IMPLICIT NONE INTEGER K INTEGER L INTEGER M INTEGER N REAL DELTA REAL G(M) REAL H(M) INTEGER I INTEGER IEV1 INTEGER J INTEGER JJ INTEGER K1 INTEGER KODE INTEGER KT INTEGER NN REAL X(K,L) REAL XC(N) 10 KT = 0 CALL JCNST1 ( N, M, K, X, G, H, I, L ) C C CHECK AGAINST EXPLICIT CONSTRAINTS. C DO 50 J = 1, N IF ( X(I,J) - G(J) ) 20, 20, 30 20 X(I,J) = G(J) + DELTA GO TO 50 30 IF ( H(J) - X(I,J) ) 40, 40, 50 40 X(I,J) = H(J) - DELTA 50 CONTINUE IF ( KODE ) 110, 110, 60 C C CHECK AGAINST THE IMPLICIT CONSTRAINTS. C 60 CONTINUE NN = N + 1 DO 100 J = NN, M CALL JCNST1 ( N, M, K, X, G, H, I, L ) IF ( X(I,J) - G(J) ) 80, 70, 70 70 IF ( H(J) - X(I,J) ) 80, 100, 100 80 IEV1 = I KT = 1 CALL JCENT ( N, M, K, IEV1, I, XC, X, L, K1 ) DO 90 JJ = 1, N X(I,JJ) = ( X(I,JJ) + XC(JJ) ) / 2.0E+00 90 CONTINUE 100 CONTINUE IF ( KT ) 110, 110, 10 110 RETURN END SUBROUTINE JCENT ( N, M, K, IEV1, I, XC, X, L, K1 ) c*********************************************************************72 C C PURPOSE: C C TO CALCULATE THE CENTROID OF POINTS. C C USAGE: C C CALL JCENT ( N, M, K, IEV1, I, XC, X, L, K1 ) C C SUBROUTINES REQUIRED: C C NONE. C C DESCRIPTION OF PARAMETERS: C C PREVIOUSLY DEFINED IN SUBROUTINE JCONSX. C IMPLICIT NONE INTEGER K INTEGER L INTEGER N INTEGER I INTEGER IEV1 INTEGER IL INTEGER J INTEGER K1 INTEGER M REAL RK REAL X(K,L) REAL XC(N) DO 20 J = 1, N XC(J) = 0.0E+00 DO 10 IL = 1, K1 XC(J) = XC(J) + X(IL,J) 10 CONTINUE RK = K1 XC(J) = ( XC(J) - X(IEV1,J) ) / ( RK - 1.0E+00 ) 20 CONTINUE RETURN END