1 : C J3LOAD SOURCE CHAT 05/01/13 00:46:59 5004 2 : SUBROUTINE J3LOAD(NUM,WWORK,NPTO,TOL,IRET) 3 : C---------------------------------------------------- 4 : C TRANSFERT DES FACE 3D EN FACE 2D 5 : C 6 : C PP 9/97 7 : C Pierre Pegon/JRC Ispra 8 : C---------------------------------------------------- 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8(A-H,O-Z) 11 : DIMENSION NUM(2,NPTO),P1(3) 12 : C 13 : -INC CCOPTIO 14 : -INC SMCOORD 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 : 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 : C 29 : IRET=0 30 : IF(NPTO.LE.2)THEN 31 : WRITE(IOIMP,*)'J3LOAD: nb de point d"une face insuffisant' 32 : IRET=IRET+1 33 : RETURN 34 : ENDIF 35 : WORK=FWORK 36 : C 37 : C LE PREMIER POINT DU CONTOURS DEFINIT L'ORIGINE 38 : C 39 : NUME=NUM(1,1) 40 : IREF=(NUME-1)*(IDIM+1) 41 : DO IE1=1,3 42 : PORIG(IE1)=XCOOR(IREF+IE1) 43 : ENDDO 44 : XYC(1,1)=0.D0 45 : XYC(2,1)=0.D0 46 : DENS(1)=XCOOR(IREF+4) 47 : C 48 : C AVEC LE SECOND POINT, ON DEFINIT LE PREMIER VECTEUR 49 : C 50 : NUME=NUM(1,2) 51 : IREF=(NUME-1)*(IDIM+1) 52 : DO IE1=1,3 53 : P1(IE1)=XCOOR(IREF+IE1) 54 : VI(IE1)=P1(IE1)-PORIG(IE1) 55 : ENDDO 56 : XNORM=SQRT(VI(1)**2+VI(2)**2+VI(3)**2) 57 : IF(XNORM.LT.TOL)THEN 58 : WRITE(IOIMP,*)'J3LOAD: 2 point d"une face sont trop proches' 59 : IRET=IRET+1 60 : RETURN 61 : ENDIF 62 : DO IE1=1,3 63 : VI(IE1)=VI(IE1)/XNORM 64 : ENDDO 65 : XYC(1,2)=XNORM 66 : XYC(2,2)=0.D0 67 : DENS(2)=XCOOR(IREF+4) 68 : C 69 : C AVEC LE POINT SUIVANT, OU UN AUTRE POINT, ON DEFINIT LE VECTEUR 70 : C NORMAL PUIS LE SECOND VECTEUR 71 : C WARNING: LA + GD COMPOSANTE DE VNOR EST TJ POSITIVE! 72 : C 73 : DO IE1=3,NPTO 74 : NUME=NUM(1,IE1) 75 : IREF=(NUME-1)*(IDIM+1) 76 : DO IE2=1,3 77 : VJ(IE2)=XCOOR(IREF+IE2)-P1(IE2) 78 : P1(IE2)=XCOOR(IREF+IE2) 79 : ENDDO 80 : XNORM=SQRT(VJ(1)**2+VJ(2)**2+VJ(3)**2) 81 : IF(XNORM.LT.TOL)THEN 82 : WRITE(IOIMP,*)'J3LOAD: 2 point d"une face sont trop proches' 83 : IRET=IRET+1 84 : RETURN 85 : ENDIF 86 : DO IE2=1,3 87 : VJ(IE2)=VJ(IE2)/XNORM 88 : ENDDO 89 : VNORM(1)=VI(2)*VJ(3)-VI(3)*VJ(2) 90 : VNORM(2)=VI(3)*VJ(1)-VI(1)*VJ(3) 91 : VNORM(3)=VI(1)*VJ(2)-VI(2)*VJ(1) 92 : XNORM=SQRT(VNORM(1)**2+VNORM(2)**2+VNORM(3)**2) 93 : IF(XNORM.GT.100*TOL)THEN 94 : XCMAX=VNORM(1) 95 : DO IE2=2,3 96 : IF(ABS(VNORM(IE2)).GT.ABS(XCMAX))THEN 97 : XCMAX=VNORM(IE2) 98 : ENDIF 99 : ENDDO 100 : XNORM=SIGN(1.D0,XCMAX)*XNORM 101 : DO IE2=1,3 102 : VNORM(IE2)=VNORM(IE2)/XNORM 103 : ENDDO 104 : VJ(1)=VNORM(2)*VI(3)-VNORM(3)*VI(2) 105 : VJ(2)=VNORM(3)*VI(1)-VNORM(1)*VI(3) 106 : VJ(3)=VNORM(1)*VI(2)-VNORM(2)*VI(1) 107 : GOTO 1 108 : ENDIF 109 : ENDDO 110 : WRITE(IOIMP,*)'J3LOAD: On ne reussit pas a definir le 2nd vecteur' 111 : IRET=IRET+1 112 : RETURN 113 : C 114 : C ON BOUCLE SUR LES POINTS ET ON LES PROJETTE SUR LE PLAN 115 : C ON TESTE LA DISTANCE DU POINT AU PLAN 116 : C 117 : 1 CONTINUE 118 : DO IE1=3,NPTO 119 : NUME=NUM(1,IE1) 120 : IREF=(NUME-1)*(IDIM+1) 121 : DO IE2=1,3 122 : P1(IE2)=XCOOR(IREF+IE2) 123 : ENDDO 124 : XDIST=(P1(1)-PORIG(1))*VNORM(1)+(P1(2)-PORIG(2))*VNORM(2) 125 : > +(P1(3)-PORIG(3))*VNORM(3) 126 : IF(ABS(XDIST).GT.TOL)THEN 127 : WRITE(IOIMP,*)'J3LOAD: 1 point d"une face est hors plan' 128 : IRET=IRET+1 129 : RETURN 130 : ENDIF 131 : XYC(1,IE1)=(P1(1)-PORIG(1))*VI(1)+(P1(2)-PORIG(2))*VI(2) 132 : > +(P1(3)-PORIG(3))*VI(3) 133 : XYC(2,IE1)=(P1(1)-PORIG(1))*VJ(1)+(P1(2)-PORIG(2))*VJ(2) 134 : > +(P1(3)-PORIG(3))*VJ(3) 135 : DENS(IE1)=XCOOR(IREF+4) 136 : ENDDO 137 : C 138 : JUN=0 139 : C 140 : RETURN 141 : END 142 : 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer