PROGRAM PARAMETER * This program creates the parameter input file for Program * Multimix/Missing * Version 1.1A November 1996. CHARACTER *18 outfile, paramfile,ANS*1 PARAMETER (ik6=6,ip15=60,im10=10,iob=20000) DIMENSION JP(ip15),IP(ip15),IPC(ip15),ISV(ip15),IEV(ip15), : IPARTYPE(ip15),IVARTYPE(ip15),NCAT(ip15),PI(ik6),IGRP(iob), : THETA(ik6,ip15,im10),EMU(ik6,ip15,ip15),IM(ip15), : EMUL(ik6,ip15,ip15,im10),VARIX(ik6,ip15,ip15,ip15) print *, ' CREATE A PARAMETER FILE FOR PROGRAM MULTIMIX / MISSING' print *, ' ------------------------------------------' print *,' ' print *, ' Name of parameter file:' READ (*,10) outfile 10 FORMAT(a18) OPEN (7, FILE=outfile, STATUS='NEW') print *, ' Number of groups to be fitted:' READ *, NG print *, ' Number of individuals:' READ *, NOBS print *, ' Total number of attributes:' READ *, NVAR print *, ' Number of partitions:' READ *, NPAR print *,' Value for ISPEC' print *, ' (ISPEC=1 - estimates of the parameters are to be input' print *, ' ISPEC=2 - specified grouping of individuals)' READ *, ISPEC PRINT *, 'Do attributes require reordering?' PRINT *, ' Input y = yes or n = no' READ (*, 71) AORD 71 FORMAT (A1) IF ((AORD.EQ.'y').OR.(AORD.EQ.'Y')) THEN print *,' Column in data array in which attributes are to' : ,' be stored' DO 12 J=1,NVAR print 13,J 13 format (' attribute ',I2,':') READ *, JP(J) 12 CONTINUE ELSE DO 70 J=1,NVAR JP(J) = J 70 CONTINUE END IF * Model of complete local independence IF (NPAR.EQ.NVAR) THEN DO 15 L=1,NPAR IP(L) = 1 ISV(L) = L IEV(L) = L 15 CONTINUE * For other models, number of attributes is initially set to one * The user then identifies those partitions having more than one attribute ELSE PRINT *,' ' PRINT *,' ' PRINT *, 'Number of attributes in each partition:' print *, ' ------------------------------------------' PRINT *,' ' PRINT *,'How many partitions have MORE THAN ONE attribute?:' READ *, INUM DO 16 L=1,NPAR IP(L)=1 16 CONTINUE print *, ' ------------------------------------------' PRINT *,' ' PRINT *,'Identify partitions having MORE THAN ONE attribute' PRINT *,' ' PRINT *,'Using one line per partition, enter partition number,' PRINT *,'followed by a space, no. of variables for that partition' PRINT *,' ' PRINT *,'Repeat for each partition having MORE THAN ONE attribute' PRINT *,' ' print *, ' ------------------------------------------' DO 9 I1=1,INUM READ *, JPAR, IP(JPAR) 9 CONTINUE * Create ISV(L) and IEV(L) from values of IP(L) DO 21 L=1,NPAR IF (L.EQ.1) THEN ISV(L) = 1 ELSE ISV(L) = IEV(L-1) + 1 END IF IEV(L) = ISV(L) + IP(L) - 1 21 CONTINUE * PRINT 20,L *20 format( ' Partition',X,I2,X,'starts at variable:') * READ *, ISV(L) * PRINT 22 *22 format(16X,'ends at variable:') * READ *, IEV(L) END IF PRINT *, ' Type of model for each partition cell:' PRINT *, ' Same type of model for each partition cell?' PRINT *, ' Input y = yes or n = no' READ (*, 74) ATYP 74 FORMAT (A1) IF ((ATYP.EQ.'y').OR.(ATYP.EQ.'Y')) THEN PRINT *, ' Input model type for partition cells' PRINT *, ' 1 = latent class, 2 = multivariate normal' : ,' 3 = location model' READ (*,72) IPAR 72 FORMAT(I1) DO 73 L=1,NPAR IPARTYPE(L)= IPAR 73 CONTINUE ELSE PRINT *, ' 1 = latent class, 2 = multivariate normal', : ' 3 = location model' DO 24 L=1,NPAR PRINT 17, L 17 FORMAT(' PARTITION',X,I2,':') READ *, IPARTYPE(L) 24 CONTINUE END IF * Create IPC(L), the number of continuous attributes in each * partition. Note that if a location model is specified, only * one categorical attribute can be present. DO 19 L=1,NPAR IF (IPARTYPE(L).EQ.1) THEN IPC(L)=0 ELSE IF(IPARTYPE(L).EQ.2) THEN IPC(L)=IP(L) ELSE IF(IPARTYPE(L).EQ.3) THEN IPC(L)=IP(L)-1 END IF 19 CONTINUE * Write out the values to the parameter file WRITE(7,11) NG,NOBS,NVAR,NPAR,ISPEC 11 FORMAT(I2,X,I6,X,I2,X,I2,X,I1) WRITE(7,18)(JP(J),J=1,NVAR) 18 FORMAT(2X,10I4) WRITE(7,18) (IP(L),L=1,NPAR) WRITE(7,18) (IPC(L),L=1,NPAR) WRITE(7,23)(ISV(L),L=1,NPAR) WRITE(7,23)(IEV(L),L=1,NPAR) WRITE(7,23)(IPARTYPE(L),L=1,NPAR) 23 FORMAT(2X,10I4) * Create the type of attribute from the model specified. * For the location model, the program checks for the categorical * attribute. DO 57 L=1,NPAR IF (IPARTYPE(L).EQ.1) THEN DO 58 J=ISV(L),IEV(L) IVARTYPE(J)=1 58 CONTINUE ELSE IF(IPARTYPE(L).EQ.2) THEN DO 59 J=ISV(L),IEV(L) IVARTYPE(J)=2 59 CONTINUE ELSE IF (IPARTYPE(L).EQ.3) THEN PRINT 60,L 60 FORMAT(' Location model for partition',I2) PRINT *,' Input y for yes, n for no' DO 61 J=ISV(L),IEV(L) PRINT 62,J 62 FORMAT(' Is attribute ',I2,' categorical?') READ (*,63) ANS 63 FORMAT(A1) IF((ANS.EQ.'y').OR.(ANS.EQ.'Y')) THEN IVARTYPE(J)=3 ELSE IF((ANS.EQ.'n').OR.(ANS.EQ.'N')) THEN IVARTYPE(J)=4 ELSE IVARTYPE(J)=9 END IF 61 CONTINUE END IF 57 CONTINUE WRITE(7,27)(IVARTYPE(J),J=1,NVAR) 27 FORMAT(2X,10I4) DO 28 J=1,NVAR IF (IVARTYPE(J).EQ.1) THEN PRINT 26,J 26 FORMAT(' Number of categories for attribute',X,I2,':') READ *, NCAT(J) ELSE IF (IVARTYPE(J).EQ.3) THEN PRINT *,'(Categorical attribute in location model)' PRINT 66,J 66 FORMAT(' Number of categories for attribute',X,I2,':') READ *,NCAT(J) ELSE NCAT(J)=0 END IF 28 CONTINUE WRITE(7,27)(NCAT(J),J=1,NVAR) IER = 0 CALL ERROR(NVAR,NPAR,ISPEC,IP,IPC,IPARTYPE,IVARTYPE,ISV,IEV,NCAT, : IER) IF(IER.EQ.1) THEN PRINT *, ' ERROR IN INPUT VALUES, CHECK OUTFILE' STOP END IF * Read in the parameters for the distribution. * First, the mixing proportions.A check is made that the inputed * values sum to 1. IF(ISPEC.EQ.1) THEN print *, ' Mixing proportions for each group:' SUMPI=0.0 TOL=0.000001 DO 30 K=1,NG print 31, K 31 FORMAT( ' Group',X,I2,':') READ *, PI(K) SUMPI=SUMPI+PI(K) 30 CONTINUE IF(ABS(SUMPI-1).LT.TOL) THEN WRITE(7,32)(PI(K),K=1,NG) 32 FORMAT(30F8.4) ELSE PRINT *,' -----------------------------------' PRINT *, ' **** ERROR, CONTINUE INPUT, BUT ' PRINT *, ' CHECK OUTFILE & CORRECT PI(K)' PRINT *,' SUM PI(K) NOT EQUAL TO 1 *****' PRINT *,' -----------------------------------' WRITE(7,53)(PI(K),K=1,NG) 53 FORMAT(' ----PI(K) ERROR',10F7.4) END IF PRINT *,'---------------------------------------------------' print *, ' Estimates of the parameters for the distributions' DO 33 K=1,NG PRINT *,' ---------------------------------------------------' PRINT *, ' GROUP',K PRINT *, ' -----------------' DO 33 L=1,NPAR print 36,L 36 FORMAT(' Partition ',I2) IF (IPARTYPE(L).EQ.1) THEN PRINT *, 'Input the level probabilities separated ' : ,'by a space' DO 34 J=ISV(L),IEV(L) PRINT 35,J,NCAT(J) 35 FORMAT(' For attribute ',I2,' the probabilities' : X,'for',I2,' levels:') READ *, (THETA(K,J,M),M=1,NCAT(J)) SUMTHETA=0.0 DO 54 M=1,NCAT(J) SUMTHETA=SUMTHETA+THETA(K,J,M) 54 CONTINUE IF (ABS(SUMTHETA-1).LT.TOL) THEN WRITE(7,37)(THETA(K,J,M),M=1,NCAT(J)) 37 FORMAT(30F9.6) ELSE PRINT *,' ---------------------------------' PRINT *, ' ***ERROR. CONTINUE INPUT, BUT' PRINT *, ' CHECK OUTFILE & CORRECT THETA ***' PRINT 56,J 56 FORMAT(' FOR VARIABLE',I2,' SUM THETA NOT' : ,' EQUAL TO 1') PRINT *,' -----------------------------------' WRITE(7,55)(THETA(K,J,M),M=1,NCAT(J)) 55 FORMAT(' ----THETA ERROR',4F7.4) END IF 34 CONTINUE ELSE IF(IPARTYPE(L).EQ.2) THEN PRINT *, 'Input the means for each partition separated' : ,' by a space' PRINT 51,IPC(L) 51 FORMAT (' the mean for ',I2,' attributes:') READ *, (EMU(K,L,J),J=1,IPC(L)) WRITE(7,38)(EMU(K,L,J),J=1,IPC(L)) 38 FORMAT(30F11.5) ELSE IF(IPARTYPE(L).EQ.3) THEN PRINT *, 'Input values separated by a space' DO 39 J=ISV(L),IEV(L) IF(IVARTYPE(J).EQ.3) THEN PRINT *,' LOCATION MODEL PARAMETERS:' PRINT 40,J,NCAT(J) 40 FORMAT(' For attribute ',I2,' the probabilities' : ,' for ',I2,' levels :') READ *, (THETA(K,J,M),M=1,NCAT(J)) IM(L)=NCAT(J) SUMTHETA2=0.0 DO 64 M=1,NCAT(J) SUMTHETA2=SUMTHETA2+THETA(K,J,M) 64 CONTINUE IF (ABS(SUMTHETA2-1).LT.TOL) THEN WRITE(7,65)(THETA(K,J,M),M=1,NCAT(J)) 65 FORMAT(30F9.6) ELSE PRINT *,' ---------------------------------' PRINT *, ' ***ERROR, CONTINUE INPUT, BUT' PRINT *, ' CHECK OUTFILE & CORRECT THETA***' PRINT 56,J PRINT *,' ---------------------------------' WRITE(7,55)(THETA(K,J,M),M=1,NCAT(J)) END IF END IF 39 CONTINUE J1=0 DO 41 J=ISV(L),IEV(L) IF(IVARTYPE(J).EQ.4) THEN J1=J1+1 PRINT 42,J,IM(L) 42 FORMAT(' For attribute ',I2,' the mean for ',I2, : ' levels:') READ *, (EMUL(K,L,J1,M),M=1,IM(L)) END IF 41 CONTINUE J2=0 DO 43 J=ISV(L),IEV(L) IF (IVARTYPE(J).EQ.4) THEN J2=J2+1 WRITE(7,38) (EMUL(K,L,J2,M),M=1,IM(L)) END IF 43 CONTINUE END IF 33 CONTINUE PRINT *,' ------------------------------' PRINT *,' Input the covariance matrices by row' DO 44 K=1,NG DO 44 L=1,NPAR IF(IPARTYPE(L).NE.1) THEN PRINT 45,K,L 45 FORMAT(' GROUP',I2,' PARTITION ',I2) PRINT 52,IPC(L),IPC(L) 52 FORMAT(' Input (',I2,' x',I2,' ) covariance matrix:') READ *, ((VARIX(K,L,I,J),J=1,IPC(L)),I=1,IPC(L)) DO 50 I=1,IPC(L) WRITE(7,49)(VARIX(K,L,I,J),J=1,IPC(L)) 49 FORMAT(30F12.4) 50 CONTINUE END IF 44 CONTINUE ELSE IF (ISPEC.EQ.2) THEN PRINT *, ' Filename in which grouping is stored:' READ (*,46) paramfile 46 FORMAT(A18) OPEN (8, FILE=paramfile, STATUS='OLD') DO 47 I=1,NOBS READ(8,*) IGRP(I) 47 CONTINUE WRITE(7,48)(IGRP(I),I=1,NOBS) 48 FORMAT(I3) END IF END * This subroutine checks for errors in the input parameter file. * It checks that the numbers of attributes specified by NVAR, IPC(L), * and IP(L) match, the types of attributes match with the type of * partition SUBROUTINE ERROR(NVAR,NPAR,ISPEC,IP,IPC,IPAR,IVAR,ISV,IEV,NCAT, : IER) PARAMETER(ip15=100) DIMENSION IP(ip15),IPC(ip15),NUM(ip15),ISV(ip15),IEV(ip15), : IPAR(ip15),IVAR(ip15),NCAT(ip15) IER=0 IF(NVAR.LT.NPAR) THEN IER=1 WRITE(7,700) 700 FORMAT(' Number of attributes cannot be less than number of' : ,X,'partitions') END IF IF ((ISPEC.NE.1).AND.(ISPEC.NE.2)) THEN IER=1 WRITE(7,702) 702 FORMAT(' Value of ISPEC not permitted. {ISPEC=1 or 2}') END IF ISUMVAR=0 DO 701 L=1,NPAR ISUMVAR=ISUMVAR+IP(L) 701 CONTINUE IF(ISUMVAR.NE.NVAR) THEN IER=1 WRITE(7,703) 703 FORMAT(' Sum of attributes in partitions not equal to the' : ,' total number of attributes') END IF DO 704 L=1,NPAR IF(IPC(L).GT.IP(L)) THEN IER=1 WRITE(7,705) 705 FORMAT(' Number of continuous attributes greater than the' : ,X,'number of attributes in a partition') END IF NUM(L) = IEV(L) - ISV(L) + 1 IF (NUM(L).NE.IP(L)) THEN IER=1 WRITE(7,706) 706 FORMAT(' Number of attributes does not match with ISV & IEV') END IF IF((IPAR(L).GT.3).OR.(IPAR(L).LT.1)) THEN IER=1 WRITE(7,707) 707 FORMAT(' Value of IPARTYPE not permitted') END IF IF(IPAR(L).EQ.1) THEN DO 708 J=ISV(L),IEV(L) IF(IVAR(J).NE.1) THEN IER=1 WRITE(7,709) 709 FORMAT(' Partition and attribute type do not match') END IF 708 CONTINUE ELSE IF (IPAR(L).EQ.2) THEN DO 710 J=ISV(L),IEV(L) IF(IVAR(J).NE.2) THEN PRINT *, ' HERE 2' PRINT *, 'IPAR',IPAR(L),'VAR',J,'IVAR',IVAR(J) IER=1 WRITE(7,709) END IF 710 CONTINUE ELSE IF (IPAR(L).EQ.3) THEN ICOUNT=0 DO 711 J=ISV(L),IEV(L) IF ((IVAR(J).NE.3).AND.(IVAR(J).NE.4)) THEN IER=1 WRITE(7,709) END IF IF(IVAR(J).EQ.3) ICOUNT=ICOUNT+1 711 CONTINUE IF (ICOUNT.GT.1) THEN IER=1 WRITE(7,712) 712 FORMAT(' Location model restriced to 1 categorical' : ,X,'attribute') END IF END IF 704 CONTINUE DO 713 J=1,NVAR IF ((IVAR(J).EQ.2).OR.(IVAR(J).EQ.4)) THEN IF (NCAT(J).NE.0)THEN WRITE(7,714) 714 FORMAT(' Input continuous attributes with 0', : X,'categories') END IF END IF 713 CONTINUE RETURN END