PROGRAM FRACFACT IMPLICIT INTEGER (A-Z) CHARACTER ATRY, APRT COMMON MOD(64,63), MODEL(64,11) COMMON / BLK1 / ALIAS(11,7), ALIEN(56,7), DROP(56) COMMON / BLK2 / ACOUNT(56) DO 300 I=1,12 300 WRITE(*,*) WRITE(*,3000) 3000 FORMAT ( 1 /,10X,'Welcome to FRACFACT! This program is designed to help', 2 /,10X,'the user design a fractional factorial experiment. You', 3 /,10X,'will be asked to provide information at various stages.', 4 /,10X,'This will be done in an interactive manner, so you need', 5 /,10X,'only respond to the prompts by providing the necessary', 6 /,10X,'information. However, at each stage instructions will', 7 /,10X,'be given to help you provide the program what it needs.') WRITE(*,3001) 3001 FORMAT ( 1 /,10X,'The final result will be the prescription for a 2**(k-p)', 2 /,10X,'fractional factorial design and its associated defining', 3 /,10X,'relation. This prescription will consist of +1''s and ', 4 /,10X,'-1''s signifying the particular level (upper or lower) ', 5 /,10X,'of the various factors which should be applied in each', 6 /,10X,'run of the experiment. These are presented in a standard' 7,/,10X,'order, and any use of this prescription should include,', 8 /,10X,'of course, a randomization of these runs.',/, 9 /,10X,'Press RETURN to continue.') READ(*,4000) BEGIN 4000 FORMAT(I1) WRITE(*,3002) 3002 FORMAT ( 1 /,10X,'You will also have the option of changing the signs of ', 2 /,10X,'any set of factors. If the design is of resolution III', 3 /,10X,'you will have the option of adding an additional fraction' 4,/,10X,'to de-alias certain sets of factors or interactions.',/, 5 /,10X,'Well, let''s get going.',/, 6 /,10X,'Press RETURN to begin.') READ(*,4000) BEGIN * * Entering input - number of factors * 99 CALL CLEAR DO 301 I=1,12 301 WRITE(*,*) WRITE(*,3003) 3003 FORMAT ( 1 /,10X,'The first information that is needed is the number of ', 2 /,10X,'factors in your experiment. This program is able to ', 3 /,10X,'handle between 3 and 11 factors (inclusive). Enter the', 4 /,10X,'number of factors and press RETURN.',/) WRITE(*,1001) 1001 FORMAT ('1','ENTER THE NUMBER OF FACTORS (BETWEEN 3 AND 11)',/) READ(*,2001) K 2001 FORMAT (I2) DO 302 I=1,12 302 WRITE(*,*) WRITE(*,3004) 3004 FORMAT ( 1 /,10X,'Now you have three options. The first two consist of ', 2 /,10X,'the choice of either a resolution III or IV design,', 3 /,10X,'which is defined in the accompanying program guide. ', 4 /,10X,'The program then gives a prescription of the chosen', 5 /,10X,'resolution in the minimum number of runs. These two', 6 /,10X,'options require the least amount of user input.') WRITE(*,3005) 3005 FORMAT ( 1 /,10X,'The last option provides the user more flexibility in ', 2 /,10X,'constructing the design. With this option you will be', 3 /,10X,'asked to provide information in a sequential manner in', 4 /,10X,'order to construct a design.',/, 5 /,10X,'Choose the desired option by entering the corresponding', 6 /,10X,'number and pressing RETURN.',/) WRITE(*,1002) 1002 FORMAT ('1','CHOOSE ONE OF THE FOLLOWING OPTIONS',/, 1 ' 1: RESOLUTION III DESIGN',/, 2 ' 2: RESOLUTION IV DESIGN',/, 3 ' 3: CONSTRUCT YOUR OWN DESIGN',/) READ(*,2002) RES 2002 FORMAT (I1) RES = RES+2 * * Determining the number of runs,i.e., minimal fraction * necessary for a Resolution III design * IF (RES .EQ. 3) THEN CALL RES3(K,P,N,POINT) IF (POINT.EQ.1) GOTO 999 END IF * * Determining the number of runs, i.e., minimal fractional * necessary for a Resolution IV design * IF (RES .EQ. 4) THEN CALL RES4(K,P,N,POINT) IF (POINT.EQ.1) GOTO 999 END IF * * Letting user choose from various designs to achieve the highest * resolution with the fewest runs * IF (RES .EQ. 5) THEN CALL RES5(K,P,N,RESV) END IF * * Calling subroutine to set up initial matrix * CALL MATRIX(K,P,N,MOD,ALIEN) * * Setting up 'reduced' matrix for saturated design * IF (K .EQ. N-1) THEN DO 117 I=1,N DO 117 J=1,K 117 MODEL(I,J) = MOD(I,J) DO 118 I=1,P DO 118 J=1,K-P+1 118 ALIAS(I,J) = ALIEN(I,J) GOTO 998 END IF * * Determining the columns to be dropped to obtain the * 'reduced' matrix * IF (RES .EQ. 5) THEN CALL CDROP5(K,P,N) ELSE CALL CDROP34(K,P,N,RES,DROP) END IF * * Dropping the given columns to obtain the 'reduced' matrix * CALL COLDROP(K,N,P) * * Printing the design matrix and the aliases for added columns * 998 CALL PRTMAT(N,K,MODEL) WRITE(*,3007) 3007 FORMAT (/,/,' Press RETURN for the defining relation',/) READ(*,4000) BEGIN * * Computing and printing the defining relation * CALL DEFINE(K,P) WRITE(*,3006) 3006 FORMAT (/,/,' Press RETURN for further options.') READ(*,4000) BEGIN * * Changing the signs of any specified column * CALL SIGN(K,P,N) WRITE(*,3006) READ(*,4000) BEGIN * * If so desired by the user, dealiasing a single main effect and * its associated interactions or dealiasing all main effects * CALL DEALIAS(K,P,N) * * Giving the user the option to have the prescription printed * WRITE(*,1003) 1003 FORMAT (/,' DO YOU WANT TO HAVE THE PRESCRIPTION PRINTED? ', + '(Y/N)',/) READ(*,2003) APRT 2003 FORMAT(A1) IF (APRT .EQ. 'Y' .OR. APRT .EQ. 'y') THEN OPEN (10,FILE='PRN',STATUS='UNKNOWN') WRITE(10,1004) (J,J=1,K) 1004 FORMAT (' ','PRESCRIPTION FOR FINAL DESIGN', + /,/,' FACTORS: ',24I3,/) DO 103 I=1,N WRITE(10,1005) I,(MODEL(I,J),J=1,K) 1005 FORMAT (' RUN ',I2,3X,24I3) 103 CONTINUE WRITE(10,1006) 1006 FORMAT ('1') END IF * * Giving the user a second chance * 999 WRITE(*,1007) 1007 FORMAT (/,' DO YOU WANT TO TRY AGAIN? (Y/N)',/) READ(*,2007) ATRY 2007 FORMAT (A1) IF (ATRY .EQ. 'Y' .OR. ATRY .EQ. 'y') THEN GOTO 99 END IF STOP END SUBROUTINE CDROP34(K,P,N,RES,DROP) * * This subroutine determines the columns that should be * dropped from a saturated matrix to achieve either a * resolution III or IV design with k factors * IMPLICIT INTEGER (A-Z) INTEGER COL4(8,8), COL3(6,8), DROP(25) DATA COL4 / 4, 5, 6, 7, 8, 9, 10, 11, 1 8, 16, 16, 16, 16, 32, 32, 32, 2 7, 15, 11, 11, 11, 27, 26, 16, 3 0, 0, 14, 13, 12, 28, 27, 19, 4 3*0, 14, 13, 29, 28, 21, 5 4*0, 14, 30, 29, 22, 6 6*0, 30, 24, 7*0, 25/ DATA COL3/ 4, 5, 6, 9, 10, 11, 1 8, 8, 8, 16, 16, 16, 2 4, 6, 7, 5, 6, 7, 3 5, 7, 0, 6, 7, 8, 4 6, 0, 0, 7, 8, 9, 5 3*0, 8, 9, 10, 6 3*0, 9, 10, 0, 3*0, 10, 2*0/ * * Determining columns to be dropped for a Resolution IV design * IF (RES .EQ. 4) THEN COUNT=1 DO 102 I=1,7 IF (COL4(I,1) .EQ. K) THEN DO 101 J=K-P+1,N-1 DO 100 L=1,P IF (J .EQ. COL4(I,L+2)) GOTO 101 IF (L .NE. P) GOTO 100 DROP(COUNT) = J COUNT = COUNT+1 100 CONTINUE 101 CONTINUE GOTO 999 END IF 102 CONTINUE ELSE * * Determining columns to be dropped for a Resolution III design * DO 104 I=1,6 IF (COL3(I,1) .EQ. K) THEN DO 103 J=1,N-K-1 103 DROP(J) = COL3(I,J+2) END IF ******* modify on jan,29,97 ******* * GOTO 999 104 CONTINUE END IF 999 RETURN END SUBROUTINE CDROP5(K,P,N) * * This subroutine allows the user to specify which columns of a * saturated design to drop in order to determine the final design. * It also provides suggestions of which columns to drop ala BHH. * IMPLICIT INTEGER (A-Z) DIMENSION DROP1(56) COMMON / BLK1 / ALIAS(11,7), ALIEN(56,7), DROP(56) COMMON / BLK2 / ACOUNT(56) CHARACTER ADROP A=K-P+1 B=N-1 C=K-P D=N-K-1 DO 300 I=1,10 300 WRITE(*,*) WRITE(*,3000) B,D,C,D,A,B 3000 FORMAT ( 1 /,10X,'FRACFACT has constructed a saturated design in ',I2, 2 /,10X,'factors. In order to pare this down to ',I2,' factors', 3 /,10X,'columns (associated with corresponding factors) must be', 4 /,10X,'droppped. However, FRACFACT reserves the first ',I2, 5 /,10X,'columns in order to retain a full factorial in these', 6 /,10X,'factors. Thus, ',I2,' columns between ',I2,' and ',I2, 7 /,10X,'must be dropped.') WRITE(*,3001) 3001 FORMAT ( 1 /,10X,'Two ways of achieving this are provided. First, a list', 2 /,10X,'of suggested columns to be dropped are provided. Choose', 3 /,10X,'this method by entering Y and pressing RETURN when asked,' 4,/,10X,'''WOULD YOU LIKE TO HAVE THE ABOVE COLUMNS DROPPED?''', 5 /,10X,'A second method may be used by responding N to the above', 6 /,10X,'question. For this method you may choose which columns', 7 /,10X,'are to be dropped by entering sequentially each of these', 8 /,10X,'columns and pressing RETURN in response to the prompt:', 9 /,10X,'ENTER ONE COLUMN TO BE DROPPED.') WRITE(*,3002) 3002 FORMAT (/,' Press RETURN to continue.') READ(*,4000) BEGIN 4000 FORMAT(I1) DO 301 I=1,12 301 WRITE(*,*) WRITE(*,1000) D,A,B 1000 FORMAT (/,' YOU NEED TO DROP A TOTAL OF ',I3,' COLUMNS',/, + ' INPUT WHICH COLUMNS BETWEEN ',I3,' AND ',I3, + ' YOU WANT DROPPED',/) WRITE(*,1003) A, B, C 1003 FORMAT (/,' THE COLUMNS ',I2,' TO ',I2,' ASSOCIATED WITH THE ', + 'INTERACTIONS OF FACTORS 1 TO',I2,' ARE:',/,/, + 2X,'COLUMN NO.',5X,'INTERACTION') DO 102 I=1,(B-C) 102 WRITE(*,1004) (ALIEN(I,J),J=1,ACOUNT(I)) 1004 FORMAT (6X,I2,9X,6(I3,2X)) * * Offering suggestions for columns to be dropped * CALL SUGGST(K,P,N,DROP1) WRITE(*,1001) 1001 FORMAT (/,' Would you like to have the above columns ', + 'dropped? (Y/N)',/) READ(*,2001) ADROP 2001 FORMAT (A1) IF (ADROP .EQ. 'Y' .OR. ADROP .EQ. 'y') THEN DO 100 J=1,N-K-1 100 DROP(J) = DROP1(J) ELSE DO 101 J=1,N-K-1 WRITE(*,1002) 1002 FORMAT (/,' ENTER ONE COLUMN TO BE DROPPED',/) READ(*,2002) DROP(J) 2002 FORMAT (I2) 101 CONTINUE END IF RETURN END SUBROUTINE CLEAR * * This subroutine set all arrays to null arrays. * IMPLICIT INTEGER (A-Z) COMMON M1(64,63), M2(64,11) COMMON / BLK1 / A1(11,7), A2(56,7), D(56) COMMON / BLK2 / AK(56) DO 100 I=1,11 DO 100 J=1,7 100 A1(I,J) = 0 DO 101 I=1,56 D(I) = 0 AK(I) = 0 DO 101 J=1,7 101 A2(I,J) = 0 DO 104 I=1,64 DO 102 J=1,63 102 M1(I,J) = 0 DO 103 K=1,7 103 M2(I,K) = 0 104 CONTINUE RETURN END SUBROUTINE COLDROP(K,N,P) * * This subroutine drops the given columns to determine the fianl * design and determines the alias structure of the main effects * associated with the interactions of the first k-p factors. * IMPLICIT INTEGER (A-Z) COMMON MOD(64,63), MODEL(64,11) COMMON / BLK1 / ALIAS(11,7), ALIEN(56,7), DROP(56) COUNT = 1 COUNT2 = 1 DO 104 I=1,N-1 DO 101 J=1,N-K-1 IF (I .EQ. DROP(J)) GOTO 104 101 CONTINUE DO 102 L=1,N 102 MODEL(L,COUNT) = MOD(L,I) COUNT = COUNT+1 IF (I .GT. (K-P)) THEN ALIAS(COUNT2,1) = (K-P) + COUNT2 DO 103 L=2,K-P+1 103 ALIAS(COUNT2,L) = ALIEN(I-K+P,L) COUNT2 = COUNT2+1 END IF 104 CONTINUE RETURN END SUBROUTINE DEALIAS(K,P,N) * * This subroutine allows the use to de-alias either one main effect * and its associated interactions or to de-alias all main effects by * adding an appropriate second fraction. * IMPLICIT INTEGER (A-Z) COMMON MOD(64,63), MODEL(64,11) DO 300 I=1,12 300 WRITE(*,*) WRITE(*,3000) 3000 FORMAT( 2 /,10X,'The user now has the option of adding an additional ' 3,/,10X,'fraction to (1) de-alias one main effect and its ', 4 /,10X,'associted interactions, or (2) de-alias all main effects.' 5,/,10X,'If either of these two options is chosen, the appropriate' 6,/,10X,'effects will not be confounded with any other main effect' 7,/,10X,'or 2fi. However, the number of runs will be doubled.') WRITE(*,3001) 3001 FORMAT ( 1 /,10X,'Choose either of these options by entering the corre-', 2 /,10X,'sponding option number and pressing RETURN. If you do', 3 /,10X,'not want to exercise either of these options, enter 3 ', 4 /,10X,'and press RETURN.',/,/) WRITE(*,1000) 1000 FORMAT (/,' You have a Resolution III design. You may:',/, + ' 1: DEALIAS A MAIN EFFECT WITH ITS INTERACTIONS',/, + ' 2: DEALIAS ALL MAIN EFFECTS',/, + ' 3: KEEP WHATCHA GOT!',/) READ(*,2000) DECIDE 2000 FORMAT(I1) IF (DECIDE .NE. 1 .AND. DECIDE .NE. 2) GOTO 997 IF (DECIDE .EQ. 1) THEN WRITE(*,1001) 1001 FORMAT (/,' Which main effect do you want dealiased?') READ(*,2001) FACTOR 2001 FORMAT (I2) DO 100 I=1,N DO 100 J=1,K IF (J .EQ. FACTOR) THEN MODEL(I+N,J) = -MODEL(I,J) ELSE MODEL(I+N,J) = MODEL(I,J) END IF 100 CONTINUE ELSE DO 101 I=1,N DO 101 J=1,K 101 MODEL(I+N,J) = -MODEL(I,J) END IF N = 2*N CALL PRTMAT(N,K,MODEL) 997 RETURN END SUBROUTINE DEFINE(K,P) * * This subroutine determines the defining relation of the * design produces by the program. * IMPLICIT INTEGER (A-Z) COMMON / BLK1 / ALIAS(11,7), ALIEN(56,7), DROP(56) DIMENSION DEF(128,11), DEFREL(128,11), KCOUNT(128) DO 200 I=1,128 DO 200 J=1,11 200 DEFREL(I,J) = 0 * * Setting up the defining relations for the first P factors, i.e., * those based on the factors K-P+1 to K which are aliased with * interactions of the other K-P factors (called generators) * DO 199 I=1,P DO 199 J=1,K 199 DEF(I,J) = -1 DO 100 I=1,P DO 100 J=1,K-P+1 DO 100 M=1,K IF (ALIAS(I,J) .EQ. M) THEN DEF(I,M) = 1 END IF 100 CONTINUE * * Taking all possible products of generators * COUNT=P+1 DO 102 I1=1,P-1 DO 102 I2=I1+1,P DO 101 M=1,K 101 DEF(COUNT,M) = -DEF(I1,M)*DEF(I2,M) 102 COUNT = COUNT+1 IF (P.LT.3) GOTO 999 DO 104 I1=1,P-2 DO 104 I2=I1+1,P-1 DO 104 I3=I2+1,P DO 103 M=1,K 103 DEF(COUNT,M) = DEF(I1,M)*DEF(I2,M)*DEF(I3,M) 104 COUNT = COUNT+1 IF (P.LT.4) GOTO 999 DO 106 I1=1,P-3 DO 106 I2=I1+1,P-2 DO 106 I3=I2+1,P-1 DO 106 I4=I3+1,P DO 105 M=1,K 105 DEF(COUNT,M) = -DEF(I1,M)*DEF(I2,M)*DEF(I3,M)*DEF(I4,M) 106 COUNT = COUNT+1 IF (P.LT.5) GOTO 999 DO 108 I1=1,P-4 DO 108 I2=I1+1,P-3 DO 108 I3=I2+1,P-2 DO 108 I4=I3+1,P-1 DO 108 I5=I4+1,P DO 107 M=1,K 107 DEF(COUNT,M) = DEF(I1,M)*DEF(I2,M)*DEF(I3,M)* + DEF(I4,M)*DEF(I5,M) 108 COUNT = COUNT+1 IF (P.LT.6) GOTO 999 DO 110 I1=1,P-5 DO 110 I2=I1+1,P-4 DO 110 I3=I2+1,P-3 DO 110 I4=I3+1,P-2 DO 110 I5=I4+1,P-1 DO 110 I6=I5+1,P DO 109 M=1,K 109 DEF(COUNT,M) = -DEF(I1,M)*DEF(I2,M)*DEF(I3,M)* + DEF(I4,M)*DEF(I5,M)*DEF(I6,M) 110 COUNT = COUNT+1 IF (P.LT.7) GOTO 999 DO 111 M=1,K 111 DEF(COUNT,M) = DEF(1,M)*DEF(2,M)*DEF(3,M)* + DEF(4,M)*DEF(5,M)*DEF(6,M)*DEF(7,M) 999 DO 112 I=1,2**P-1 KCOUNT(I) = 0 DO 112 J=1,K IF (DEF(I,J) .EQ. 1) THEN KCOUNT(I) = KCOUNT(I)+1 DEFREL(I,KCOUNT(I)) = J END IF 112 CONTINUE WRITE(*,1001) 1001 FORMAT (/,' The defining relation is (i.e., those factors or ', 1 'interactions that are',/, 2 ' confounded with the mean):',/) DO 113 I=1,2**P-1 113 WRITE(*,1002) (DEFREL(I,J),J=1,KCOUNT(I)) 1002 FORMAT (11I3) RETURN END SUBROUTINE MATRIX(K,P,N,V,A) C C This subroutine sets up a full factorial model matrix C for a 2**(k-p), including columns for interaction terms. C IMPLICIT INTEGER (A-Z) INTEGER F1(2), F2(4), F3(8), F4(16), F5(32), F6(64) INTEGER V(64,63), A(56,7) COMMON / BLK2 / ACOUNT(56) DATA F1, F2/ -1, 1, 2*-1, 2*1/ DATA F3, F4/ 4*-1, 4*1, 8*-1, 8*1/ DATA F5, F6/ 16*-1, 16*1, 32*-1, 32*1/ C C Setting up the main effects columns C DO 101 J=1,(N/2) V(1+(J-1)*2,1) = F1(1) 101 V(2+(J-1)*2,1) = F1(2) IF (K-P .LT. 2) GOTO 199 DO 102 J=1,(N/4) DO 102 I=1,4 102 V(I+(J-1)*4,2) = F2(I) IF (K-P .LT. 3) GOTO 199 DO 103 J=1,(N/8) DO 103 I=1,8 103 V(I+(J-1)*8,3) = F3(I) IF (K-P .LT. 4) GOTO 199 DO 104 J=1,(N/16) DO 104 I=1,16 104 V(I+(J-1)*16,4) = F4(I) IF (K-P .LT. 5) GOTO 199 DO 105 J=1,(N/32) DO 105 I=1,32 105 V(I+(J-1)*32,5) = F5(I) IF (K-P .LT. 6) GOTO 199 DO 106 J=1,(N/64) DO 106 I=1,64 106 V(I+(J-1)*64,6) = F6(I) C C Setting up the interaction columns C 199 COUNT = K-P+1 COUNT2 = 1 DO 201 I1=1,(K-P-1) DO 201 I2=I1+1,(K-P) DO 21 J=1,N 21 V(J,COUNT) = V(J,I1)*V(J,I2) A(COUNT2,1) = COUNT A(COUNT2,2) = I1 A(COUNT2,3) = I2 ACOUNT(COUNT2) = 3 COUNT2 = COUNT2+1 COUNT = COUNT+1 201 CONTINUE IF (K-P .LT. 3) GOTO 999 DO 202 I1=1,(K-P-2) DO 202 I2=I1+1,(K-P-1) DO 202 I3=I2+1,(K-P) DO 22 J=1,N 22 V(J,COUNT) = V(J,I1)*V(J,I2)*V(J,I3) A(COUNT2,1) = COUNT A(COUNT2,2) = I1 A(COUNT2,3) = I2 A(COUNT2,4) = I3 ACOUNT(COUNT2) = 4 COUNT2 = COUNT2+1 COUNT = COUNT+1 202 CONTINUE IF (K-P .LT. 4) GOTO 999 DO 203 I1=1,(K-P-3) DO 203 I2=I1+1,(K-P-2) DO 203 I3=I2+1,(K-P-1) DO 203 I4=I3+1,(K-P) DO 23 J=1,N 23 V(J,COUNT) = V(J,I1)*V(J,I2)*V(J,I3)*V(J,I4) A(COUNT2,1) = COUNT A(COUNT2,2) = I1 A(COUNT2,3) = I2 A(COUNT2,4) = I3 A(COUNT2,5) = I4 ACOUNT(COUNT2) = 5 COUNT2 = COUNT2+1 COUNT = COUNT+1 203 CONTINUE IF (K-P .LT. 5) GOTO 999 DO 204 I1=1,(K-P-4) DO 204 I2=I1+1,(K-P-3) DO 204 I3=I2+1,(K-P-2) DO 204 I4=I3+1,(K-P-1) DO 204 I5=I4+1,(K-P) DO 24 J=1,N 24 V(J,COUNT) = V(J,I1)*V(J,I2)*V(J,I3)*V(J,I4)*V(J,I5) A(COUNT2,1) = COUNT A(COUNT2,2) = I1 A(COUNT2,3) = I2 A(COUNT2,4) = I3 A(COUNT2,5) = I4 A(COUNT2,6) = I5 ACOUNT(COUNT2) = 6 COUNT = COUNT+1 COUNT2 = COUNT2+1 204 CONTINUE IF (K-P .LT. 6) GOTO 999 DO 205 I1=1,(K-P-5) DO 205 I2=I1+1,(K-P-4) DO 205 I3=I2+1,(K-P-3) DO 205 I4=I3+1,(K-P-2) DO 205 I5=I4+1,(K-P-1) DO 205 I6=I5+1,(K-P) DO 25 J=1,N 25 V(J,COUNT) = V(J,I1)*V(J,I2)*V(J,I3)*V(J,I4)*V(J,I5)*V(J,I6) A(COUNT2,1) = COUNT A(COUNT2,2) = I1 A(COUNT2,3) = I2 A(COUNT2,4) = I3 A(COUNT2,5) = I4 A(COUNT2,6) = I5 A(COUNT2,7) = I6 ACOUNT(COUNT2) = 7 COUNT = COUNT+1 COUNT2 = COUNT2+1 205 CONTINUE 999 RETURN END SUBROUTINE PRTMAT(R,C,M) * * This subroutine prints a rxc matrix up to 64x11 * IMPLICIT INTEGER (A-Z) INTEGER M(64,11) * * Printing out the matrix * WRITE(*,1002) 1002 FORMAT (/,' PRESCRIPTION FOR A 2**(K-P) DESIGN') WRITE(*,1001) (J,J=1,C) 1001 FORMAT (/,9X,24I3) DO 200 I=1,R 200 WRITE(*,1000) I,(M(I,J),J=1,C) 1000 FORMAT(' RUN ',I2,2X,24I3) RETURN END SUBROUTINE RES3(K,P,N,POINT) * * This subroutine determines the number of runs, i.e., minimal * fraction, necessary for a Resolution III design * IMPLICIT INTEGER (A-Z) POINT=0 DO 100 J=1,6 N=2**J IF (N-1 .GE. K) THEN P=K-J GOTO 999 END IF 100 CONTINUE WRITE(*,1003) N 1003 FORMAT ('1','RESOLUTION III DESIGN CANNOT BE MADE WITH LESS ', % 'THAN ',I3,' OBSERVATIONS') POINT=1 999 RETURN END SUBROUTINE RES4(K,P,N,POINT) * * This subroutine determines the number of runs, i.e., minimal * fraction, necessary for a Resolution IV design * IMPLICIT INTEGER (A-Z) POINT=0 DO 100 J=1,6 N=2**J IF (N-1 .GE. K-1) THEN N=N*2 P=K-J-1 GOTO 999 END IF 100 CONTINUE WRITE(*,1000) N 1000 FORMAT (/,' RESOLUTION IV DESIGN CANNOT BE MADE WITH LESS ', + 'THAN ',I3,' OBSERVATIONS') POINT=1 999 RETURN END SUBROUTINE RES5(K,P,N,RESV) IMPLICIT INTEGER (A-Z) DIMENSION CHOICE(10,2) * * This subroutine displays possible run sizes and resolution, * allowing the user to choose which to use. * DO 300 I=1,12 300 WRITE(*,*) WRITE(*,3000) 3000 FORMAT ( 1 /,10X,'FRACFACT now requires some additional information. The', 2 /,10X,'first is the maximum number of runs you may have in your', 3 /,10X,'experiment. FRACFACT allows up to 64 runs. Although the' 4,/,10X,'actual number of runs will be a power of 2, the inputted', 5 /,10X,'maximum need not be. Input the maximum number of runs by' 6,/,10X,'entering the appropriate integer and pressing RETURN.') DO 301 I=1,12 301 WRITE(*,*) WRITE(*,1000) 1000 FORMAT (/,' ENTER MAXIMUM NUMBER OF RUNS',/) READ(*,2000) MAXN 2000 FORMAT (I3) DO 302 I=1,12 302 WRITE(*,*) WRITE(*,3001) K 3001 FORMAT ( 1 /,10X,'Below FRACFACT has given a list of the possible designs', 2 /,10X,'with ',I2,' factors. Included below are the number of', 3 /,10X,'runs required for a particular design and the resolution', 4 /,10X,'of that design. Associated with each design is a number', 5 /,10X,'for purposes of identifying that design choice. Choose', 6 /,10X,'the desired design by entering the number corresponding', 7 /,10X,'to your choice of design and pressing RETURN.',/,/) CALL RESOL(K,MAXN,CHOICE) WRITE(*,1001) 1001 FORMAT (/,' WHICH OF THESE DESIGNS DO YOU CHOOSE TO ', + 'CONSTRUCT?',/) READ(*,2001) CHOOSE 2001 FORMAT (I1) N = CHOICE(CHOOSE,1) RESV = CHOICE(CHOOSE,2) DO 100 J=1,6 IF (N .EQ. 2**J) THEN P = K-J END IF 100 CONTINUE RETURN END SUBROUTINE RESOL(K,N,TEMP) * * This subroutine determines the resolution for various run * sizes at most equal to some inputted maximum number of runs. * Secondly, the choices are outputted for the user's perusal. * IMPLICIT INTEGER (A-Z) INTEGER RES3(7,2), RES4(11,2), RES5(2,2) INTEGER RES6(2), RES7(2) INTEGER TEMP(10,2) DATA RES3/ 3, 5, 6, 7, 9, 10, 11, 4, 8, 8, 8, 16, 16, 16/, 2 RES4/ 4, 6, 7, 7, 8, 8, 9, 9, 10, 11, 11, 3 8, 16, 16, 32, 16, 32, 32, 64, 32, 32, 64/, 4 RES5/ 5, 8, 16, 64/, 5 RES6/ 6, 32/, 6 RES7/ 7, 64/ * * Determining the resolution that can be obtained * with a given (maximum) number of runs * COUNT=0 DO 100 I=1,7 IF (RES3(I,1) .EQ. K .AND. RES3(I,2) .LE. N) THEN COUNT=COUNT+1 TEMP(COUNT,1) = RES3(I,2) TEMP(COUNT,2) = 3 END IF 100 CONTINUE DO 101 I=1,11 IF (RES4(I,1) .EQ. K .AND. RES4(I,2) .LE. N) THEN COUNT = COUNT+1 TEMP(COUNT,1) = RES4(I,2) TEMP(COUNT,2) = 4 END IF 101 CONTINUE DO 102 I=1,2 IF (RES5(I,1) .EQ. K .AND. RES5(I,2) .LE. N) THEN COUNT = COUNT+1 TEMP(COUNT,1) = RES5(I,2) TEMP(COUNT,2) = 5 END IF 102 CONTINUE IF (RES6(1) .EQ. K .AND. RES6(2) .LE. N) THEN COUNT = COUNT+1 TEMP(COUNT,1) = RES6(2) TEMP(COUNT,2) = 6 END IF IF (RES7(1) .EQ. K .AND. RES7(2) .LE. N) THEN COUNT = COUNT+1 TEMP(COUNT,1) = RES7(2) TEMP(COUNT,2) = 7 END IF * * Outputting possible resolution and run sizes * IF (COUNT .EQ. 0) THEN WRITE(*,1000) K,N 1000 FORMAT ('1CANNOT ACHIEVE RESOLUTION GREATER THAN TWO', + ' WITH ',I2,' FACTORS IN ',I3,' RUNS') ELSE WRITE(*,1001) DO 104 I=1,COUNT WRITE(*,1002) I, (TEMP(I,J),J=1,2) 1001 FORMAT (/,20X,'CHOICE',3X,'RUNS',3X,'RESOLUTION') 1002 FORMAT (/,22X,I2,6X,I2,9X,I3) 104 CONTINUE END IF RETURN END SUBROUTINE SIGN(K,P,N) * * This subroutine allows the user to change the signs of any * number of the columns in order to give another of the * possible fractions. * IMPLICIT INTEGER (A-Z) COMMON MOD(64,63), MODEL(64,11) DO 300 I=1,12 300 WRITE(*,*) WRITE(*,3000) K 3000 FORMAT ( 1 /,10X,'FRACFACT gives the user the option of changing the signs', 2 /,10X,'of any set of columns. This corresponds to choosing ', 3 /,10X,'another of the possible fractions of the full factorial', 4 /,10X,'in ',I2,' factors. This does not change the size or res-' 5,/,10X,'olution of the design, only the signs of the defining', 6 /,10X,'relation. (See the program guide, p. xx, for elaboration)' 7,/,10X,'If you do not wish to change the signs, enter 0 and press' 8,/,10X,'RETURN. Otherwise, enter the number of columns whose ', 9 /,10X,'are to be changed and press RETURN.',/) WRITE(*,1000) 1000 FORMAT (/,' DO YOU WANT TO CHANGE THE SIGNS OF ANY OF THE ', + 'COLUMNS?',/,' IF SO, ENTER THE NUMBER OF COLUMNS TO ', + 'BE CHANGED (0 if none to be changed):') READ(*,2000) NSIGN 2000 FORMAT (I2) IF (NSIGN .EQ. 0) GOTO 999 WRITE(*,3001) 3001 FORMAT (/, 1 /,10X,'The user must now choose which columns'' signs are to ', 2 /,10X,'be changed. This is achieved by responding to the', 3 /,10X,'prompt below each time by entering a column number and', 4 /,10X,'pressing RETURN.',/) DO 101 J=1,NSIGN WRITE(*,1001) 1001 FORMAT (/,' ENTER ONE COLUMN WHOSE SIGNS ARE TO BE CHANGED') READ(*,2001) CHANGE 2001 FORMAT (I2) DO 100 I=1,N 100 MODEL(I,CHANGE) = -MODEL(I,CHANGE) 101 CONTINUE CALL PRTMAT(N,K,MODEL) 999 RETURN END SUBROUTINE SUGGST(K,P,N,DROP) * * This subroutine gives the user some suggestions as to * which columns should be dropped to achieve the optimal * design (in terms of necessary generators) * IMPLICIT INTEGER (A-Z) DIMENSION DROP(56) DIMENSION COL8(3,4), COL16(7,8), COL32(6,7), COL64(5,6) DATA COL8/ 4, 5, 6, 4, 5, 7, 1 5, 6, 0, 6, 2*0/ DATA COL16/ 5, 6, 7, 8, 9, 10, 11, 1 15, 11, 11, 11, 11, 5, 5, 2 0, 14, 13, 12, 12, 11, 6, 3 2*0, 14, 13, 13, 12, 11, 4 3*0, 14, 14, 13, 12, 5 4*0, 15, 14, 13, 6 5*0, 15, 14, 6*0, 15/ DATA COL32/ 6, 7, 8, 9, 10, 11, 1 31, 26, 16, 27, 26, 19, 2 0, 28, 17, 28, 27, 19, 3 2*0, 30, 29, 28, 31, 4 3*0, 30, 29, 22, 5 4*0, 30, 24, 5*0, 25/ DATA COL64/ 7, 8, 9, 10, 11, 1 63, 42, 42, 43, 25, 2 0, 47, 50, 45, 38, 3 2*0, 56, 49, 42, 4 3*0, 53, 31, 4*0, 55/ IF (N .EQ. 8) THEN DO 101 I=1,3 IF (K .EQ. COL8(I,1)) THEN DO 100 J=1,N-K-1 100 DROP(J) = COL8(I,J+1) GOTO 999 END IF 101 CONTINUE ELSE IF (N .EQ. 16) THEN COUNT = 1 DO 104 I=1,7 IF (K .EQ. COL16(I,1)) THEN DO 103 J=K-P+1,N-1 DO 102 L=1,P IF (J .EQ. COL16(I,L+1)) GOTO 103 IF (L .NE. P) GOTO 102 DROP(COUNT) = J COUNT = COUNT+1 102 CONTINUE 103 CONTINUE END IF 104 CONTINUE ELSE IF (N .EQ. 32) THEN COUNT = 1 DO 107 I=1,6 IF (K .EQ. COL32(I,1)) THEN DO 106 J=K-P+1,N-1 DO 105 L=1,P IF (J .EQ. COL32(I,L+1)) GOTO 106 IF (L .NE. P) GOTO 105 DROP(COUNT) = J COUNT = COUNT+1 105 CONTINUE 106 CONTINUE END IF 107 CONTINUE ELSE COUNT = 1 DO 110 I=1,5 IF (K .EQ. COL64(I,1)) THEN DO 109 J=K-P+1,N-1 DO 108 L=1,P IF (J .EQ. COL64(I,L+1)) GOTO 109 IF (L .NE. P) GOTO 108 DROP(COUNT) = J COUNT = COUNT+1 108 CONTINUE 109 CONTINUE END IF 110 CONTINUE END IF 999 WRITE(*,1000) (DROP(J),J=1,N-K-1) 1000 FORMAT (/,' MAY I SUGGEST YOU DROP THE COLUMNS:',3(/,20I3)) RETURN END