MODULE CODE9
USE CODE7, ONLY : MATINV,COLINEAR,PERFECT_PREDICT_PROBIT
USE CODE6
IMPLICIT NONE

TYPE normalization
REAL(8), POINTER :: zo_f(:) 
REAL(8), POINTER :: zo_s(:) 
REAL(8), POINTER :: v(:)   	
INTEGER, POINTER :: i_f(:)	
INTEGER :: i_s			
LOGICAL :: l_f				
LOGICAL :: l_s			
INTEGER :: k_f			
end type normalization

TYPE LINEAR_FACTOR_EQUATION
INTEGER, POINTER :: icol(:)	
REAL(8), POINTER :: m(:)	
INTEGER, POINTER :: i(:)		
REAL(8), POINTER :: X(:,:)		
REAL(8), POINTER :: iXX(:,:)
REAL(8), POINTER :: Y(:)		
REAL(8), POINTER :: f(:,:)	
REAL(8), POINTER :: iff(:,:)
REAL(8), POINTER :: f_f(:,:)	
REAL(8), POINTER :: f_s(:)	
REAL(8), POINTER :: X_all(:,:)	
REAL(8), POINTER :: Y_all(:)
REAL(8), POINTER :: Yq(:)	
REAL(8), POINTER :: a(:)		
REAL(8), POINTER :: b(:)
REAL(8) :: t				
TYPE(normalization) :: nor	
INTEGER :: k				
INTEGER :: Ii				
INTEGER :: Hh				
INTEGER :: file					
LOGICAL :: l_t				
REAL(8), POINTER :: Xmix(:,:)	
INTEGER, POINTER :: coun(:)	
!!!!!!!!!!!!!! 
INTEGER, POINTER :: d(:)	
LOGICAL :: drop_perfect_predict=.FALSE. 
INTEGER :: loc_constant		
END TYPE LINEAR_FACTOR_EQUATION


TYPE PROBIT
REAL(8), POINTER :: d(:)	! choice indicator
TYPE(LINEAR_FACTOR_EQUATION) :: eq
END TYPE PROBIT


CONTAINS

SUBROUTINE norma(this,Hh,v1,v2)
IMPLICIT NONE	
TYPE(normalization), INTENT(INOUT) :: this
INTEGER, INTENT(IN) :: Hh
REAL(8), INTENT(IN) :: v2(Hh)
REAL(8), INTENT(IN) :: v1(Hh)
INTEGER :: v3(Hh),h
this%k_f=0
DO h = 1, Hh
	IF (v1(h)==0.0d0) THEN
		this%k_f = this%k_f + 1	
		v3(this%k_f) = h
	END IF
	IF (v1(h)==2.0d0) THEN
		this%i_s = h
	END IF		
END DO
ALLOCATE(this%zo_f(Hh),this%zo_s(Hh),this%v(Hh),this%i_f(this%k_f))
this%zo_f = 0.0d0
WHERE(v1>0.0d0) this%zo_f = 1.0d0
this%zo_s = 1.0d0
WHERE(v1==2.0d0) this%zo_s = 0.0d0
this%v = v2
this%i_f = v3(1:this%k_f)	
this%l_f = COUNT(v1==0.0d0).ne.0
this%l_s = COUNT(v1==2.0d0).ne.0
IF (count(v1==2.0d0)>1) THEN
	WRITE(*,*) 'Only one loading can be normalized to be positive per equation'
	STOP
END IF
END SUBROUTINE norma

SUBROUTINE elements_linear(this,dataset,nv,Hh,Ii,l_x,l_w,l_m,la,counter)
IMPLICIT NONE
TYPE(linear_factor_equation), INTENT(INOUT) :: this
INTEGER, INTENT(IN) :: Hh,Ii,l_w,l_x(:),l_m,nv,counter
REAL(8), INTENT(IN) :: dataset(Ii,nv)
LOGICAL, INTENT(IN) :: la
INTEGER :: i
REAL(8) :: tol
INTEGER :: ranko,inc
ALLOCATE(this%m(Ii),this%a(Hh))
this%Hh = Hh
this%m = 1.0d0
IF (la) this%m = dataset(:,l_m)
this%Ii=0
i = SUM(this%m)
ALLOCATE(this%i(i))
DO i = 1, Ii
	IF (this%m(i)==1.0d0) THEN
		this%Ii = this%Ii + 1
		this%i(this%Ii) = i
	ENDIF
END DO
ALLOCATE(this%x(this%Ii,this%k),this%icol(this%k))
this%x = dataset(this%i,l_x)
CALL COLINEAR(this%x,this%icol,inc)
IF (inc<this%k) this%k=inc
DEALLOCATE(this%x)
ALLOCATE(this%x(this%Ii,this%k),this%y(this%Ii),this%f(this%Ii,Hh),this%f_f(this%Ii,this%nor%k_f), &
	this%yq(this%Ii),this%x_all(Ii,this%k),this%y_all(Ii),this%iXX(this%k,this%k), &
	this%f_s(this%Ii),this%b(this%k),this%d(this%Ii),this%xmix(this%Ii,this%k))
this%x_all = dataset(:,l_x(this%icol(1:inc)))
this%x = dataset(this%i,l_x(this%icol(1:inc)))
this%y_all = dataset(:,l_w)
this%y = dataset(this%i,l_w)
ALLOCATE(this%coun(this%Hh))
	this%iXX = MATMUL(TRANSPOSE(this%X),this%X)
	this%iXX = MATINV(this%iXX) 
this%file = counter
END SUBROUTINE elements_linear

SUBROUTINE elements_multi(this,dataset,nv,Hh,Ii,l_x,l_m,la,counter,l_d)
IMPLICIT NONE
TYPE(linear_factor_equation), INTENT(INOUT) :: this
INTEGER, INTENT(IN) :: Hh,Ii,l_m,nv,counter,l_d
REAL(8), INTENT(IN) :: dataset(Ii,nv)
LOGICAL, INTENT(IN) :: la
INTEGER, INTENT(INOUT) :: l_x(:)
INTEGER :: i
REAL(8) :: tol
INTEGER :: inc
REAL(8), ALLOCATABLE :: aux(:) 
ALLOCATE(this%m(Ii),this%a(Hh))
this%Hh = Hh
this%m = 1.0d0
IF (la) this%m = dataset(:,l_m)
this%Ii=0
i = SUM(this%m)
ALLOCATE(this%i(i))
DO i = 1, Ii
	IF (this%m(i)==1.0d0) THEN
		this%Ii = this%Ii + 1
		this%i(this%Ii) = i
	ENDIF
END DO
ALLOCATE(this%x(this%Ii,this%k),this%icol(this%k))
this%x = dataset(this%i,l_x)
IF (this%drop_perfect_predict) THEN
	ALLOCATE(aux(this%Ii))
	aux = dataset(this%i,l_d)
	CALL PERFECT_PREDICT_PROBIT(aux,this%x,this%loc_constant,this%icol,inc)
	IF (inc<this%k) this%k=inc
	DEALLOCATE(this%x)
	ALLOCATE(this%x(this%Ii,this%k))
	DEALLOCATE(aux)
	l_x(1:inc) = l_x(this%icol(1:inc))
	this%x = dataset(this%i,l_x(1:inc))
END IF
CALL COLINEAR(this%x,this%icol,inc)
IF (inc<this%k) this%k=inc
DEALLOCATE(this%x)
ALLOCATE(this%x(this%Ii,this%k),this%y(this%Ii),this%f(this%Ii,Hh),this%f_f(this%Ii,this%nor%k_f), &
	this%yq(this%Ii),this%x_all(Ii,this%k),this%y_all(Ii),this%iXX(this%k,this%k), &
	this%f_s(this%Ii),this%b(this%k),this%xmix(this%Ii,this%k))
this%x_all = dataset(:,l_x(this%icol(1:inc)))
this%x = dataset(this%i,l_x(this%icol(1:inc)))
ALLOCATE(this%coun(this%Hh))
	this%iXX = MATMUL(TRANSPOSE(this%X),this%X)
	this%iXX = MATINV(this%iXX) 
this%file = counter
END SUBROUTINE elements_multi

END MODULE CODE9
