*
* $Id: tlor.F,v 1.1.1.1 1996/02/15 17:54:58 mclareni Exp $
*
* $Log: tlor.F,v $
* Revision 1.1.1.1  1996/02/15 17:54:58  mclareni
* Kernlib
*
*
#include "kerngent/pilot.h"
      SUBROUTINE TLOR

#include "kerngent/mkcde.inc"

      DIMENSION    P(4),PNEG(4),PLAB1(4),PLAB2(4),PNCM1(4),PNCM2(4)
      EQUIVALENCE (A(1),PNEG(1)), (A(11),PLAB1(1)), (A(15),PLAB2(1))
     +,           (A(21),PNCM1(1)), (A(25),PNCM2(1))
      DIMENSION    PCMVV(8),PCM1(4),PCM2(4)
      EQUIVALENCE (PCM1(1),PCMVV(1)),(PCM2(1),PCMVV(5))
      DIMENSION    PCHKVV(8),PCHK1(4),PCHK2(4)
      EQUIVALENCE (PCHK1(1),PCHKVV(1)),(PCHK2(1),PCHKVV(5))
      INTEGER      TINF(4),TINFF,TINFB
      REAL         M,M1,M2

      DATA  P     / 3000.,1000.,500.,0./
      DATA  PCM1  / 400.,300.,0.,100./
      DATA  PCM2  / -400.,-300.,0.,200./
      DATA  PCHK1 / 2830.74124, 1110.24708, 405.123540, 100./
      DATA  PCHK2 /  169.25876, -110.24708,  94.876460, 200./
      DATA   TINF / 1000, 4HLOR4, 0, 4H    /
     +,      TINFF /4HLORF/, TINFB /4HLORB/

C-     CONSERVE P   3000.0,  1000.0,  500.0  ----------

      CALL NEWGUY ('LOREN4-LORENF-LORENB.','TLOR    ')
      ZERLEV = ZEROV(5)

      ECM1 = VMOD (PCM1,4)
      ECM2 = VMOD (PCM2,4)
      M   = ECM1+ECM2
      P(4) = SQRT ( VDOT(P,P,3) + M*M)
      CALL VCOPYN (P,PNEG,3)
      PNEG(4)= P(4)

C--   CHECK OF ROUTINE LOREN4
      M1=PCM1(4)
      M2=PCM2(4)
      PCM1(4)=ECM1
      PCM2(4)=ECM2
      CALL LOREN4 (PNEG,PCM1,PLAB1)
      CALL LOREN4 (PNEG,PCM2,PLAB2)
      CALL LOREN4 (P,PLAB1,PNCM1)
      CALL LOREN4 (P,PLAB2,PNCM2)
      PLAB1(4)=SQRT (-DOTI (PLAB1,PLAB1))
      PLAB2(4)=SQRT (-DOTI (PLAB2,PLAB2))
      PNCM1(4)=SQRT (-DOTI (PNCM1,PNCM1))
      PNCM2(4)=SQRT (-DOTI (PNCM2,PNCM2))
      PCM1(4)=M1
      PCM2(4)=M2
      CALL MVERIF (3,PLAB1,PCHK1,8)
      CALL MVERIF (4,PNCM1,PCM1,8)

C--   CHECK OF ROUTINE LORENF
      PCM1(4)= ECM1
      PCM2(4)= ECM2
      CALL LORENF (M,PNEG,PCM1,PLAB1)
      CALL LORENF (M,PNEG,PCM2,PLAB2)
      CALL LORENF (M,P,PLAB1,PNCM1)
      CALL LORENF (M,P,PLAB2,PNCM2)
      PLAB1(4)= SQRT (-DOTI (PLAB1,PLAB1))
      PLAB2(4)= SQRT (-DOTI (PLAB2,PLAB2))
      PNCM1(4)= SQRT (-DOTI (PNCM1,PNCM1))
      PNCM2(4)= SQRT (-DOTI (PNCM2,PNCM2))
      PCM1(4)= M1
      PCM2(4)= M2
      CALL MVERIF (7,PLAB1,PCHK1,8)
      CALL MVERIF (8,PNCM1,PCM1 ,8)

C--   CHECK OF ROUTINE LORENB
      PCM1(4)= ECM1
      PCM2(4)= ECM2
      CALL LORENB (M,P,PCM1,PLAB1)
      CALL LORENB (M,P,PCM2,PLAB2)
      CALL LORENB (M,PNEG,PLAB1,PNCM1)
      CALL LORENB (M,PNEG,PLAB2,PNCM2)
      PLAB1(4)= SQRT (-DOTI (PLAB1,PLAB1))
      PLAB2(4)= SQRT (-DOTI (PLAB2,PLAB2))
      PNCM1(4)= SQRT (-DOTI (PNCM1,PNCM1))
      PNCM2(4)= SQRT (-DOTI (PNCM2,PNCM2))
      PCM1(4)= M1
      PCM2(4)= M2
      CALL MVERIF (9 ,PLAB1,PCHK1,8)
      CALL MVERIF (10,PNCM1,PCM1 ,8)


C--      TIMING
      IF (ITIMES.EQ.0) RETURN
      NTIMES = ITIMES*TINF(1)
      TINF(1) = NTIMES
      CALL TIMED (TIMERD)
         DO 180 J=1,NTIMES
  180 CALL LOREN4 (P,PCM1,PLAB1)
      CALL TIMING (TINF)

      TINF(2)= TINFF
      CALL TIMED (TIMERD)
      DO 380 J=1,NTIMES
  380 CALL LORENF (M,P,PCM1,PLAB1)

      CALL TIMING (TINF)
      TINF(2)= TINFB
      DO 480 J= 1,NTIMES
  480 CALL LORENB (M,PNEG,PCM1,PLAB1)
      CALL TIMING (TINF)
      RETURN
      END