***********************************************************************;
*  Version 3.1 July 20, 1994                                          *;
***********************************************************************;
START _UNIREP_(U,
               _ECODE_,_EPSL_,_OPT_,_PARM_,
               _H_,_E_,_NROWC_,_NCOLU_,_THCNM_,
               _URESUL_,_UCOLNM_,_UROWNM_);
*___________________________________________________________________*
    Code to compute univariate repeated measures tests           
    Presumes results from TESTGLH unchanged.         
By default, U must be such that
            U = K # ( orthonormal matrix ).                      
            Here K is any nonzero constant.                   
            This is equivalent to requiring that the          
            inner product of U is I(NCOL(U))#(K##2).          
            If K=1, of course, U is orthonormal.              
            The test typically is a multivariate repeated
            measures test, involving at least one repeated      
*Inputs
          U,
          _ECODE_,_EPSL_,_OPT_,_PARM_,
          _H_,_E_,_NROWC_,_NCOLU_,_THCNM_,

Outputs   _URESUL_,_UCOLNM_,_UROWNM_
  *___________________________________________________________________*;

_ECODE_ (| 6 , 1 |) = 0;

IF _OPT_(|1,5|)=0 THEN PRINT "**************************************" ,
                             "**           BEGIN UNIREP           **" ,
                             "**************************************" ;
 
IF _ECODE_(| 5 , 1 |) > 0 THEN DO;
     PRINT  "No UNIREP tests due to previous error in TESTGLH" ;
     _ECODE_(|6,1|)=1001;
     RETURN;
     END;

IF (NROW(_H_)=0) | (NROW(_E_)=0)  THEN DO;
     NOTEU_1={"UNIREP terminating due to _H_ or _E_ undefined"};
     PRINT ,, NOTEU_1, ;
     _ECODE_(|6,1|)=1002;
     RETURN;
     END;

_NROWU_=NROW(U);

IF _NROWU_=0 THEN DO; *U=I;
   IF _OPT_(|6,3|) THEN IF _OPT_(|6,4|) THEN PRINT
                               "Warning:  UNIREP test forced with U=I";
                                        ELSE PRINT
                               "No UNIREP test if U=I and UNIFORC off";
   IF _OPT_(|6,4|) THEN       ;
                   ELSE RETURN;
   END;

IF _NROWU_>0 THEN DO; *U^=I;

   IF _NCOLU_>=_NROWU_ THEN DO;
      IF _OPT_(|6,3|) THEN IF _OPT_(|6,4|) THEN PRINT
                  "Warning:  UNIREP test forced with ncol(U)>=nrow(U)";
                                           ELSE PRINT
                  "No UNIREP test if ncol(U)>=nrow(U) and UNIFORC off";
      IF _OPT_(|6,4|) THEN       ;
                      ELSE RETURN;
      END;

   _UPUSCA_ = U` * U;
   IF _UPUSCA_(|1,1|)>_EPSL_ THEN _UPUSCA_=_UPUSCA_/_UPUSCA_(|1,1|);
   _UDIF_ = ABS( _UPUSCA_ - I( NCOL( U )));
   IF MAX(_UDIF_)>SQRT(_EPSL_) THEN DO;
      IF _OPT_(|6,3|) THEN PRINT ,,
          "U not proportional to an orthonormal matrix.               "
        , "Due either to programming error or to numerical inaccuracy."
        , "Try using UTRENDS, UPOLY1, or UPOLY2 (Ch 8, LINMOD manual)."
        , "Inner product not K # I(NCOL(U)), for a nonzero constant K."
        , "Inner product scaled so (1, 1) element = 1.0 (unless=0) is:"
        , _UPUSCA_ (|COLNAME=_THCNM_ ROWNAME=_THCNM_ &_FMT2_|) ;
      IF _OPT_(|6,4|)=0 THEN DO;
         IF _OPT_(|6,3|) THEN PRINT "No UNIREP tests";
         RETURN;
         END;
      END;
   END;

_TRCE_ = TRACE( _E_ );
_TRCH_ = TRACE( _H_ );
_UDF1_ = _NROWC_ # _NCOLU_;
_UDF2_ = _NCOLU_ # ( _PARM_(| 1 , 1 |) - _PARM_(| 1 , 3 |) );
_UFOBS_ = ( _TRCH_ / _UDF1_ ) / ( _TRCE_ / _UDF2_ );
_TRCE2_ = TRACE(_E_*_E_);
_EPSHAT_ = ( _TRCE_ # _TRCE_ ) / ( _NCOLU_ # _TRCE2_ );
_GDF1_ =_UDF1_ # _EPSHAT_;
_GDF2_ =_UDF2_ # _EPSHAT_;
_UFOBSP_ = {1} - PROBF(_UFOBS_, _UDF1_ , _UDF2_ );
_UFGGP_  = {1} - PROBF(_UFOBS_, _GDF1_ , _GDF2_ );
_UCOLNM_ = { "F   " "DF Numer" "DF Denom" "epslnHat" "p Value" };
_UROWNM_ = { "Uncrrctd" "Gsr Grnh" };
_URESUL_= (_UFOBS_||_UDF1_||_UDF2_||   {1}  ||_UFOBSP_ ) //
          (_UFOBS_||_GDF1_||_GDF2_||_EPSHAT_||_UFGGP_  )    ;

IF _OPT_(|6,2|)=1 THEN PRINT , "Univariate Repeated Measures Tests"
         , _URESUL_ (| COLNAME=_UCOLNM_ ROWNAME=_UROWNM_  &_FMT4_|);
FINISH _UNIREP_;