Esope Source Files | Cast3M - AFS ENEA

• Home
• Support
  • Manual pages
  • Thematic manual pages
  • Examples
• Developers
  • Procedures
  • Source files
  • Include
  • Errors
• Misc
  • FAQ

Download projec.eso

Back to the list

1 : C PROJEC SOURCE PV 06/01/16 21:15:10 5292 2 : SUBROUTINE PROJEC(ICPR,XPROJ,IOEIL,CGRAV,axez) 3 : IMPLICIT INTEGER(I-N) 4 : REAL*8 XO,XG,XP,XN,SN,XV,SV,UI,UJ 5 : DIMENSION XO(3),XP(3),XN(3),XG(3),XV(3),UI(3),UJ(3),CGRAV(*), 6 : > axez(*) 7 : -INC CCOPTIO 8 : -INC SMCOORD 9 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 10 : SEGMENT XPROJ(3,ITE) 11 : SEGACT MCOORD 12 : IF (IDIM.NE.2) GOTO 5500 13 : DO 5501 I=1,ICPR(/1) 14 : IF (ICPR(I).EQ.0) GOTO 5501 15 : XPROJ(1,ICPR(I))=XCOOR(I*3-2) 16 : XPROJ(2,ICPR(I))=XCOOR(I*3-1) 17 : 5501 CONTINUE 18 : GOTO 5502 19 : 5500 CONTINUE 20 : IREF=(IOEIL-1)*4 21 : XO(1)=XCOOR(IREF+1) 22 : XO(2)=XCOOR(IREF+2) 23 : XO(3)=XCOOR(IREF+3) 24 : C POINT MOYEN 25 : DO 1 I=1,3 26 : XG(I)=0.D0 27 : 1 CONTINUE 28 : DO 2 I=1,ICPR(/1) 29 : IF (ICPR(I).EQ.0) GOTO 2 30 : DO 3 J=1,3 31 : XG(J)=XG(J)+XCOOR(I*4-4+J) 32 : 3 CONTINUE 33 : 2 CONTINUE 34 : NBPOIN=XPROJ(/2) 35 : DO 4 J=1,3 36 : XG(J)=XG(J)/NBPOIN 37 : XN(J)=XO(J)-XG(J) 38 : 4 CONTINUE 39 : C NORMALE AU PLAN 40 : SN=SQRT(XN(1)**2+XN(2)**2+XN(3)**2) 40 : IF (SN.EQ.0.) CALL ERREUR(21) 41 : IF (IERR.NE.0) RETURN 42 : DO 5 J=1,3 43 : XN(J)=XN(J)/SN 44 : 5 CONTINUE 45 : C REPERE LOCAL SUR LE PLAN 46 : UJ(1)=0.D0 47 : UJ(2)=0.D0 48 : UJ(3)=1.D0 49 : 21 CONTINUE 50 : SV=UJ(1)*XN(1)+UJ(2)*XN(2)+UJ(3)*XN(3) 51 : DO 20 J=1,3 52 : UJ(J)=UJ(J)-SV*XN(J) 53 : 20 CONTINUE 54 : SV=UJ(1)**2+UJ(2)**2+UJ(3)**2 55 : IF (ABS(SV).LT.0.01) THEN 56 : UJ(1)=0.D0 57 : UJ(2)=1.D0 58 : UJ(3)=1.D0 59 : GOTO 21 60 : ENDIF 61 : SV=SQRT(SV) 62 : UJ(1)=UJ(1)/SV 63 : UJ(2)=UJ(2)/SV 64 : UJ(3)=UJ(3)/SV 65 : UI(1)=UJ(2)*XN(3)-UJ(3)*XN(2) 66 : UI(2)=UJ(3)*XN(1)-UJ(1)*XN(3) 67 : UI(3)=UJ(1)*XN(2)-UJ(2)*XN(1) 68 : C PROJECTION CONIQUE SUR LE PLAN 69 : DO 12 I=1,ICPR(/1) 70 : IF (ICPR(I).EQ.0) GOTO 12 71 : DO 13 J=1,3 72 : XP(J)=XCOOR(I*4-4+J) 73 : XV(J)=XP(J)-XO(J) 74 : 13 CONTINUE 75 : * XPROJ(3,ICPR(I))=SQRT(XV(1)**2+XV(2)**2+XV(3)**2) 76 : SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3) 77 : SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))*XN(3) 78 : XPROJ(3,ICPR(I))=-SN 79 : DO 14 J=1,3 80 : XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J) 81 : 14 CONTINUE 82 : XPROJ(1,ICPR(I))=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3) 83 : XPROJ(2,ICPR(I))=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3) 84 : 12 CONTINUE 85 : * rendre le centre de gravite pour eventuelle rotation 86 : cgrav(1)=xg(1) 87 : cgrav(2)=xg(2) 88 : cgrav(3)=xg(3) 89 : 5502 CONTINUE 90 : * axez pour tourner correctement avec opengl 91 : axez(1)=0 92 : axez(2)=uj(3) 93 : axez(3)=sqrt(1-uj(3)**2) 94 : if (xn(3).lt.0) axez(3)=-axez(3) 95 : * write (6,*) ' axez ',axez(1),axez(2),axez(3) 96 : RETURN 97 : END 98 : 99 :

© Cast3M 2003 - All rights reserved. Disclaimer