program test implicit none integer ndim double precision x0(10),xt(10),fvalue ndim=2 x0(1)=-90.0d0 x0(2)=1000.0d0 call GSA(ndim,x0,xt,fvalue) write(*,*)fvalue,xt(1),xt(2) end * Generalized Simulated Annealing - Code * Program developed by Members of Lab. of Molecular Modeling * Kleber C. Mundim (1995) * ------------------------------------------------------ * Global optimization method using Generalized Simulated Annealing * as for example; * GSA Procedure + Your objective/coust function * ______________ __________________ * | | Set of Parameters | | * | | =================> | Routine with | * | GSA-routine | | your objective | * | | <================= | function | * |______________| Objective function |__________________| * * ------------------------------------------------------ * First Version Jan./1994 (Kleber Mundim and Constantino Tsallis) * Second Version Jun./1995 (Marcelo Moret) * Third Version Sep./1995 (Thierry Lemaire and Amin Bassrei) * * Some Basic References and literature citation: * *1- Title : Geometry Optimization and Conformational Analysis Through * Generalized Simulated Annealing * Authors : Kleber C. Mundim and Constantino Tsallis * Journal : Int.Journal of Quantum Chemistry, 58 (1996),373-381 * *2- Title : Stochastic Molecular Optimization using Generalized * Simulated Annealing * Authors : Marcelo Moret, Pedro G. Pascutti, Paulo M. Bish * and Kleber C. Mundim * Journal : Journal of Computational Chemistry, 19 (1998) 647-657 * *3- Title : Modeling Gravity Anomalies Through Generalized * Simulated Annealing * Authors : Kleber C. Mundim, Thierry Lemaire and Amin Bassrei * Journal : Physica A, 252 (1998) 405-416 * ------------------------------------------------------ * Most important vectors and parameters used in the GSA routines. * NDimension --> Number of parameters to be optimized (problem dependent). * X_t(i) --> This vector contains the parameters. * X_0(i) --> X_0(i) contains X_t at the time t-1. * X_Min --> Minimal parameters obtained. * To --> Initial Temperature. * qV --> qV caracterize the Visiting Probability Function. * qA --> qA Acceptance Parameter. * qT --> qT Temperature parameter * NStopMax --> Maximum number of GSA loops (problem dependent). * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | subroutine GSA(ndim,X0,Xt,fvalue) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | * This routine start the GSA-loop IMPLICIT DOUBLE PRECISION (A-H,O-Z) PARAMETER (MaxDim=500) dimension X0(ndim),Xt(ndim) COMMON /Par1/ qV1,qV2,qA1,qT1,D,exp1,exp2,Coef,Tqt,To,ToScale COMMON /Par2/ qA,qV,qT COMMON /Par3/ NDimension,NStopMax,NRAN COMMON /Xvector/ X_t(Maxdim), X_0(Maxdim), X_Min(Maxdim) DATA One /1.0D+00/ NDimension=ndim CALL GSAini() DO i=1,NDimension X_0(i)=X0(i) X_Min(i) = X_0(i) X_t(i) = X_0(i) ENDDO func_0 = func(X_0) func_Min = func_0 func_t = func_0 OneqA1 = One/qA1 Time = 0.0D0 NCycle = 0 DO WHILE (NCycle.LE.NStopMax) Time = Time + One NCycle = NCycle + 1 T = Tqt/((One+Time)**qT1 - One) IF(D.EQ.0.0D0) THEN Tup = One ELSE Tup = T**(D/(qT-3.0D0)) ENDIF CALL Gfunc(T,Tup) func_t = func(X_t) IF(func_t .LE. func_0) THEN DO I=1, NDimension X_0(I) = X_t(I) ENDDO func_0 = func_t IF(func_t .LE. func_Min) THEN func_Min = func_t DO I=1,NDimension X_Min(I) = X_t(I) ENDDO ENDIF ELSE DeltaE = func_t - func_0 qA1= qA - One PqA = One/((One+qA1*DeltaE/T)**OneqA1) Rand = RAN3(NRAN) IF(Rand .LT. PqA) THEN DO I=1,NDimension X_0(I) = X_t(I) ENDDO func_0 = func_t ENDIF ENDIF ENDDO fvalue=func_t do I=1,ndim Xt(I)=X_t(I) enddo return END * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | SUBROUTINE Gfunc(T,Tup) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | * This routine evaluate the new set o parameters using the * visiting probability function g(q,T). IMPLICIT DOUBLE PRECISION (A-H,O-Z) PARAMETER (MaxDim=500) COMMON /Par1/ qV1,qV2,qA1,qT1,D,exp1,exp2,Coef,Tqt,To,ToScale COMMON /Par3/ NDimension,NStopMax,NRAN COMMON /Xvector/ X_t(Maxdim), X_0(Maxdim), X_Min(Maxdim) DATA One /1.00000D+00/ DO I = 1,NDimension R = RAN3(NRAN) S = RAN3(NRAN) DeltaX = Coef*Tup/(One+qV1*R*R/T**exp1)**exp2 IF(S.LE.0.5) DeltaX = -DeltaX X_t(I) = X_0(I) + DeltaX ENDDO RETURN END * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | FUNCTION dgamma(r) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | * This routine evaluate usual Gamma function. IMPLICIT REAL*8 (a - h, o - z) PARAMETER ( 1 p0 = 0.999999999999999990d+00, p1 = -0.422784335098466784d+00, 2 p2 = -0.233093736421782878d+00, p3 = 0.191091101387638410d+00, 3 p4 = -0.024552490005641278d+00, p5 = -0.017645244547851414d+00, 4 p6 = 0.008023273027855346d+00) PARAMETER ( 1 p7 = -0.000804329819255744d+00,p8 = -0.000360837876648255d+00, 2 p9 = 0.000145596568617526d+00,p10 = -0.000017545539395205d+00, 3 p11 = -0.000002591225267689d+00,p12 = 0.000001337767384067d+00, 4 p13 = -0.000000199542863674d+00) n = NINT(r - 2) w = r - (n + 2) y = ((((((((((((p13 * w + p12)* w + p11)* w + p10)* 1 w + p9) * w + p8) * w + p7) * w + p6) * w + p5) * 2 w + p4) * w + p3) * w + p2) * w + p1) * w + p0 IF (n .gt. 0) THEN w = r - 1 DO k = 2, n w = w * (r - k) END DO ELSE w = 1 DO k = 0, -n - 1 y = y * (r + k) END DO END IF dgamma = w / y RETURN END * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | DOUBLE PRECISION FUNCTION RAN3(IDUM) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | IMPLICIT DOUBLE PRECISION (A-H,O-Z) * This routine return an randomic number 0<= r <= 1 C IMPLICIT REAL*4(M) C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=2.5D-7) PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1.D-9) COMMON /RAN1A/ IFF,MJ,MK,INEXT,INEXTP,MA(55) * DATA IFF /0/ * INEXT=0 * INEXTP=31 IF(IDUM.LT.0.OR.IFF.EQ.0)THEN IFF=1 MJ=MSEED-IABS(IDUM) MJ=MOD(MJ,MBIG) MA(55)=MJ MK=1 DO 11 I=1,54 II=MOD(21*I,55) MA(II)=MK MK=MJ-MK IF(MK.LT.MZ)MK=MK+MBIG MJ=MA(II) 11 CONTINUE DO 13 K=1,4 DO 12 I=1,55 MA(I)=MA(I)-MA(1+MOD(I+30,55)) IF(MA(I).LT.MZ)MA(I)=MA(I)+MBIG 12 CONTINUE 13 CONTINUE INEXT=0 INEXTP=31 IDUM=1 ENDIF INEXT=INEXT+1 IF(INEXT.EQ.56)INEXT=1 INEXTP=INEXTP+1 IF(INEXTP.EQ.56)INEXTP=1 MJ=MA(INEXT)-MA(INEXTP) IF(MJ.LT.MZ)MJ=MJ+MBIG MA(INEXT)=MJ RAN3=MJ*FAC RETURN END * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | SUBROUTINE GSAini() * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | * This routine read and initialize the GSA parameters * The number of parameters to be optimized (NDIMENSION) is problem * dependent. IMPLICIT DOUBLE PRECISION (A-H,O-Z) PARAMETER (MaxDim=500) COMMON /Par1/ qV1,qV2,qA1,qT1,D,exp1,exp2,Coef,Tqt,To,ToScale COMMON /Par2/ qA,qV,qT COMMON /Par3/ NDimension,NStopMax,NRAN DATA One /1.00000D+00/ CHARACTER tempo*8 qA=1.5d0 qT=1.5d0 qV=1.5d0 NStopMax=1000 To=1.0E-00 CALL TIME(tempo) READ(tempo(7:8),"(I2)")NRAN NRAN = -NRAN D = 10.5d0 Pi = 3.14159265359D0 * Acceptance probability qA1= qA - One * Temperature qT1 = qT - One Tqt = To*(2.0D0**qT1-One) * Visiting probability qV1= qV - One qV2= 2.0D0**qV1 - One tmp= One/qV1 - 0.5D0 GamaDown = dgamma(tmp) exp1 = 2.0D0/(3.0D0 - qV) IF(D.EQ.0.0D0) THEN Coef1 = One exp2 = One/qv1 - 0.5D0 GamaUp = GamaDown ELSE Coef1 = (qV1/Pi)**(D*0.5D0) exp2 = One/qV1 + 0.5D0*D - 0.5D0 GamaUp = dgamma(exp2) ENDIF Coef = Coef1*GamaUp/GamaDown RETURN END * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | FUNCTION func(X) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | IMPLICIT DOUBLE PRECISION (A-H,O-Z) PARAMETER (MaxDim=500) * This subrotuine make link between GSA and your Objective function * X(nDimension) is a vector that contains the parameters set. * GSA Procedure + Your objective/coust function * ______________ __________________ * | | Set of Parameters X(i) | | * | | =================> | Routine with | * | GSA-routine | | your objective | * | | <================= | function | * |______________| Value of the function (f) |__________________| COMMON /Par3/ NDimension,NStopMax,NRAN DIMENSION X(MaxDim) * CALL here your routine with the objective function * X(i) is parameters set and f is the value of the objective function ! CALL funct(X,f) ! func = f func=(X(1)-2.0d0)*(X(1)-2.0d0)+(X(2)-13.8d0)*(X(2)-13.8d0) RETURN END