PHOS/shaker/lorenb.f

   1       SUBROUTINE LORENB (U,PS,PI,PF)
   2 C
   3 C CERN PROGLIB# U102    LORENB          .VERSION KERNFOR  4.04  821124
   4 C ORIG. 20/08/75 L.PAPE
   5 C
   6       DOUBLE PRECISION PF4, FN
   7       DIMENSION      PS(4),PI(4),PF(4)
   8
   9       IF (PS(4).EQ.U) GO TO 17
  10       PF4  = (PI(4)*PS(4)+PI(3)*PS(3)+PI(2)*PS(2)+PI(1)*PS(1)) / U
  11       FN   = (PF4+PI(4)) / (PS(4)+U)
  12       PF(1)= PI(1) + FN*PS(1)
  13       PF(2)= PI(2) + FN*PS(2)
  14       PF(3)= PI(3) + FN*PS(3)
  15       PF(4)= PF4
  16       GO TO 18
  17 C
  18    17 PF(1)= PI(1)
  19       PF(2)= PI(2)
  20       PF(3)= PI(3)
  21       PF(4)= PI(4)
  22 C
  23    18 CONTINUE
  24 C
  25       RETURN
  26 C
  27       END