Télécharger la plaquette Cast3M


fr en

Télécharger j3copl.eso

Retour à la liste

Numérotation des lignes : 

j3copl

  1. C J3COPL    SOURCE    CHAT      05/01/13    00:46:07     5004
  2.       SUBROUTINE J3COPL(WWORK1,WWORK2,LPLAN,TOL)
  3. C----------------------------------------------------
  4. C     LES FACES WWORK1 ET WWORK2 SONT-ELLES COPLANAIRES?
  5. C               SI OUI, ON EN MET UNE DANS LE REPERE DE L'AUTRE
  6. C
  7. C     PP 9/97
  8. C     Pierre Pegon/JRC Ispra
  9. C----------------------------------------------------
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12. C
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. C
  16.       SEGMENT WWORK
  17.         REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
  18.         INTEGER FWORK
  19.         INTEGER TWORK(NTROU)
  20.       ENDSEGMENT
  21.       POINTEUR WWORK1.WWORK,WWORK2.WWORK
  22. C
  23.       SEGMENT WORK
  24.         REAL*8 XYC(2,NPTO)
  25.         INTEGER IST(3,NPTO)
  26.         REAL*8 DENS(NPTO)
  27.         INTEGER JUN
  28.       ENDSEGMENT
  29.       LOGICAL LPLAN
  30. C
  31. C     ON VERIFIE QUE LES NORMALES SONT COPLANAIRES
  32. C
  33.       XPMIX=(WWORK1.VNORM(2)*WWORK2.VNORM(3)
  34.      >      -WWORK1.VNORM(3)*WWORK2.VNORM(2))**2
  35.      >     +(WWORK1.VNORM(3)*WWORK2.VNORM(1)
  36.      >      -WWORK1.VNORM(1)*WWORK2.VNORM(3))**2
  37.      >     +(WWORK1.VNORM(1)*WWORK2.VNORM(2)
  38.      >      -WWORK1.VNORM(2)*WWORK2.VNORM(1))**2
  39.       XPMIX=SQRT(XPMIX)
  40.       LPLAN=XPMIX.LT.TOL
  41.       IF(.NOT.LPLAN)RETURN
  42. C
  43. C     ON VERIFIE QUE L'ORIGINE DU SECOND PLAN EST SUR LE PREMIER
  44. C
  45.       XDIST=WWORK1.VNORM(1)*(WWORK2.PORIG(1)-WWORK1.PORIG(1))
  46.      >     +WWORK1.VNORM(2)*(WWORK2.PORIG(2)-WWORK1.PORIG(2))
  47.      >     +WWORK1.VNORM(3)*(WWORK2.PORIG(3)-WWORK1.PORIG(3))
  48.       LPLAN=ABS(XDIST).LT.TOL
  49.       IF(.NOT.LPLAN)RETURN
  50. C
  51. C     ON CHANGE LE HEADER DE WWORK2 AINSI QUE LE SYSTEME DE COORDONNEES
  52. C
  53.       XSCAL=WWORK1.VNORM(1)*WWORK2.VNORM(1)
  54.      >     +WWORK1.VNORM(2)*WWORK2.VNORM(2)
  55.      >     +WWORK1.VNORM(3)*WWORK2.VNORM(3)
  56.       ISI=INT(SIGN(1.D0,XSCAL))
  57. C
  58.       X12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VI(1)
  59.      >   +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VI(2)
  60.      >   +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VI(3)
  61.       Y12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VJ(1)
  62.      >   +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VJ(2)
  63.      >   +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VJ(3)
  64. C
  65.       A=WWORK2.VI(1)*WWORK1.VI(1)+WWORK2.VI(2)*WWORK1.VI(2)
  66.      >                           +WWORK2.VI(3)*WWORK1.VI(3)
  67.       B=WWORK2.VI(1)*WWORK1.VJ(1)+WWORK2.VI(2)*WWORK1.VJ(2)
  68.      >                           +WWORK2.VI(3)*WWORK1.VJ(3)
  69. C
  70.       DO IE1=1,3
  71.         WWORK2.PORIG(IE1)=WWORK1.PORIG(IE1)
  72.         WWORK2.VNORM(IE1)=WWORK1.VNORM(IE1)
  73.         WWORK2.VI(IE1)=WWORK1.VI(IE1)
  74.         WWORK2.VJ(IE1)=WWORK1.VJ(IE1)
  75.       ENDDO
  76. C
  77.       WWORK=WWORK2
  78.       DO IE1=1,1+TWORK(/1)
  79.         IF(IE1.EQ.1)THEN
  80.           WORK=FWORK
  81.         ELSE
  82.           WORK=TWORK(IE1-1)
  83.         ENDIF
  84.         NPTO=DENS(/1)
  85.         DO IE2=1,NPTO
  86.           X1=X12+XYC(1,IE2)*A-ISI*XYC(2,IE2)*B
  87.           Y1=Y12+XYC(1,IE2)*B+ISI*XYC(2,IE2)*A
  88.           XYC(1,IE2)=X1
  89.           XYC(2,IE2)=Y1
  90.         ENDDO
  91.         IF(ISI.EQ.-1)CALL J3ORIE(1,XYC,DENS,NPTO,1,TOL,IRET)
  92.       ENDDO
  93. C
  94.       RETURN
  95.       END
  96.  
  97.  
  98.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales