1 : C CALJQ SOURCE CHAT 05/01/12 21:46:56 5004 2 : SUBROUTINE CALJQ(XYZ,XY,IES,ND,NP) 3 : C*********************************************************************** 4 : C CE SP CALCULE 5 : C 1/ LES COORDONNEES D UN ELEMENT COQUE DANS LE PLAN ASSOCIE A CET 6 : C ELEMENT A PARTIR DE SES COORDONNEES 3D 7 : C 2/ LES COORDONNEES D UN ELEMENT 1D A PARTIR DE SES COORDONNEES 8 : C 2D OU 3D 9 : C |||| CES ELEMENTS SONT SUPPOSES DROITS 10 : C*********************************************************************** 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8 (A-H,O-Z) 13 : REAL*8 XYZ(IES,NP),XY(ND,NP) 14 : IF(ND.NE.2)GOTO 10 15 : TX=XYZ(1,2)-XYZ(1,1) 16 : TY=XYZ(2,2)-XYZ(2,1) 17 : TZ=XYZ(3,2)-XYZ(3,1) 18 : TT=TX*TX+TY*TY+TZ*TZ 19 : TT=SQRT(TT) 20 : TX=TX/TT 21 : TY=TY/TT 22 : TZ=TZ/TT 23 : C WRITE(6,*)TX,TY,TZ,TT 24 : UX=(XYZ(2,NP)-XYZ(2,1))*TZ-(XYZ(3,NP)-XYZ(3,1))*TY 25 : UY=(XYZ(3,NP)-XYZ(3,1))*TX-(XYZ(1,NP)-XYZ(1,1))*TZ 26 : UZ=(XYZ(1,NP)-XYZ(1,1))*TY-(XYZ(2,NP)-XYZ(2,1))*TX 27 : UU=UX*UX+UY*UY+UZ*UZ 28 : UU=SQRT(UU) 29 : UX=-UX/UU 30 : UY=-UY/UU 31 : UZ=-UZ/UU 32 : C WRITE(6,*)'UX,UY,UZ,UU',UX,UY,UZ,UU 33 : VX=+UY*TZ-UZ*TY 34 : VY=+UZ*TX-UX*TZ 35 : VZ=+UX*TY-UY*TX 36 : C WRITE(6,*)VX,VY,VZ 37 : C 38 : DO 1 I=1,NP 39 : XY(1,I)=(XYZ(1,I)-XYZ(1,1))*TX+(XYZ(2,I)-XYZ(2,1))*TY 40 : *+(XYZ(3,I)-XYZ(3,1))*TZ 41 : XY(2,I)=(XYZ(1,I)-XYZ(1,1))*VX+(XYZ(2,I)-XYZ(2,1))*VY 42 : *+(XYZ(3,I)-XYZ(3,1))*VZ 43 : 1 CONTINUE 44 : RETURN 45 : C 46 : 10 CONTINUE 47 : IF(IES.NE.3)GOTO 20 48 : DO 11 I=1,NP 49 : TX=XYZ(1,I)-XYZ(1,1) 50 : TY=XYZ(2,I)-XYZ(2,1) 51 : TZ=XYZ(3,I)-XYZ(3,1) 52 : TT=TX*TX+TY*TY+TZ*TZ 53 : TT=SQRT(TT) 54 : XY(1,I)=TT 55 : 11 CONTINUE 56 : RETURN 57 : 20 CONTINUE 58 : DO 12 I=1,NP 59 : TX=XYZ(1,I)-XYZ(1,1) 60 : TY=XYZ(2,I)-XYZ(2,1) 61 : TT=TX*TX+TY*TY 62 : TT=SQRT(TT) 63 : XY(1,I)=TT 64 : C WRITE(6,3000) XYZ(1,I),XYZ(2,I),TT 65 : C3000 FORMAT(2X,' X Y TT ',3E12.5) 66 : 12 CONTINUE 67 : C 68 : RETURN 69 : END 70 :
© Cast3M 2003 - All rights reserved.
Disclaimer