$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 1 1 JOINT BOX-COX TRANSFORMATIONS OF MULTIVARIATE DATA TO "NEAR" NORMALITY USING MTRANS HAMPARSUM BOZDOGAN AND DONALD E. RAMIREZ DEPARTMENT OF MATHEMATICS MATH-ASTRO BUILDING UNIVERSITY OF VIRGINIA CHARLOTTESVILLE, VIRGINIA 22903 TECHNICAL REPORT 15 (NOVEMBER 29, 1986) 1 INTRODUCTION THIS TECHNICAL REPORT PRESENTS THE PROGRAM MTRANS WHICH IS DISCUSSED IN OUR PAPER: TESTING OF MODEL FIT: ASSESSING AND BOX-COX TRANSFORMATIONS OF MUTIVARIATE DATA TO "NEAR" NORMALITY, COMPUTATIONAL STATISTICS QUARTERLY,1987 MTRANS IS A FORTRAN 77 PROGRAM WHICH TRANSFORMS MULTIVARIATE DATA TO "NEARLY" NORMAL DATA BY A JOINT BOX-COX TRANSFORMATION. THE BOX-COX VALUES CAN BE COMPUTED BY USING EITHER A GRID SEARCH OR BY USING A QUASI-NEWTON METHOD. THE PROGRAM MTRANS REQUIRES THAT THE IMSL LIBRARY BE AVAILABLE. INDEX APPENDIX A CONTAINS THE RAW DATA SET WITH N=50 AND P=4 APPENDIX B CONTAINS THE TERMINAL OUTPUT FROM MTRANS APPENDIX C CONTAINS THE TRANSFORMED DATA APPENDIX D CONTAINS THE FORTRAN PROGRAM MTRANS APPENDIX E CONTAINS THE CALL STATEMENTS FROM MTRANS $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ APPENDIX A: THE ORIGINAL DATA 9.9689641 9.6915752 8.3610642 9.2067892 9.4359220 9.9914326 8.8740372 8.3535806 8.7552509 9.9914326 9.0784452 6.8721149 9.7818922 9.4759142 8.4040289 11.151012 10.834453 10.246976 8.8831509 11.535036 10.638366 10.332650 8.7685783 9.5972406 10.345362 10.338558 8.8740372 9.0525368 10.300284 11.300170 8.5954173 8.9384543 10.445659 9.4109205 9.7854106 9.3738959 10.985463 10.508428 9.8505087 11.290803 10.658651 9.6413528 9.2724376 8.5608573 9.4460645 8.6974666 8.2777386 10.961410 9.6568020 10.084492 8.0251579 9.1248426 10.480594 10.610350 8.7243116 9.5474299 9.5835510 8.3872693 8.3076837 10.974265 11.581614 10.583762 8.6214566 11.261881 9.5283310 10.709318 8.6696292 9.9475220 10.502006 8.8200684 8.8740372 10.056784 8.4205501 7.6649526 9.8192616 9.9073522 10.336346 8.3680666 9.8765480 9.4478086 7.6632471 8.0534378 10.626478 9.8559347 7.9663937 11.257333 9.6552144 9.3738959 9.6263747 8.3902235 9.4547123 8.8565077 8.0295023 9.2720702 8.6566095 9.4092455 9.2556118 8.6974666 8.8883588 10.390998 8.3687109 8.9781213 11.819075 8.4789107 9.7976694 9.3739922 9.0367824 7.6465905 8.5659252 7.8555024 9.1891120 9.1296630 7.6655010 9.3370640 9.4377868 7.7671001 10.144767 8.1538827 9.9143049 9.5201144 9.4483183 8.9160819 10.586117 10.390998 9.0426203 8.9205133 8.9326255 8.9802310 10.352123 8.4256746 9.6330811 9.0798523 11.581614 8.2572818 10.907702 9.1135950 8.9051338 8.6974666 10.914212 9.2132164 8.1782582 9.0667491 10.067936 10.257634 8.9524652 11.035764 10.501490 9.0525368 11.002367 11.241085 9.7059909 11.641085 11.910680 11.527648 10.664235 10.190148 12.008723 12.657653 12.355484 9.9250269 12.127052 13.052046 11.678463 11.091561 13.983120 13.286910 12.759092 13.742774 9.3344975 12.566071 13.617085 11.922274 10.924608 13.066818 10.175999 11.061032 9.6568020 9.8791708 12.910120 9.5345755 9.1868685 10.174597 10.609553 12.399492 9.2815314 10.174597 12.128942 13.069526 10.533560 10.994404 11.550871 9.8559347 9.1260138 10.319356 11.132941 9.0991339 15.693814 13.515865 14.546686 14.788798 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ APPENDIX B: TERMINAL OUTPUT FROM MTRANS OK, seg mtrans BOX-COX TRANSFORMATION TO MULTIVARIATE NORMALITY USING AKAIKE INFORMATION CRITERION (AIC) VERSION MAY 20 1985 : REVISED OCT 1 1986 ENTER THE NUMBER OF VARIABLES 4 ENTER THE NUMBER OF CASES 50 WHAT FILE IS YOUR DATA IN? atmos4.std ENTER THE FORTRAN FORMAT OR HIT RETURN FOR FREEFIELD READING DATA... DATA READ WHAT FILE DO YOU WANT THE TRANSFORMED DATA IN? atmos4.mtrans THE ORIGINAL DATA HAS AN AIC OF 698.4949187413 SELECT ALGORITHM 1 - GRID SEARCH 2 - QUASI-NEWTON BY FLETCHER 2 INPUT LAMBDA VECTOR -.5 -.5 -1 -.5 ENTER MAXIMUM NUMBER OF FUNCTION EVALUATIONS <=500 SUGGESTED VALUE IS 100 200 ENTER NUMBER OF SIG DIGITS DESIRED <=10 SUGGESTED VALUE IS 3 3 AIC VALUE LAMBDA 686.20 -0.500 -0.500 -1.00 -0.500 686.20 -0.500 -0.500 -1.00 -0.500 686.20 -0.500 -0.500 -1.00 -0.500 686.20 -0.500 -0.500 -1.00 -0.500 686.20 -0.500 -0.500 -1.00 -0.500 689.56 -0.866 1.01 -2.63 1.17 685.07 -0.683 0.253 -1.82 0.337 685.07 -0.683 0.253 -1.82 0.337 685.07 -0.683 0.253 -1.82 0.337 685.07 -0.683 0.253 -1.82 0.337 685.07 -0.683 0.253 -1.82 0.337 685.07 -0.321 0.497 -2.15 -0.338 687.74 0.408E-01 0.740 -2.49 -1.01 685.07 -0.321 0.497 -2.15 -0.338 685.07 -0.321 0.497 -2.15 -0.338 685.07 -0.321 0.497 -2.15 -0.338 685.07 -0.321 0.497 -2.15 -0.338 685.06 -0.324 0.493 -2.15 -0.335 685.05 -0.327 0.488 -2.14 -0.333 685.03 -0.333 0.480 -2.14 -0.327 684.99 -0.345 0.463 -2.12 -0.317 684.93 -0.368 0.430 -2.09 -0.295 684.81 -0.415 0.362 -2.03 -0.253 684.69 -0.509 0.228 -1.92 -0.168 684.69 -0.509 0.228 -1.92 -0.168 684.69 -0.509 0.228 -1.92 -0.168 684.69 -0.509 0.228 -1.92 -0.168 684.69 -0.509 0.228 -1.92 -0.168 684.68 -0.443 0.190 -1.78 -0.287E-01 684.80 -0.376 0.152 -1.64 0.111 684.68 -0.443 0.190 -1.78 -0.287E-01 684.68 -0.443 0.190 -1.78 -0.287E-01 684.68 -0.443 0.190 -1.78 -0.287E-01 684.68 -0.443 0.190 -1.78 -0.287E-01 684.67 -0.474 0.196 -1.78 -0.439E-01 684.66 -0.506 0.202 -1.79 -0.592E-01 684.66 -0.506 0.202 -1.79 -0.592E-01 684.66 -0.506 0.202 -1.79 -0.592E-01 684.66 -0.506 0.202 -1.79 -0.592E-01 684.66 -0.506 0.202 -1.79 -0.592E-01 684.66 -0.524 0.178 -1.84 -0.851E-01 684.67 -0.543 0.153 -1.89 -0.111 684.66 -0.524 0.178 -1.84 -0.851E-01 684.66 -0.524 0.178 -1.84 -0.851E-01 684.66 -0.524 0.178 -1.84 -0.851E-01 684.66 -0.524 0.178 -1.84 -0.851E-01 684.66 -0.525 0.193 -1.82 -0.827E-01 684.66 -0.526 0.209 -1.80 -0.804E-01 684.66 -0.525 0.193 -1.82 -0.827E-01 684.66 -0.525 0.193 -1.82 -0.827E-01 684.66 -0.525 0.193 -1.82 -0.827E-01 684.66 -0.525 0.193 -1.82 -0.827E-01 684.66 -0.525 0.191 -1.82 -0.816E-01 684.66 -0.524 0.190 -1.82 -0.806E-01 684.66 -0.525 0.191 -1.82 -0.816E-01 684.66 -0.525 0.191 -1.82 -0.816E-01 684.66 -0.525 0.191 -1.82 -0.816E-01 684.66 -0.525 0.191 -1.82 -0.816E-01 684.66 -0.525 0.192 -1.82 -0.823E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.192 -1.82 -0.819E-01 684.66 -0.525 0.192 -1.82 -0.819E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.820E-01 684.66 -0.525 0.191 -1.82 -0.819E-01 **** CONVERGENCE ACHIEVED **** NORM OF GRAD = 1.2225442623560E-0003 NUMBER OF FUNCTION EVALS = 76.00000000000 ESTIMATED NO. OF SIG. DIGITS = 3.100251228418 AIC VALUE AT CONVERGENCE = 684.6616717371 THE MINIMUM AIC IS 684.6616717371 IT OCCURS AT A LAMBDA OF: -0.5246654522615 0.1914825184756 -1.820049992278 -8.1954901366503E-0002 THE DIFFERENCE BETWEEN THE ORIGINAL AND TRANSFORMED AIC`S IS 13.8332470042 **** STOP $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ APPENDIX C: TRANSFORMED DATA FROM MTRANS 1.335493179416 2.844968585534 0.5379398887613 2.029794542889 1.318812197910 2.892169216656 0.5391230165433 1.948389847985 1.295297067630 2.892169216656 0.5395426803951 1.783010119402 1.329797033745 2.810285828273 0.5380468496155 2.188280970241 1.359866260946 2.931498690882 0.5391423092543 2.216031916511 1.354610129149 2.944506858295 0.5388956445377 2.064364167202 1.346474719891 2.945400670834 0.5391230165433 2.015697991858 1.345191877327 3.085666362465 0.5385051195499 2.005104205057 1.349298659327 2.799708376290 0.5408078551615 2.044780300419 1.363816240630 2.970925103376 0.5409116336352 2.198500812319 1.355160700079 2.836947950596 0.5399170436505 1.968967378763 1.319142935559 2.679531847800 0.5377279714449 2.174195827745 1.325894632837 2.906584722077 0.5370473069321 2.022337845509 1.350272592809 2.986080035093 0.5387978879825 2.060039572020 1.323573467986 2.624780247711 0.5378048193676 2.175159100533 1.378635663761 2.982138013823 0.5385652608914 2.196397655481 1.321805707145 3.000683501825 0.5386751818611 2.094106351137 1.350867082933 2.700736965899 0.5391230165433 2.103152371164 1.282684158577 2.490640510846 0.5408620620732 2.090753556399 1.346218822593 2.621337357495 0.5409526058978 2.051316683633 1.251102163903 2.563996336975 0.5420135032881 2.086440440411 1.264293121546 3.079627446164 0.5405943515587 2.044780300419 1.324933728219 2.625309346248 0.5402492166784 1.997403901987 1.266943288870 2.776911676411 0.5386456433542 2.047913331423 1.312840499587 2.679531847800 0.5391533087728 2.130176329385 1.280662133876 2.727724787595 0.5433240341990 1.960897179426 1.330283828324 2.793672108681 0.5394593117207 1.873803383961 1.288254770025 2.526987643079 0.5397589726445 2.022778477933 1.251203164949 2.787616598595 0.5402191323464 1.887031749652 1.340699597875 2.582496282928 0.5410114772810 2.057657647798 1.319216356394 2.717177602900 0.5419617537906 2.130176329385 1.305553747543 2.717932940359 0.5392460746384 2.009000509402 1.346666391483 2.631646932788 0.5405572447855 2.018213100324 1.378635663761 2.601348838416 0.5423592034392 2.021308723043 1.300709606194 2.679531847800 0.5423669096261 2.030376343847 1.273066298964 2.742690443886 0.5412446317452 2.119507092422 1.302390059348 3.048091956621 0.5418514220794 2.015697991858 1.364253248343 3.077332034532 0.5406785789765 2.223519479065 1.386327164225 3.117428248982 0.5420614147601 2.114050817746 1.388556438985 3.268082904597 0.5438001872300 2.092230593700 1.391210293068 3.318104814401 0.5431889189018 2.183892540158 1.428254173643 3.347315344719 0.5441217815885 2.358343118514 1.315474755253 3.256287327372 0.5447180346580 2.243020891553 1.362234468816 3.319954511735 0.5414027138890 2.181629113599 1.325894632837 2.874633935418 0.5442348860020 2.058919582098 1.310516861410 2.920440436432 0.5419918702134 2.275005366638 1.313709805917 2.920440436432 0.5436063292401 2.317733364841 1.351739798484 3.042148659724 0.5430622819558 2.086440440411 1.308437637769 2.942494116664 0.5426184834467 2.019983553772 1.456309825298 3.375391798381 0.5452550146774 2.417351094783 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ APPENDIX D: THE FORTRAN PROGRAM MTRANS PROGRAM MTRANS 0000001 C BOX COX TRANSFORMATION TO NEAR NORMALITY USING AIC 0000002 C MULTIVARIATE VERSION WITH UNIVARIATE OPTIONAL 0000003 C WRITTEN AND DEVELOPED BY H. BOZDOGAN AND L.G. BOBBITT 0000004 C REVISED BY DONALD E. RAMIREZ 0000005 C DEPARTMENT OF MATHEMATICS 0000006 C MATH-ASTRO BUILDING 0000007 C UNIVERSITY OF VIRGINIA 0000008 C CHARLOTTESVILLE, VIRGINIA 22903 0000009 CHARACTER*72 VERSON 0000010 PARAMETER(VERSON='VERSION MAY 20 1985 : REVISED NOV 29,1986') 0000011 INTEGER MOBS,MVARS,PSYM 0000012 PARAMETER(MOBS=100,MVARS=20) 0000013 PARAMETER(PSYM=((MVARS+1)*MVARS)/2) 0000014 C *** IF THE ABOVE PARA STATEMENT IS CHANGED IT MUST ALSO BE CHANGED 0000015 C *** IN FUNCT BELOW 0000016 C NOTE THAT THE PROGRAM IS LIMITED TO MVARS VARIABLES AND 0000017 C MOBS OBSERVATIONS. 0000018 DOUBLE PRECISION LAMBDA,MEAN,WORK,SIG,SMALL,H,B,A,XT,X,ALT, 0000019 + DET,AIC,AICMIN,AICNO, 0000020 + W,GRAD,HESS,F 0000021 INTEGER NVAR,N,K,I,J,JJ,NCHNG,ITER,ILIN,II, 0000022 + IPRNT,IMTHD,IER,IOPT,NSIG 0000023 EXTERNAL RIPGDF,QUERY,UNIV,TRANS,COVAR,CRITER,MINIMA,ENUMER, 0000024 + AICORG,FUNCT,ZXMIN,FINDO 0000025 INTRINSIC NINT,MOD 0000026 LOGICAL FIN,NOERR,LSEE 0000027 CHARACTER NAME1*32,TITLE*60 0000028 COMMON /QUASI/ X(MOBS,MVARS),N,XT(MOBS,MVARS),DET, 0000029 + SIG(PSYM),MEAN(MVARS),WORK(PSYM),IPRNT,AIC 0000030 COMMON LAMBDA(MVARS),HESS(PSYM),GRAD(MVARS),W(3*MVARS), 0000031 + A(MVARS),B(MVARS),H(MVARS),SMALL(MVARS) 0000032 C IPRNT IS PRIMARILY A DEBUGGING AID 0000033 C ITS VALUES MEAN THE FOLLOWING TO THE PROGRAM: 0000034 C 10 PRINT SUMMARY FOR EACH LAMBDA LOOKED AT 0000035 C 20 PRINT ABOVE + COVARIANCE FOR EACH LAMBDA LOOKED AT 0000036 PRINT*,'BOX-COX TRANSFORMATION TO MULTIVARIATE NORMALITY' 0000037 PRINT*,'USING AKAIKE INFORMATION CRITERION (AIC)' 0000038 PRINT* 0000039 PRINT*,VERSON 0000040 CALL RIPGDF(NVAR,MVARS,N,MOBS,X,MOBS,MVARS) 0000041 PRINT* 0000042 PRINT*,'WHAT FILE DO YOU WANT THE TRANSFORMED DATA IN?' 0000043 READ 1,NAME1 0000044 1 FORMAT(A) 0000045 OPEN(UNIT=6,FILE=NAME1,STATUS='UNKNOWN') 0000046 C DETERMINE AIC FOR THE ORIGINAL DATA 0000047 NCHNG=1 0000048 CALL COVAR(X,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG,WORK, 0000049 + IPRNT,IER) 0000050 IF(IER.EQ.0) THEN 0000051 NOERR=.TRUE. 0000052 CALL AICORG(N,NVAR,AICNO,DET,MOBS,MVARS) 0000053 PRINT* 0000054 PRINT*,'THE ORIGINAL DATA HAS AN AIC OF',AICNO 0000055 PRINT* 0000056 ELSE 0000057 NOERR=.FALSE. 0000058 PRINT*,'ERROR IN CALCUATING ORIGINAL AIC' 0000059 ENDIF 0000060 PRINT* 0000061 5 PRINT*,'SELECT ALGORITHM' 0000062 PRINT*,'1 - GRID SEARCH' 0000063 PRINT*,'2 - QUASI-NEWTON BY FLETCHER' 0000064 READ*,IMTHD 0000065 IF(IMTHD.NE.1.AND.IMTHD.NE.2) GOTO 5 0000066 IF(IMTHD.EQ.1) THEN 0000067 PRINT* 0000068 DO 10 K=1,NVAR 0000069 PRINT*,'FOR VARIABLE',K 0000070 PRINT*,'ENTER RANGE OF LAMBDA (START,STOP,STEPSIZE)' 0000071 READ*,A(K),B(K),H(K) 0000072 10 CONTINUE 0000073 PRINT* 0000074 TITLE='DO YOU WANT TO START WITH UNIVARIATE ESTIMATES?' 0000075 CALL QUERY(TITLE,LSEE) 0000076 ELSE 0000077 LSEE=.FALSE. 0000078 PRINT*,'INPUT LAMBDA VECTOR' 0000079 READ*,(LAMBDA(I),I=1,NVAR) 0000080 ENDIF 0000081 IF(LSEE) THEN 0000082 PRINT* 0000083 PRINT*,'FILE TO HOLD DATA TRANSFORMED BY UNIV. ESTIMATES:' 0000084 PRINT*,' (RETURN IF THIS DATA IS NOT DESIRED)' 0000085 READ 1,NAME1 0000086 LSEE=NAME1.NE.' ' 0000087 IF(LSEE) THEN 0000088 OPEN(UNIT=8,FILE=NAME1,STATUS='UNKNOWN') 0000089 ENDIF 0000090 PRINT* 0000091 PRINT*,'**** UNIVARIATE RESULTS ****' 0000092 DO 25,I=1,NVAR 0000093 PRINT* 0000094 PRINT26,I 0000095 26 FORMAT(/1X,70('=')//1X,T10,'VARIABLE ',I3) 0000096 CALL UNIV(X(1,I),XT(1,I),N,A(I),B(I),H(I), 0000097 + LSEE,LAMBDA(I)) 0000098 IF(IMTHD.EQ.1) THEN 0000099 H(I)=H(I)/2. 0000100 A(I)=LAMBDA(I)-H(I) 0000101 B(I)=LAMBDA(I)+H(I) 0000102 ENDIF 0000103 25 CONTINUE 0000104 PRINT* 0000105 PRINT*,'UNIVARIATE ESTIMATE FOR LAMBDA VECTOR IS' 0000106 DO 28,I=1,NVAR 0000107 28 PRINT*,LAMBDA(I) 0000108 PRINT* 0000109 IF(IMTHD.EQ.1) THEN 0000110 PRINT*,'USING THE UNIVARIATE RESULTS, LAMBDA BEGIN,END,STEP'0000111 PRINT*,' VALUES ARE:' 0000112 DO 20,I=1,NVAR 0000113 PRINT 30,I,A(I),B(I),H(I) 0000114 30 FORMAT(1X,'FOR VARIABLE ',I3,' :',3(1X,G14.5)) 0000115 20 CONTINUE 0000116 ENDIF 0000117 IF(LSEE) THEN 0000118 DO 35,I=1,N 0000119 35 WRITE(8,*) (XT(I,J),J=1,NVAR) 0000120 ENDFILE(8) 0000121 CLOSE(8) 0000122 ENDIF 0000123 ENDIF 0000124 IF(IMTHD.EQ.1) THEN 0000125 ALT=1.0 0000126 IPRNT=0. 0000127 DO 40,I=1,NVAR 0000128 40 ALT=ALT*(NINT( (B(I)-A(I))/H(I) ) + 1) 0000129 PRINT*,'THE NUMBER OF ALTERNATIVES IS ',ALT 0000130 IF(ALT.LE.1000) THEN 0000131 TITLE='DO YOU WANT TO SEE THE ALTERNATIVES?' 0000132 CALL QUERY(TITLE,LSEE) 0000133 IF(LSEE) IPRNT=10 0000134 ENDIF 0000135 PRINT* 0000136 PRINT*,'WORKING' 0000137 C INITIALIZE THE LAMBDA VECTOR TO ITS STARTING VALUE 0000138 DO 100 JJ=1,NVAR-1 0000139 100 LAMBDA(JJ)=A(JJ) 0000140 LAMBDA(NVAR)=A(NVAR)-H(NVAR) 0000141 NCHNG=1 0000142 ITER=1 0000143 ILIN=0 0000144 C MAIN PROGRAM LOOP- IS REPEATED FOR ALL POSSIBLE LAMBDA VECTORS 0000145 999 CALL TRANS(X,N,NVAR,LAMBDA,XT,MOBS,MVARS,NCHNG) 0000146 CALL COVAR(XT,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG,WORK, 0000147 + IPRNT,IER) 0000148 IF(IER.NE.0) GOTO 600 0000149 CALL CRITER(XT,N,NVAR,LAMBDA,X,AIC,DET,MOBS,MVARS) 0000150 CALL MINIMA(NVAR,AIC,LAMBDA,AICMIN,SMALL,MVARS) 0000151 IF(IPRNT.EQ.0.AND.MOD(ITER,10).EQ.0) THEN 0000152 ILIN=ILIN+1 0000153 IF(ILIN.EQ.70) THEN 0000154 PRINT* 0000155 ILIN=0 0000156 ENDIF 0000157 ELSE IF (IPRNT.EQ.10) THEN 0000158 PRINT 710,ITER,(LAMBDA(II),II=1,NVAR),AIC 0000159 710 FORMAT(I4,1X,(5G13.6)) 0000160 ENDIF 0000161 ITER=ITER+1 0000162 CALL ENUMER(LAMBDA,H,A,B,NVAR,FIN,MVARS,NCHNG) 0000163 IF(.NOT.FIN) GOTO 999 0000164 ELSE 0000165 IOPT=0 0000166 500 CONTINUE 0000167 PRINT*,'ENTER MAXIMUM NUMBER OF FUNCTION EVALUATIONS <=500' 0000168 PRINT*,'SUGGESTED VALUE IS 100' 0000169 READ*,ITER 0000170 IF(ITER.GT.500) GOTO 500 0000171 PRINT*,'ENTER NUMBER OF SIG DIGITS DESIRED <=10' 0000172 PRINT*,'SUGGESTED VALUE IS 3' 0000173 READ*,NSIG 0000174 IF(NSIG.GT.10) GOTO 500 0000175 PRINT 530,'AIC VALUE','LAMBDA' 0000176 530 FORMAT(/1X,A20,T30,A45) 0000177 CALL ZXMIN(FUNCT,NVAR,NSIG,ITER,IOPT, 0000178 + LAMBDA,HESS,GRAD,F,W,IER) 0000179 PRINT* 0000180 IF(IER.EQ.129) THEN 0000181 PRINT*,'UNABLE TO MAKE HESSIAN POSITIVE DEFINITE' 0000182 ELSE IF(IER.EQ.130) THEN 0000183 PRINT*,'ITERATION TERMINATED DUE TO ROUNDING ERRORS' 0000184 ELSE IF(IER.EQ.131) THEN 0000185 PRINT*,ITER,' EVALUATIONS USED.' 0000186 PRINT*,'NORM OF GRAD = ',W(1) 0000187 PRINT*,'ESTIMATED NO. OF SIG. DIGITS = ',W(3) 0000188 TITLE='DO YOU WISH TO CONTINUE?' 0000189 CALL QUERY(TITLE,LSEE) 0000190 IF(LSEE)THEN 0000191 IOPT=1 0000192 GOTO 500 0000193 ENDIF 0000194 ELSE 0000195 PRINT*,'**** CONVERGENCE ACHIEVED ****' 0000196 PRINT*,'NORM OF GRAD = ',W(1) 0000197 PRINT*,'NUMBER OF FUNCTION EVALS = ',W(2) 0000198 PRINT*,'ESTIMATED NO. OF SIG. DIGITS = ',W(3) 0000199 PRINT*,'AIC VALUE AT CONVERGENCE = ',F 0000200 ENDIF 0000201 DO 510,I=1,NVAR 0000202 510 SMALL(I)=LAMBDA(I) 0000203 AICMIN=F 0000204 ENDIF 0000205 PRINT* 0000206 PRINT*,'THE MINIMUM AIC IS',AICMIN 0000207 GOTO 610 0000208 600 PRINT*,'ERROR IN CALCULATING AIC' 0000209 DO 620,I=1,NVAR 0000210 620 SMALL(I)=LAMBDA(I) 0000211 610 CONTINUE 0000212 PRINT*,'IT OCCURS AT A LAMBDA OF:' 0000213 DO 65 J=1,NVAR 0000214 65 PRINT*,SMALL(J) 0000215 IF(NOERR) THEN 0000216 PRINT*,'THE DIFFERENCE BETWEEN THE ORIGINAL AND TRANSFORMED' 0000217 PRINT*,'AIC`S IS',AICNO-AICMIN 0000218 ENDIF 0000219 CALL FINDO(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 0000220 END 0000221 C***********************************************************************0000222 SUBROUTINE FINDO(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 0000223 INTEGER N,NVAR,MOBS,MVARS,NCHNG,I,J 0000224 DOUBLE PRECISION X,SMALL,XT 0000225 EXTERNAL TRANS 0000226 DIMENSION X(MOBS,MVARS),SMALL(MVARS),XT(MOBS,MVARS) 0000227 NCHNG=1 0000228 CALL TRANS(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 0000229 DO 75 I=1,N 0000230 75 WRITE(6,*)(XT(I,J),J=1,NVAR) 0000231 ENDFILE(6) 0000232 CLOSE(6) 0000233 END 0000234 C***********************************************************************0000235 SUBROUTINE TRANS(X,N,NVAR,LAMBDA,XT,MOBS,MVARS,NCHNG) 0000236 C THIS ROUTINE TRANSFORMS THE DATA USING THE GIVEN LAMBDA VECTOR 0000237 DOUBLE PRECISION XT,X,LAMBDA,TINY 0000238 INTEGER MOBS,MVARS,J,NCHNG,NVAR,I,N 0000239 PARAMETER(TINY=1.0D-4) 0000240 INTRINSIC LOG,ABS 0000241 DIMENSION X(MOBS,MVARS),XT(MOBS,MVARS),LAMBDA(MVARS) 0000242 DO 10 J=NCHNG,NVAR 0000243 IF (ABS(LAMBDA(J)).LT.TINY)THEN 0000244 DO 20 I=1,N 0000245 XT(I,J)=LOG(X(I,J)) 0000246 20 CONTINUE 0000247 ELSE 0000248 DO 30 I=1,N 0000249 XT(I,J)=(X(I,J)**LAMBDA(J)-1.D0)/LAMBDA(J) 0000250 30 CONTINUE 0000251 ENDIF 0000252 10 CONTINUE 0000253 RETURN 0000254 END 0000255 C***********************************************************************0000256 SUBROUTINE COVAR(X,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG, 0000257 + WORK,IPRNT,IER) 0000258 DOUBLE PRECISION WORK,SIG,X,D1,D2,DET,MEAN, 0000259 + SUM,MI,MJ,DBN 0000260 INTEGER N,I,NCHNG,NVAR,L,II,J,IPRNT,III,IER, 0000261 + MOBS,MVARS 0000262 INTRINSIC DBLE,LOG 0000263 EXTERNAL LUDECP 0000264 DIMENSION X(MOBS,MVARS),SIG(((MVARS+1)*MVARS)/2), 0000265 + WORK(((MVARS+1)*MVARS)/2),MEAN(MVARS) 0000266 DBN=DBLE(N) 0000267 DO 20,I=NCHNG,NVAR 0000268 SUM=0. 0000269 DO 11,L=1,N 0000270 11 SUM=SUM+X(L,I) 0000271 MEAN(I)=SUM/DBN 0000272 20 CONTINUE 0000273 II=((NCHNG-1)*NCHNG)/2 0000274 DO 30,I=NCHNG,NVAR 0000275 MI=MEAN(I) 0000276 DO 31,J=1,I 0000277 MJ=MEAN(J) 0000278 II=II+1 0000279 SUM=0. 0000280 DO 32,L=1,N 0000281 32 SUM=SUM+(X(L,I)-MI)*(X(L,J)-MJ) 0000282 SIG(II)=SUM/DBN 0000283 31 CONTINUE 0000284 30 CONTINUE 0000285 IF(IPRNT.GE.20) THEN 0000286 III=0 0000287 DO 35,I=1,NVAR 0000288 III=III+1 0000289 PRINT 45,(SIG(J),J=III,III+I-1) 0000290 III=III+I-1 0000291 45 FORMAT(5G10.4) 0000292 35 CONTINUE 0000293 ENDIF 0000294 CALL LUDECP(SIG,WORK,NVAR,D1,D2,IER) 0000295 IF(IER.EQ.0) THEN 0000296 DET=LOG(D1)+D2*LOG(2.D0) 0000297 ENDIF 0000298 RETURN 0000299 END 0000300 C***********************************************************************0000301 SUBROUTINE CRITER(XT,N,NVAR,LAMBDA,X,AIC,DET,MOBS,MVARS) 0000302 C THIS ROUTINE COMPUTES AIC FOR THE TRANSFORMED DATA. THE EQUATION 0000303 C FOR AIC INCLUDES THE TERM N*NVAR*LN(2*PI). 0000304 DOUBLE PRECISION LAMBDA,X,XT,AIC,SUM,DET,PI,DF 0000305 INTEGER MOBS,MVARS,J,NVAR,I,N 0000306 INTRINSIC LOG,ATAN 0000307 DIMENSION XT(MOBS,MVARS),X(MOBS,MVARS),LAMBDA(MVARS) 0000308 AIC=0.0 0000309 DO 30 J=1,NVAR 0000310 SUM=0.0 0000311 DO 10 I=1,N 0000312 SUM=SUM+LOG(X(I,J)) 0000313 10 CONTINUE 0000314 SUM=(LAMBDA(J)-1.0)*SUM 0000315 AIC=AIC - 2.0*SUM 0000316 30 CONTINUE 0000317 AIC=(N*DET)+AIC 0000318 C NOTE THE VARIABLE DET CONTAINS LOG(DETERMINANT) 0000319 PI=4.D0*ATAN(1.D0) 0000320 AIC=AIC+ N*NVAR*LOG(2.0*PI) + N*NVAR 0000321 DF=(2.0*NVAR)+(NVAR*(NVAR+1)/2.D0) 0000322 AIC=AIC +2.0*DF 0000323 RETURN 0000324 END 0000325 C***********************************************************************0000326 SUBROUTINE MINIMA(NVAR,AIC,LAMBDA,AICMIN,SMALL,MVARS) 0000327 C THIS ROUTINE FINDS THE MINIMUM AIC VECTOR AND STORES IT 0000328 C IN THE VECTOR 'SMALL' 0000329 DOUBLE PRECISION SMALL,AIC,AICMIN,LAMBDA 0000330 INTEGER MVARS,J,NVAR 0000331 LOGICAL FIRST 0000332 DIMENSION LAMBDA(MVARS),SMALL(MVARS) 0000333 DATA FIRST/.TRUE./ 0000334 IF(FIRST) GOTO 20 0000335 IF(AIC.LT.AICMIN) GOTO 20 0000336 RETURN 0000337 20 CONTINUE 0000338 AICMIN=AIC 0000339 DO 10 J=1,NVAR 0000340 10 SMALL(J)=LAMBDA(J) 0000341 FIRST=.FALSE. 0000342 RETURN 0000343 END 0000344 C***********************************************************************0000345 SUBROUTINE ENUMER(LAMBDA,H,A,B,NVAR,FINISH,MVARS,NCHNG) 0000346 C THIS ROUTINE PRODUCES A DIFFERENT ONE OF THE POSSIBLE LAMBDA 0000347 C VECTORS EACH TIME THAT IT IS CALLED. WHEN THE POSSIBILITIES ARE 0000348 C EXHAUSTED, IT ,THROUGH THE LOG. VARIABLE FINISH, ENDS THE 0000349 C MAIN LOOP. 0000350 DOUBLE PRECISION LAMBDA,B,A,H 0000351 INTEGER MVARS,NVAR,NCHNG,I 0000352 LOGICAL FINISH 0000353 DIMENSION LAMBDA(MVARS),H(MVARS),B(MVARS),A(MVARS) 0000354 LAMBDA(NVAR)=LAMBDA(NVAR)+H(NVAR) 0000355 NCHNG=NVAR 0000356 DO 10 I=NVAR,2,-1 0000357 IF(LAMBDA(I).LE.B(I))GOTO 100 0000358 LAMBDA(I)=A(I) 0000359 LAMBDA(I-1)=LAMBDA(I-1)+H(I-1) 0000360 NCHNG=NCHNG-1 0000361 10 CONTINUE 0000362 100 CONTINUE 0000363 FINISH=(LAMBDA(1).GT.B(1)) 0000364 RETURN 0000365 END 0000366 C***********************************************************************0000367 SUBROUTINE AICORG(N,NVAR,AICNO,DET,MOBS,MVARS) 0000368 C THIS ROUTINE COMPUTES THE AIC OF THE ORIGINAL DATA. 0000369 DOUBLE PRECISION PI,AICNO,DET,DF 0000370 INTEGER N,NVAR,MOBS,MVARS 0000371 INTRINSIC ATAN,LOG 0000372 PI=4.D0*ATAN(1.D0) 0000373 AICNO=N*NVAR*LOG(2.0*PI) 0000374 AICNO=AICNO+(N*DET)+(N*NVAR) 0000375 C NOTE THE VARIABLE DET CONTAINS LOG(DETERMINANT) 0000376 DF=2.0*NVAR+(NVAR*(NVAR+1)/2.D0) 0000377 AICNO=AICNO+2.0*DF 0000378 RETURN 0000379 END 0000380 C***********************************************************************0000381 SUBROUTINE RIPGDF(NVAR,MVARS,N,MOBS,X,IX,IXCOL) 0000382 C READ_INTERACTIVELY_THE_PARAMETERS_AND_GET_DATA_FROM_A_FILE 0000383 CHARACTER*72 NAME 0000384 INTEGER NVAR,MVARS,N,MOBS,IX,IXCOL,I,J 0000385 DOUBLE PRECISION X(IX,IXCOL) 0000386 1 FORMAT(A) 0000387 PRINT* 0000388 PRINT*,'ENTER THE NUMBER OF VARIABLES' 0000389 READ*,NVAR 0000390 IF(NVAR.GT.MVARS) THEN 0000391 PRINT*,'MAXIMUM NO. OF VARIABLES IS ',MVARS 0000392 STOP 0000393 ENDIF 0000394 PRINT*,'ENTER THE NUMBER OF CASES' 0000395 READ*,N 0000396 IF(N.GT.MOBS) THEN 0000397 PRINT*,'MAXIMUM NO. OF CASES IS ',MOBS 0000398 STOP 0000399 ENDIF 0000400 PRINT* 0000401 PRINT*,'WHAT FILE IS YOUR DATA IN?' 0000402 READ 1,NAME 0000403 OPEN(UNIT=5,FILE=NAME,STATUS='OLD') 0000404 PRINT*,'ENTER THE FORTRAN FORMAT OR HIT RETURN FOR FREEFIELD' 0000405 READ 1,NAME 0000406 PRINT*,'READING DATA...' 0000407 IF(NAME.EQ.' ') THEN 0000408 DO 10 I=1,N 0000409 10 READ(5,*)(X(I,J),J=1,NVAR) 0000410 ELSE 0000411 DO 20 I=1,N 0000412 20 READ(5,NAME)(X(I,J),J=1,NVAR) 0000413 ENDIF 0000414 CLOSE(5) 0000415 PRINT*,'DATA READ' 0000416 RETURN 0000417 END 0000418 C***********************************************************************0000419 SUBROUTINE QUERY(TITLE,LFMT) 0000420 CHARACTER*60 TITLE 0000421 LOGICAL LFMT 0000422 C LOCAL VARIABLES 0000423 CHARACTER*1 ANS 0000424 1 CONTINUE 0000425 PRINT* 0000426 PRINT*,TITLE 0000427 PRINT*,' (Y OR N)' 0000428 READ 10,ANS 0000429 10 FORMAT(A) 0000430 IF(ANS.NE.'y'.AND.ANS.NE.'Y'.AND.ANS.NE.'N'.AND.ANS.NE.'n') 0000431 + THEN 0000432 GOTO 1 0000433 ENDIF 0000434 LFMT=(ANS.EQ.'y'.OR.ANS.EQ.'Y') 0000435 RETURN 0000436 END 0000437 C***********************************************************************0000438 SUBROUTINE UNIV(X,XT,N,A,B,H,LTRANS,SMALL) 0000439 C AIC METHOD FOR TRANSFORMATION OF DATA TO UNIVARIATE 0000440 C NORMALITY 0000441 C X (INPUT) ORIGINAL DATA 0000442 C XT (OUTPUT) CONTAINS TRANS. DATA IF LTRANS IS TRUE. ALSO USED 0000443 C FOR WORK STORAGE REGARDLESS OF THE VALUE OF LTRANS 0000444 C N (INPUT) NUMBER OF OBSERVATIONS 0000445 C A,B,H (INPUT) START WITH LAMBDA=A, LOOP TO B WITH STEPSIZE H 0000446 C LTRANS (INPUT) TRUE IF THE DATA IS TO BE TRANSFORMED BY THE 0000447 C OPTIMAL LAMBDA, FALSE OTHERWISE. 0000448 C IF LTRANS IS FALSE, THEN THE X ARRAY REMAINS AS 0000449 C IT WAS ON INPUT. 0000450 C SMALL (OUTPUT) THE VALUE OF LAMBDA THAT GENERATED THE OPTIMAL AIC 0000451 DOUBLE PRECISION LAMBDA,XT,X,A,B,H,XTMEAN,AIC,AICMIN,SMALL,XMEAN, 0000452 + AICNO 0000453 INTEGER N 0000454 EXTERNAL UTRANS,UMEAN,UCRIT,UMINI,UORIG 0000455 DIMENSION X(N),XT(N) 0000456 LOGICAL LTRANS,FIRST 0000457 PRINT* 0000458 PRINT*,' LAMBDA AIC' 0000459 PRINT* 0000460 FIRST=.TRUE. 0000461 C MAIN LOOP THROUGH ALL THE LAMBDA`S 0000462 DO 15 LAMBDA=A,B,H 0000463 CALL UTRANS(X,N,LAMBDA,XT) 0000464 CALL UMEAN(XT,N,XTMEAN) 0000465 CALL UCRIT(XT,N,LAMBDA,XTMEAN,X,AIC) 0000466 CALL UMINI(AIC,AICMIN,LAMBDA,SMALL,FIRST) 0000467 PRINT*,LAMBDA,AIC 0000468 15 CONTINUE 0000469 CALL UMEAN(X,N,XMEAN) 0000470 CALL UORIG(X,N,XMEAN,AICNO) 0000471 PRINT* 0000472 PRINT* 0000473 PRINT*,'MINIMUM AIC OCCURS AT A LAMBDA OF ',SMALL 0000474 PRINT*,'AND HAS A VALUE OF',AICMIN 0000475 PRINT* 0000476 PRINT*,'THE ORIGINAL DATA HAS AN AIC OF',AICNO 0000477 PRINT* 0000478 PRINT*,'THE DIFFERENCE BETWEEN THE ORIGINAL AND TRANSFORMED' 0000479 PRINT*,'AIC`S IS:' 0000480 PRINT*,AICNO-AICMIN 0000481 IF(LTRANS) THEN 0000482 C TRANSFORM DATA USING BEST LAMBDA 0000483 CALL UTRANS(X,N,SMALL,XT) 0000484 ENDIF 0000485 RETURN 0000486 END 0000487 C***********************************************************************0000488 SUBROUTINE UTRANS(X,N,LAMBDA,XT) 0000489 DOUBLE PRECISION LAMBDA,XT,X,TINY 0000490 INTEGER N,I 0000491 INTRINSIC DLOG,ABS 0000492 PARAMETER(TINY=1.0D-4) 0000493 DIMENSION X(N),XT(N) 0000494 IF (ABS(LAMBDA).GT.TINY) THEN 0000495 DO 10,I=1,N 0000496 10 XT(I)=(X(I)**LAMBDA-1.0D0)/LAMBDA 0000497 ELSE 0000498 DO 20,I=1,N 0000499 20 XT(I)=DLOG(X(I)) 0000500 ENDIF 0000501 RETURN 0000502 END 0000503 C***********************************************************************0000504 SUBROUTINE UMEAN(DATA,N,DMN) 0000505 DOUBLE PRECISION DATA,DMN 0000506 INTEGER N,I 0000507 INTRINSIC DBLE 0000508 DIMENSION DATA(N) 0000509 DMN=0 0000510 DO 10 I=1,N 0000511 DMN=DATA(I)+DMN 0000512 10 CONTINUE 0000513 DMN=DMN/DBLE(N) 0000514 RETURN 0000515 END 0000516 C***********************************************************************0000517 SUBROUTINE UCRIT(XT,N,LAMBDA,XTMEAN,X,AIC) 0000518 C THIS ROUTINE COMPUTE THE AIC OF THE TRANSFORMED DATA 0000519 C BY THE FORMULA AIC=(N*LN(2*PI)+(N*LN(S-SQUARED)) 0000520 C -2*(LAMBDA-1)*(SUM-OVER-I`S OF LN(X(I))) 0000521 C +6 0000522 C S-SQUARED IS COMPUTED USING THE TRANSFORMED DATA. 0000523 DOUBLE PRECISION LAMBDA,X,XT,FIRST,SECOND,XTMEAN,AIC,PI 0000524 INTEGER N,J 0000525 INTRINSIC DABS,DLOG,DATAN 0000526 DIMENSION XT(N),X(N) 0000527 FIRST=0 0000528 SECOND=0 0000529 DO 10 J=1,N 0000530 FIRST=FIRST+(DABS(XT(J)-XTMEAN))**2.0D0 0000531 SECOND=SECOND+DLOG(X(J)) 0000532 10 CONTINUE 0000533 FIRST=FIRST/N 0000534 FIRST=N*DLOG(FIRST) 0000535 SECOND=(LAMBDA-1.0D0)*SECOND 0000536 AIC=FIRST-2.0D0*SECOND 0000537 C COMPUTES VALUE OF PI 0000538 PI=4.0D0*DATAN(1.0D0) 0000539 AIC=AIC+(N*DLOG(2.0D0*PI))+ 6.0D0 + N 0000540 RETURN 0000541 END 0000542 C***********************************************************************0000543 SUBROUTINE UMINI(AIC,AICMIN,LAMBDA,SMALL,FIRST) 0000544 C THIS ROUTINE LOCATES AND STORES THE MINIMUM AIC 0000545 DOUBLE PRECISION LAMBDA,AIC,AICMIN,SMALL 0000546 LOGICAL FIRST 0000547 IF(FIRST) GOTO 10 0000548 IF(AIC.LT.AICMIN) GOTO 10 0000549 RETURN 0000550 10 SMALL=LAMBDA 0000551 AICMIN=AIC 0000552 FIRST=.FALSE. 0000553 RETURN 0000554 END 0000555 C***********************************************************************0000556 SUBROUTINE UORIG(X,N,XMEAN,AICNO) 0000557 C THIS ROUTINE COMPUTE THE AIC OF THE ORIGINAL DATA 0000558 C USING THE FORMULAN*LN(2*PI)+(N*LN(S-SQUARED))+N+4. 0000559 DOUBLE PRECISION X,AICNO,XMEAN,PI 0000560 INTEGER N,I 0000561 INTRINSIC DLOG,DATAN 0000562 DIMENSION X(N) 0000563 AICNO=0.0D0 0000564 DO 10 I=1,N 0000565 10 AICNO=AICNO+((X(I)-XMEAN)**2) 0000566 AICNO=AICNO/N 0000567 AICNO=N*DLOG(AICNO) 0000568 PI=4.0D0*DATAN(1.0D0) 0000569 AICNO=AICNO+(N*DLOG(2.0D0*PI))+N+4.0D0 0000570 RETURN 0000571 END 0000572 C***********************************************************************0000573 SUBROUTINE FUNCT(NVAR,LAMBDA,F) 0000574 INTEGER MOBS,MVARS,PSYM, 0000575 + NVAR,N,IPRNT,NCHNG,I,IER 0000576 DOUBLE PRECISION F,X,XT,DET,SIG,WORK,AIC,LAMBDA,MEAN 0000577 EXTERNAL FINDO,CRITER,COVAR,TRANS 0000578 INTRINSIC ABS 0000579 PARAMETER(MOBS=100,MVARS=20, 0000580 + PSYM=((MVARS+1)*MVARS)/2) 0000581 DIMENSION LAMBDA(NVAR) 0000582 COMMON /QUASI/ X(MOBS,MVARS),N,XT(MOBS,MVARS),DET, 0000583 + SIG(PSYM),MEAN(MVARS),WORK(PSYM),IPRNT,AIC 0000584 NCHNG=1 0000585 DO 30,I=1,NVAR 0000586 C IF LAMBDA IS TOO LARGE, MAKE THE ALGORITHM BACK UP 0000587 IF(ABS(LAMBDA(I)).GT.100) THEN 0000588 F=1.D50 0000589 RETURN 0000590 ENDIF 0000591 30 CONTINUE 0000592 CALL TRANS(X,N,NVAR,LAMBDA,XT,MOBS,MVARS,NCHNG) 0000593 CALL COVAR(XT,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG,WORK, 0000594 + IPRNT,IER) 0000595 IF(IER.NE.0) THEN 0000596 PRINT* 0000597 PRINT*,'ERROR IN CALCULATING AIC AT THIS LAMBDA:' 0000598 DO 10,I=1,NVAR 0000599 10 PRINT*,LAMBDA(I) 0000600 CALL FINDO(X,N,NVAR,LAMBDA,XT,MOBS,MVARS,NCHNG) 0000601 ELSE 0000602 CALL CRITER(XT,N,NVAR,LAMBDA,X,AIC,DET,MOBS,MVARS) 0000603 F=AIC 0000604 PRINT 20,AIC,(LAMBDA(I),I=1,NVAR) 0000605 20 FORMAT(1X,G20.5,T30,3G15.3,(/,T30,3G15.3)) 0000606 RETURN 0000607 ENDIF 0000608 END 0000609 C***********************************************************************0000610 SUBROUTINE FINDO(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 0000611 INTEGER N,NVAR,MOBS,MVARS,NCHNG,I,J 0000612 DOUBLE PRECISION X,SMALL,XT 0000613 EXTERNAL TRANS 0000614 DIMENSION X(MOBS,MVARS),SMALL(MVARS),XT(MOBS,MVARS) 0000615 CALL TRANS(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 0000616 DO 75 I=1,N 0000617 75 WRITE(6,*)(XT(I,J),J=1,NVAR) 0000618 ENDFILE(6) 0000619 CLOSE(6) 0000620 C END 0000621 C***********************************************************************0000622 C ROUTINES CALLED WHICH ARE IN IMSL 0000623 C LUDECP(SIG,WORK,NVAR,D1,D2,IER) - CALCULATES DETERMINANT 0000624 C ZXMIN(F,NVAR,NSIG,I,IOPT,D,HESS,GRAD,F1,W,IER) - 0000625 C CARRIES OUT A MINIMIZATION OF A REAL-VALUED 0000626 C FUNCTION OF N-VARIABLES USING A QUASI-NEWTON FLETCHER TYPE 0000627 C ALGORITHM. 0000628 C***********************************************************************0000629 END 0000630 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ APPENDIX E: THE CALL STATEMENTS IN MTRANS 1: PROGRAM MTRANS 41: CALL RIPGDF(NVAR,MVARS,N,MOBS,X,MOBS,MVARS) 49: CALL COVAR(X,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG,WORK, 50: + IPRNT,IER) 53: CALL AICORG(N,NVAR,AICNO,DET,MOBS,MVARS) 76: CALL QUERY(TITLE,LSEE) 97: CALL UNIV(X(1,I),XT(1,I),N,A(I),B(I),H(I), 98: + LSEE,LAMBDA(I)) 133: CALL QUERY(TITLE,LSEE) 147: CALL COVAR(XT,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG,WORK, 148: + IPRNT,IER) 150: CALL CRITER(XT,N,NVAR,LAMBDA,X,AIC,DET,MOBS,MVARS) 151: CALL MINIMA(NVAR,AIC,LAMBDA,AICMIN,SMALL,MVARS) 163: CALL ENUMER(LAMBDA,H,A,B,NVAR,FIN,MVARS,NCHNG) 178: CALL ZXMIN(FUNCT,NVAR,NSIG,ITER,IOPT, 179: + LAMBDA,HESS,GRAD,F,W,IER) 190: CALL QUERY(TITLE,LSEE) 220: CALL FINDO(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 223: SUBROUTINE FINDO(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 229: CALL TRANS(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 236: SUBROUTINE TRANS(X,N,NVAR,LAMBDA,XT,MOBS,MVARS,NCHNG) 257: SUBROUTINE COVAR(X,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG, 258: + WORK,IPRNT,IER) 295: CALL LUDECP(SIG,WORK,NVAR,D1,D2,IER) 302: SUBROUTINE CRITER(XT,N,NVAR,LAMBDA,X,AIC,DET,MOBS,MVARS) 327: SUBROUTINE MINIMA(NVAR,AIC,LAMBDA,AICMIN,SMALL,MVARS) 346: SUBROUTINE ENUMER(LAMBDA,H,A,B,NVAR,FINISH,MVARS,NCHNG) 367: SUBROUTINE AICORG(N,NVAR,AICNO,DET,MOBS,MVARS) 381: SUBROUTINE RIPGDF(NVAR,MVARS,N,MOBS,X,IX,IXCOL) 419: SUBROUTINE QUERY(TITLE,LFMT) 438: SUBROUTINE UNIV(X,XT,N,A,B,H,LTRANS,SMALL) 463: CALL UTRANS(X,N,LAMBDA,XT) 464: CALL UMEAN(XT,N,XTMEAN) 465: CALL UCRIT(XT,N,LAMBDA,XTMEAN,X,AIC) 466: CALL UMINI(AIC,AICMIN,LAMBDA,SMALL,FIRST) 469: CALL UMEAN(X,N,XMEAN) 470: CALL UORIG(X,N,XMEAN,AICNO) 483: CALL UTRANS(X,N,SMALL,XT) 488: SUBROUTINE UTRANS(X,N,LAMBDA,XT) 504: SUBROUTINE UMEAN(DATA,N,DMN) 517: SUBROUTINE UCRIT(XT,N,LAMBDA,XTMEAN,X,AIC) 543: SUBROUTINE UMINI(AIC,AICMIN,LAMBDA,SMALL,FIRST) 556: SUBROUTINE UORIG(X,N,XMEAN,AICNO) 573: SUBROUTINE FUNCT(NVAR,LAMBDA,F) 592: CALL TRANS(X,N,NVAR,LAMBDA,XT,MOBS,MVARS,NCHNG) 593: CALL COVAR(XT,N,NVAR,DET,MOBS,MVARS,SIG,MEAN,NCHNG,WORK, 594: + IPRNT,IER) 600: CALL FINDO(X,N,NVAR,LAMBDA,XT,MOBS,MVARS,NCHNG) 602: CALL CRITER(XT,N,NVAR,LAMBDA,X,AIC,DET,MOBS,MVARS) 610: SUBROUTINE FINDO(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) 615: CALL TRANS(X,N,NVAR,SMALL,XT,MOBS,MVARS,NCHNG) The following subroutines are from IMSL: ZXMIN LUDECP $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$