Esope source files

   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 CCOPTIO
  14 : C
  15 :       SEGMENT WWORK
  16 :         REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
  17 :         INTEGER FWORK
  18 :         INTEGER TWORK(NTROU)
  19 :       ENDSEGMENT
  20 :       POINTEUR WWORK1.WWORK,WWORK2.WWORK
  21 : C
  22 :       SEGMENT WORK
  23 :         REAL*8 XYC(2,NPTO)
  24 :         INTEGER IST(3,NPTO)
  25 :         REAL*8 DENS(NPTO)
  26 :         INTEGER JUN
  27 :       ENDSEGMENT
  28 :       LOGICAL LPLAN
  29 : C
  30 : C     ON VERIFIE QUE LES NORMALES SONT COPLANAIRES
  31 : C
  32 :       XPMIX=(WWORK1.VNORM(2)*WWORK2.VNORM(3)
  33 :      >      -WWORK1.VNORM(3)*WWORK2.VNORM(2))**2
  34 :      >     +(WWORK1.VNORM(3)*WWORK2.VNORM(1)
  35 :      >      -WWORK1.VNORM(1)*WWORK2.VNORM(3))**2
  36 :      >     +(WWORK1.VNORM(1)*WWORK2.VNORM(2)
  37 :      >      -WWORK1.VNORM(2)*WWORK2.VNORM(1))**2
  38 :       XPMIX=SQRT(XPMIX)
  39 :       LPLAN=XPMIX.LT.TOL
  40 :       IF(.NOT.LPLAN)RETURN
  41 : C
  42 : C     ON VERIFIE QUE L'ORIGINE DU SECOND PLAN EST SUR LE PREMIER
  43 : C
  44 :       XDIST=WWORK1.VNORM(1)*(WWORK2.PORIG(1)-WWORK1.PORIG(1))
  45 :      >     +WWORK1.VNORM(2)*(WWORK2.PORIG(2)-WWORK1.PORIG(2))
  46 :      >     +WWORK1.VNORM(3)*(WWORK2.PORIG(3)-WWORK1.PORIG(3))
  47 :       LPLAN=ABS(XDIST).LT.TOL
  48 :       IF(.NOT.LPLAN)RETURN
  49 : C
  50 : C     ON CHANGE LE HEADER DE WWORK2 AINSI QUE LE SYSTEME DE COORDONNEES
  51 : C
  52 :       XSCAL=WWORK1.VNORM(1)*WWORK2.VNORM(1)
  53 :      >     +WWORK1.VNORM(2)*WWORK2.VNORM(2)
  54 :      >     +WWORK1.VNORM(3)*WWORK2.VNORM(3)
  55 :       ISI=INT(SIGN(1.D0,XSCAL))
  56 : C
  57 :       X12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VI(1)
  58 :      >   +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VI(2)
  59 :      >   +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VI(3)
  60 :       Y12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VJ(1)
  61 :      >   +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VJ(2)
  62 :      >   +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VJ(3)
  63 : C
  64 :       A=WWORK2.VI(1)*WWORK1.VI(1)+WWORK2.VI(2)*WWORK1.VI(2)
  65 :      >                           +WWORK2.VI(3)*WWORK1.VI(3)
  66 :       B=WWORK2.VI(1)*WWORK1.VJ(1)+WWORK2.VI(2)*WWORK1.VJ(2)
  67 :      >                           +WWORK2.VI(3)*WWORK1.VJ(3)
  68 : C
  69 :       DO IE1=1,3
  70 :         WWORK2.PORIG(IE1)=WWORK1.PORIG(IE1)
  71 :         WWORK2.VNORM(IE1)=WWORK1.VNORM(IE1)
  72 :         WWORK2.VI(IE1)=WWORK1.VI(IE1)
  73 :         WWORK2.VJ(IE1)=WWORK1.VJ(IE1)
  74 :       ENDDO
  75 : C
  76 :       WWORK=WWORK2
  77 :       DO IE1=1,1+TWORK(/1)
  78 :         IF(IE1.EQ.1)THEN
  79 :           WORK=FWORK
  80 :         ELSE
  81 :           WORK=TWORK(IE1-1)
  82 :         ENDIF
  83 :         NPTO=DENS(/1)
  84 :         DO IE2=1,NPTO
  85 :           X1=X12+XYC(1,IE2)*A-ISI*XYC(2,IE2)*B
  86 :           Y1=Y12+XYC(1,IE2)*B+ISI*XYC(2,IE2)*A
  87 :           XYC(1,IE2)=X1
  88 :           XYC(2,IE2)=Y1
  89 :         ENDDO
  89 :         IF(ISI.EQ.-1)CALL J3ORIE(1,XYC,DENS,NPTO,1,TOL,IRET)
  90 :       ENDDO
  91 : C
  92 :       RETURN
  93 :       END
  94 :  
  95 :