Télécharger la plaquette Cast3M


fr en

Télécharger projec.eso

Retour à la liste

Numérotation des lignes : 

projec

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

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