|
 |
Software Release
Disclaimer:
// EXEC FORTVCLG 00000010
//FORT.SYSIN DD * 00000020
C 00000030
PROGRAM MAM 00000040
C 00000050
C OBTAINING INITIAL PARAMETER ESTIMATES FOR NONLINEAR SYSTEMS 00000060
C USING MULTICRITERIA ASSOCIATIVE MEMORIES, COMPUTER SCIENCE 00000070
C IN ECONOMICS AND MANAGEMENT, VOL. 4 (1991), 237-259. 00000080
C R. KALABA AND L. TESFATSION 00000090
C 00000100
C LAST UPDATED: JUNE 13, 1992 00000110
C 00000120
IMPLICIT REAL*8(A-H,O-Z) 00000130
DIMENSION R(10,50),S(15,50),XMEM(10,15),RHAT(10) 00000140
C 00000150
C THIS PROGRAM IS SET UP FOR TWO-DIMENSIONAL PARAMETER VECTORS 00000160
C R = (KZERO,THETA) WITH NORMAL NOISE TESTING AND TIME TESTING 00000170
C 00000180
CALL TRAIN(N,M,IQ,R,S) 00000190
C THE INITIAL VALUE OF ALPHA IS ALPHAZ, THE STEPSIZE OF ALPHA IS 00000200
C SSALPHA, AND THE NUMBER OF ALPHA VALUES TESTED IS NALPHA 00000210
ALPHAZ = 0.10D+00 00000220
SSALPHA = 0.10D+00 00000230
NALPHA = 10 00000240
C THE INITIAL STANDARD DEVIATION FOR THE TEST AGAINST NOISE IS SIGMAZ, 00000250
C THE STEPSIZE FOR SIGMA IS SSSIGMA, AND THE NUMBER OF SIGMA VALUES 00000260
C TESTED IS NSIGMA. FOR EACH SIGMA, THE THEORETICALLY OPTIMAL VALUE OF00000270
C ALPHA IS AOPT = 1/(1 + (SIGMA**2)*IQ). 00000280
SIGMAZ = 0.00D+00 00000290
SSSIGMA = 0.05D+00 00000300
NSIGMA = 10 00000310
SIGMA = SIGMAZ 00000320
DO 45 LL = 1,NSIGMA 00000330
AOPT = 1.0D+00/(1.0D+00 + (SIGMA**2.0D+00)*DFLOAT(IQ)) 00000340
WRITE(6,700) SIGMA, AOPT 00000350
700 FORMAT(3X,//2X,'THE STANDARD DEVIATION SIGMA =',F5.2, 00000360
* ' AND THE OPTIMAL ALPHA VALUE =',D9.4) 00000370
C WRITE(6,500) 00000380
C 500 FORMAT(2X,'HERE IS S TRANSPOSE') 00000390
C DO 1000 J = 1,IQ 00000400
C WRITE(6,600) (S(I,J),I = 1,M) 00000410
C 600 FORMAT(4X,5D15.3) 00000420
C1000 CONTINUE 00000430
ALPHA = ALPHAZ 00000440
BETA = 1.0D+00 - ALPHA 00000450
DO 10 J = 1,NALPHA 00000460
CALL MEMORY(ALPHA,BETA,R,S,N,M,IQ,XMEM,CA,CZ) 00000470
WRITE (6,100) ALPHA,CA,CZ 00000480
100 FORMAT (2X,/2X,'ALPHA =',D9.4,2X,'CA =',D12.4,2X,'CZ =',D12.4)00000490
C TEST OF TRAINING CASE ENCODING 00000500
IF (J.GE.1) CALL OUTPUT(ALPHA,R,S,N,M,IQ,XMEM,SIGMA) 00000510
C WRITE(6,1) ALPHA 00000520
C 1 FORMAT(2X,/1X,'HERE IS THE TRANSPOSED MEMORY MATRIX FOR ', 00000530
C * 'ALPHA =',D9.4) 00000540
C DO 40 JJ = 1,M 00000550
C WRITE(6,120) (XMEM(II,JJ),II = 1,N) 00000560
C 120 FORMAT(10X,2D25.5) 00000570
C 40 CONTINUE 00000580
ALPHA = ALPHA + SSALPHA 00000590
BETA = 1.0D+00 - ALPHA 00000600
10 CONTINUE 00000610
SIGMA = SIGMA + SSSIGMA 00000620
45 CONTINUE 00000630
STOP 00000640
END 00000650
C 00000660
SUBROUTINE OUTPUT(ALPHA,R,S,N,M,IQ,XMEM,SIGMA) 00000670
IMPLICIT REAL*8(A-H,O-Z) 00000680
DIMENSION R(10,50),S(15,50),XMEM(10,15),RHAT(10),DISC(10,50) 00000690
DIMENSION SN(15,50) 00000700
C PRINT OUT OF RHAT, R, AND THE DISCREPANCIES 00000710
C DISC = (RHAT - R)/R FOR THE IQ TEST CASES 00000720
C WRITE(6,100) IQ 00000730
C 100 FORMAT(1X,//,2X,'HERE ARE RHAT, R = (K0,THETA), AND THE'/2X, 00000740
C * 'DISCREPANCIES (RHAT-R)/R FOR THE',I4,' TEST CASES') 00000750
DO 10 IC = 1,IQ 00000760
DO 20 II = 1,N 00000770
SUM = 0.0D+00 00000780
DO 30 JJ = 1,M 00000790
XNOISE = SIGMA*0.0D+00 00000800
SN(JJ,IC) = S(JJ,IC) + XNOISE 00000810
SUM = SUM + XMEM(II,JJ)*SN(JJ,IC) 00000820
30 CONTINUE 00000830
RHAT(II) = SUM 00000840
DISC(II,IC) = ((RHAT(II)-R(II,IC))/R(II,IC))*100.0D+00 00000850
20 CONTINUE 00000860
C WRITE(6,200) IC,(RHAT(II),II=1,N),(R(II,IC),II=1,N), 00000870
C * (DISC(II,IC),II=1,N) 00000880
C 200 FORMAT(1X,I4,2X,4D12.4,2E12.3) 00000890
10 CONTINUE 00000900
WRITE(6,300) ALPHA,SIGMA 00000910
300 FORMAT(2X,/2X,'HERE ARE THE PERCENTAGE DISCREPANCIES FOR ', 00000920
* 'KZERO'/2X,'WHEN ALPHA =',D9.4,' AND SIGMA =',F5.2) 00000930
WRITE(6,400) (DISC(1,IT), IT=1,IQ) 00000940
400 FORMAT(1X,7F11.0) 00000950
WRITE(6,500) ALPHA,SIGMA 00000960
500 FORMAT(2X,/2X,'HERE ARE THE PERCENTAGE DISCREPANCIES FOR ', 00000970
* 'THETA'/2X,'WHEN ALPHA =',D9.4,' AND SIGMA =',F5.2) 00000980
WRITE(6,600) (DISC(2,IT), IT=1,IQ) 00000990
600 FORMAT(1X,7F11.0) 00001000
RETURN 00001010
END 00001020
C 00001030
SUBROUTINE TRAIN(N,M,IQ,R,S) 00001040
IMPLICIT REAL*8(A-H,O-Z) 00001050
DIMENSION R(10,50),S(15,50) 00001060
C CALCULATING THE TRAINING STIMULUS AND RESPONSE MATRICES 00001070
C FOR THE SOLOW-SWAN DESCRIPTIVE GROWTH MODEL 00001080
C DK = SAV*F(K) - ALAM*K WITH F(K) = K**THETA 00001090
C WHERE N = NUMBER OF PARAMETERS, M = NUMBER OF OBSERVATIONS, 00001100
C AND IQ = NUMBER OF TEST CASES 00001110
SAV = 0.15D+00 00001120
ALAM = 0.10D+00 00001130
N = 2 00001140
M = 10 00001150
C NUMBER OF TESTED KZERO AND THETA VALUES 00001160
NKZERO = 7 00001170
NTHETA = 7 00001180
C INITIAL VALUES FOR KZERO, THETA, AND TIME 00001190
XKZERZ = 4.00D+00 00001200
THETAZ = 0.20D+00 00001210
TINIT = 0.05D+00 00001220
C STEP SIZES FOR KZERO, THETA, AND TIME 00001230
SSKZERO = 0.50D+00 00001240
SSTHETA = 0.03D+00 00001250
SSTIME = 1.0D+00 00001260
C THE DO LOOPS 00001270
XKZERO = XKZERZ 00001280
THETA = THETAZ 00001290
T = TINIT 00001300
IQ = NKZERO*NTHETA 00001310
ICASE = 1 00001320
DO 9 KK = 1,NKZERO 00001330
DO 10 JJ = 1,NTHETA 00001340
R(1,ICASE) = XKZERO 00001350
R(2,ICASE) = THETA 00001360
DO 11 II = 1,M 00001370
S(II,ICASE)=((XKZERO**(1.0D+00-THETA) - SAV/ALAM)* 00001380
& DEXP(-(1.0D+00-THETA)*ALAM*T) + SAV/ALAM)** 00001390
& (1.0D+00/(1.0D+00-THETA)) 00001400
T = T + SSTIME 00001410
11 CONTINUE 00001420
THETA = THETA + SSTHETA 00001430
ICASE = ICASE + 1 00001440
T = TINIT 00001450
10 CONTINUE 00001460
XKZERO = XKZERO + SSKZERO 00001470
THETA = THETAZ 00001480
9 CONTINUE 00001490
RETURN 00001500
END 00001510
C 00001520
SUBROUTINE MEMORY(ALPHA,BETA,R,S,N,M,IQ,XMEM,CA,CZ) 00001530
IMPLICIT REAL*8(A-H,O-Z) 00001540
DIMENSION R(10,50),S(15,50),XMEM(10,15),ST(50,15),SST(15,15) 00001550
DIMENSION ASST(15,15),E(15,15),F(15,15),AST(50,15),PINV(50,15)00001560
DIMENSION XMEMS(10,50),DIF(10,50),DIFT(50,10),SQDIF(10,10) 00001570
DIMENSION XMEMT(15,10),RST(10,15),ARST(10,15),E1(10,10) 00001580
C CALCULATING THE ASSOCIATIVE MEMORY MATRIX 00001590
C XMEM = ALPHA*R*ST*(ALPHA*S*ST + (1-ALPHA)*I)-1 00001600
CALL TRANS(M,IQ,S,ST) 00001610
DO 10 I = 1,M 00001620
DO 11 J = 1,M 00001630
SUM = 0.0D+00 00001640
DO 12 K = 1,IQ 00001650
SUM = SUM + S(I,K)*ST(K,J) 00001660
12 CONTINUE 00001670
SST(I,J) = SUM 00001680
11 CONTINUE 00001690
10 CONTINUE 00001700
CALL MULCON(M,M,ALPHA,SST,ASST) 00001710
CALL IDEN(M,E) 00001720
CALL MULCON(M,M,BETA,E,E) 00001730
CALL ADD(M,M,ASST,E,E) 00001740
CALL INV(M,E,F) 00001750
DO 13 I = 1,N 00001760
DO 14 J = 1,M 00001770
SUM = 0.0D+00 00001780
DO 15 K = 1,IQ 00001790
SUM = SUM + R(I,K)*ST(K,J) 00001800
15 CONTINUE 00001810
RST(I,J) = SUM 00001820
14 CONTINUE 00001830
13 CONTINUE 00001840
DO 1 I = 1,N 00001850
DO 2 J = 1,M 00001860
ARST(I,J) = ALPHA*RST(I,J) 00001870
2 CONTINUE 00001880
1 CONTINUE 00001890
DO 16 I = 1,N 00001900
DO 17 J = 1,M 00001910
SUM = 0.0D+00 00001920
DO 18 K = 1,M 00001930
SUM = SUM + ARST(I,K)*F(K,J) 00001940
18 CONTINUE 00001950
XMEM(I,J) = SUM 00001960
17 CONTINUE 00001970
16 CONTINUE 00001980
C CALCULATING THE COST CA = TR((XMEM*S-R)(XMEM*S-R)T) 00001990
DO 19 I = 1,N 00002000
DO 20 J = 1,IQ 00002010
SUM = 0.0D+00 00002020
DO 21 K = 1,M 00002030
SUM = SUM + XMEM(I,K)*S(K,J) 00002040
21 CONTINUE 00002050
XMEMS(I,J) = SUM 00002060
20 CONTINUE 00002070
19 CONTINUE 00002080
CALL SUB(N,IQ,XMEMS,R,DIF) 00002090
DO 3 I = 1,IQ 00002100
DO 4 J = 1,N 00002110
DIFT(I,J) = DIF(J,I) 00002120
4 CONTINUE 00002130
3 CONTINUE 00002140
DO 22 I = 1,N 00002150
DO 23 J = 1,N 00002160
SUM = 0.0D+00 00002170
DO 24 K = 1,IQ 00002180
SUM = SUM + DIF(I,K)*DIFT(K,J) 00002190
24 CONTINUE 00002200
SQDIF(I,J) = SUM 00002210
23 CONTINUE 00002220
22 CONTINUE 00002230
CALL TRACE(SQDIF,N,CA) 00002240
C CALCULATING THE COST CZ = TR(XMEM*XMEMT) 00002250
DO 5 I = 1,M 00002260
DO 6 J = 1,N 00002270
XMEMT(I,J) = XMEM(J,I) 00002280
6 CONTINUE 00002290
5 CONTINUE 00002300
DO 25 I = 1,N 00002310
DO 26 J = 1,N 00002320
SUM = 0.0D+00 00002330
DO 27 K = 1,M 00002340
SUM = SUM + XMEM(I,K)*XMEMT(K,J) 00002350
27 CONTINUE 00002360
E1(I,J) = SUM 00002370
26 CONTINUE 00002380
25 CONTINUE 00002390
CALL TRACE(E1,N,CZ) 00002400
RETURN 00002410
END 00002420
C 00002430
C HERE ARE THE MATRIX SUBROUTINES 00002440
C 00002450
C MATRIX SUBROUTINES FOR ADDITION, MULTIPLICATION, TRANSPOSITION, 00002460
C SUBTRACTION, INVERSION, MULTIPLICATION BY A SCALAR, SHIFT, FORM 00002470
C AN IDENTITY MATRIX, AND TAKE THE TRACE. 00002480
C 00002490
C CALCULATING THE SUM C=A+B OF TWO NROW X MCOL MATRICES A AND B 00002500
C 00002510
SUBROUTINE ADD(NROW,MCOL,A,B,C) 00002520
IMPLICIT REAL*8(A-H,O-Z) 00002530
DIMENSION A(15,15),B(15,15),C(15,15) 00002540
DO 10 I=1,NROW 00002550
DO 20 J=1,MCOL 00002560
C(I,J)=A(I,J)+B(I,J) 00002570
20 CONTINUE 00002580
10 CONTINUE 00002590
RETURN 00002600
END 00002610
C 00002620
C CALCULATING THE PRODUCT C=A*B OF AN NROW X L MATRIX A AND AN 00002630
C L X MCOL MATRIX B 00002640
C 00002650
SUBROUTINE MUL(NROW,L,MCOL,A,B,C) 00002660
IMPLICIT REAL*8(A-H,O-Z) 00002670
DIMENSION A(15,50),B(50,15),C(15,15) 00002680
DO 10 I=1,NROW 00002690
DO 20 J=1,MCOL 00002700
SUM=0.0D+00 00002710
DO 30 K=1,L 00002720
SUM=SUM+A(I,K)*B(K,J) 00002730
30 CONTINUE 00002740
C(I,J)=SUM 00002750
20 CONTINUE 00002760
10 CONTINUE 00002770
RETURN 00002780
END 00002790
C 00002800
C CALCULATING THE TRANSPOSE B OF AN NROW X MCOL MATRIX A 00002810
C 00002820
SUBROUTINE TRANS(NROW,MCOL,A,B) 00002830
IMPLICIT REAL*8(A-H,O-Z) 00002840
DIMENSION A(15,50),B(50,15) 00002850
DO 10 I=1,NROW 00002860
DO 20 J=1,MCOL 00002870
B(J,I)=A(I,J) 00002880
20 CONTINUE 00002890
10 CONTINUE 00002900
RETURN 00002910
END 00002920
C 00002930
C CALCULATING THE DIFFERENCE C=A-B BETWEEN NROW X MCOL MATRICES 00002940
C A AND B 00002950
C 00002960
SUBROUTINE SUB(NROW,MCOL,A,B,C) 00002970
IMPLICIT REAL*8(A-H,O-Z) 00002980
DIMENSION A(10,50),B(10,50),C(10,50) 00002990
DO 10 I=1,NROW 00003000
DO 20 J=1,MCOL 00003010
C(I,J)=A(I,J)-B(I,J) 00003020
20 CONTINUE 00003030
10 CONTINUE 00003040
RETURN 00003050
END 00003060
C 00003070
C CALCULATING THE INVERSE C OF A K X K MATRIX A 00003080
C 00003090
SUBROUTINE INV(K,A,C) 00003100
IMPLICIT REAL*8(A-H,O-Z) 00003110
DIMENSION A(15,15),B(15,30),C(15,15) 00003120
DO 5 J=1,K 00003130
DO 6 I=1,K 00003140
B(I,J)=A(I,J) 00003150
6 CONTINUE 00003160
5 CONTINUE 00003170
K2=K*2 00003180
DO 7 J=1,K 00003190
DO 8 I=1,K 00003200
B(I,K+J)=0.0D+00 00003210
IF(I.EQ.J) B(I,K+J)=1.0D+00 00003220
8 CONTINUE 00003230
7 CONTINUE 00003240
C THE PIVOT OPERATION STARTS HERE 00003250
DO 9 L=1,K 00003260
PIVOT = B(L,L) 00003270
DO 13 J=L,K2 00003280
B(L,J)=B(L,J)/PIVOT 00003290
13 CONTINUE 00003300
C TO IMPROVE THE ROWS 00003310
DO 14 I=1,K 00003320
IF(I.EQ.L) GO TO 14 00003330
AIL=B(I,L) 00003340
DO 15 J=L,K2 00003350
B(I,J)=B(I,J)-AIL*B(L,J) 00003360
15 CONTINUE 00003370
14 CONTINUE 00003380
9 CONTINUE 00003390
DO 45 I=1,K 00003400
DO 46 J=1,K 00003410
C(I,J)=B(I,K+J) 00003420
46 CONTINUE 00003430
45 CONTINUE 00003440
RETURN 00003450
END 00003460
C 00003470
C CALCULATING THE PRODUCT C*A OF A SCALAR C AND AN NROW X MCOL 00003480
C MATRIX A 00003490
C 00003500
SUBROUTINE MULCON(NROW,MCOL,C,A,CA) 00003510
IMPLICIT REAL*8(A-H,O-Z) 00003520
DIMENSION A(15,15),CA(15,15) 00003530
DO 10 I=1,NROW 00003540
DO 20 J=1,MCOL 00003550
CA(I,J)=C*A(I,J) 00003560
20 CONTINUE 00003570
10 CONTINUE 00003580
RETURN 00003590
END 00003600
C 00003610
C PUTTING AN NROW X MCOL MATRIX A INTO AN NROW X MCOL MATRIX B 00003620
C 00003630
SUBROUTINE SHIFT(NROW,MCOL,A,B) 00003640
IMPLICIT REAL*8(A-H,O-Z) 00003650
DIMENSION A(15,15),B(15,15) 00003660
DO 10 I=1,NROW 00003670
DO 20 J=1,MCOL 00003680
B(I,J)=A(I,J) 00003690
20 CONTINUE 00003700
10 CONTINUE 00003710
RETURN 00003720
END 00003730
C 00003740
C FORMING AN IDENTITY MATRIX 00003750
C 00003760
SUBROUTINE IDEN(N,E) 00003770
IMPLICIT REAL*8(A-H,O-Z) 00003780
DIMENSION E(15,15) 00003790
ZERO=0.0D+00 00003800
ONE=1.0D+00 00003810
DO 10 I=1,N 00003820
DO 20 J=1,N 00003830
E(I,J)=ZERO 00003840
20 CONTINUE 00003850
10 CONTINUE 00003860
DO 30 L=1,N 00003870
E(L,L)=ONE 00003880
30 CONTINUE 00003890
RETURN 00003900
END 00003910
C 00003920
C CALCULATING THE TRACE OF A MATRIX 00003930
C 00003940
SUBROUTINE TRACE(A,N,TR) 00003950
IMPLICIT REAL*8 (A-H,O-Z) 00003960
DIMENSION A(10,10) 00003970
SUM = 0.0D+00 00003980
DO 10 I = 1,N 00003990
SUM = SUM + A(I,I) 00004000
10 CONTINUE 00004010
TR = SUM 00004020
RETURN 00004030
END 00004040