*********************************************************************** * SUBROUTINE MDCACC(U,V) * * * MODIFIED BY: H.NEUMANN 17/02/94 17.12.01 * * * *********************************************************************** IMPLICIT NONE INTEGER NU, NV, IDU, IDV, J PARAMETER(NU=16, NV=26) REAL U(NU), V(NV), DEG, XME REAL PXE, PYE, PZE, PTE2, PTE, PE2, PE, EE, PHE, THE REAL PXP, PYP, PZP, PTP2, PTP, PP2, PP, EP, PHP, THP REAL PX0, PY0, PZ0, PT02, PT0, P02, P0, E0, PH0, TH0 REAL XM02, XM0, Y0, ET02, ET0 DATA IDU, IDV/111, 100/ DATA XME /.511E-3/ DEG = 45./ATAN(1.) * PXE = U(1) PYE = U(2) PZE = U(3) PTE2 = PXE*PXE + PYE*PYE PTE = SQRT(PTE2) PE2 = PTE2 + PZE*PZE PE = SQRT(PE2) EE = SQRT(XME*XME + PE2) PHE = 0 IF (PTE.NE.0) PHE = ACOS(PXE/PTE)*SIGN(DEG,PYE) IF (PHE.LT.0) PHE = PHE + 360. THE = 0 IF (PE.NE.0) THE = ACOS(PZE/PE)*DEG PXP = U(9) PYP = U(10) PZP = U(11) PTP2 = PXP*PXP + PYP*PYP PTP = SQRT(PTP2) PP2 = PTP2 + PZP*PZP PP = SQRT(PP2) EP = SQRT(XME*XME + PP2) PHP = 0 IF (PTP.NE.0) PHP = ACOS(PXP/PTP)*SIGN(DEG,PYP) IF (PHP.LT.0) PHP = PHP + 360. THP = 0 IF (PP.NE.0) THP = ACOS(PZP/PP)*DEG PX0 = PXE + PXP PY0 = PYE + PYP PZ0 = PZE + PZP PT02 = PX0*PX0 + PY0*PY0 PT0 = SQRT(PT02) P02 = PT02 + PZ0*PZ0 P0 = SQRT(P02) E0 = EE + EP XM02 = E0*E0 - P02 XM0 = SQRT(XM02) Y0 = .5*LOG((E0+PZ0)/(E0-PZ0)) ET02 = XM02 + PT02 ET0 = SQRT(ET02) PH0 = 0 IF (PT0.NE.0) PH0 = ACOS(PX0/PT0)*SIGN(DEG,PY0) V(1) = PE V(2) = THE V(3) = PHE V(4) = PP V(5) = THP V(6) = PHP DO 10 J = 7, 11 10 V(J) = U(J-3) DO 20 J = 12, 16 20 V(J) = U(J) V(17) = PXE V(18) = PYE V(19) = PZE V(20) = PXP V(21) = PYP V(22) = PZP V(23) = XM0 V(24) = Y0 V(25) = P0 V(26) = PT0 RETURN END