	PROGRAM PARAMETER

*	This program creates the parameter input file for Program 
*	Multimix/Missing
*	Version 1.1A November 1996.

	CHARACTER *18	outfile, paramfile,ANS*1,AORD,ATYP
	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 ',I2,' 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 ',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,1X,I6,1X,I2,1X,I2,1X,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 ',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 ',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 ',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'
     : ,' 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'
     : ,' 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'
     : ,' 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'
     : ,' 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',
     : ' categories')
		END IF
	   END IF
713	CONTINUE
	RETURN
	END
