Télécharger la plaquette Cast3M


fr en

Télécharger projc2.eso

Retour à la liste

Numérotation des lignes : 

projc2

  1. C PROJC2    SOURCE    GOUNAND   16/12/01    21:15:14     9218           
  2.       SUBROUTINE PROJC2(IMBOIT,IOEIL,CGRAV,XBMIN,XBMAX,YBMIN
  3.      $        ,YBMAX,ZBMIN,ZBMAX)
  4. C***********************************************************************
  5. C NOM         : PROJC2
  6. C DESCRIPTION : Calcul des coordonnées de la fenêtre de tracé 
  7. C               centrée sur le maillage IMBOIT
  8. C
  9. C      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10. C
  11. C          ATTENTION : il faut que ce calcul, repris de prtrac.eso
  12. C                      et projec.eso a la creation reste consistant
  13. C                      avec ce qui est fait par ailleurs 
  14. C                      dans prtrac.eso et projec.eso
  15. C
  16. C           
  17. C      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  18. C
  19. C
  20. C
  21. C LANGAGE     : ESOPE
  22. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  23. C               mél : gounand@semt2.smts.cea.fr
  24. C***********************************************************************
  25. C VERSION    : v1, 29/11/2016, version initiale
  26. C HISTORIQUE : v1, 29/11/2016, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30.       IMPLICIT INTEGER(I-N)
  31.       REAL*8 XO,XG,XP,XN,SN,XV,SV,UI,UJ
  32.       DIMENSION XO(3),XP(3),XN(3),XG(3),XV(3),UI(3),UJ(3),CGRAV(*)
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCREEL
  37. -INC SMCOORD
  38. -INC SMELEME
  39.       POINTEUR IMBOIT.MELEME
  40.       SEGMENT XPBOIT(3,NNODE)
  41.       SEGACT MCOORD
  42. *
  43.       segact imboit
  44.       nnode=imboit.num(/2)
  45. *
  46.       segini xpboit
  47.       IF (IDIM.NE.2) GOTO 5500
  48.       DO 5501 inode=1,nnode
  49.          nuno=imboit.num(1,inode)
  50.          XPBOIT(1,inode)=XCOOR(nuno*3-2)
  51.          XPBOIT(2,inode)=XCOOR(nuno*3-1)
  52.  5501 CONTINUE
  53.       GOTO 5502
  54.  5500 CONTINUE
  55.       IREF=(IOEIL-1)*4
  56.       XO(1)=XCOOR(IREF+1)
  57.       XO(2)=XCOOR(IREF+2)
  58.       XO(3)=XCOOR(IREF+3)
  59.       DO  J=1,3
  60.          XG(J)=CGRAV(J)
  61.          XN(J)=XO(J)-XG(J)
  62.       ENDDO
  63.  
  64. C     NORMALE AU PLAN
  65.       SN=SQRT(XN(1)**2+XN(2)**2+XN(3)**2)
  66.       IF (SN.EQ.0.) CALL ERREUR(21)
  67.       IF (IERR.NE.0) RETURN
  68.       DO 5 J=1,3
  69.          XN(J)=XN(J)/SN
  70.  5    CONTINUE
  71. C  REPERE LOCAL SUR LE PLAN
  72.       UJ(1)=0.D0
  73.       UJ(2)=0.D0
  74.       UJ(3)=1.D0
  75.  21   CONTINUE
  76.       SV=UJ(1)*XN(1)+UJ(2)*XN(2)+UJ(3)*XN(3)
  77.       DO 20 J=1,3
  78.          UJ(J)=UJ(J)-SV*XN(J)
  79.   20  CONTINUE
  80.       SV=UJ(1)**2+UJ(2)**2+UJ(3)**2
  81.       IF (ABS(SV).LT.0.01) THEN
  82.          UJ(1)=0.D0
  83.          UJ(2)=1.D0
  84.          UJ(3)=1.D0
  85.       GOTO 21
  86.       ENDIF
  87.       SV=SQRT(SV)
  88.       UJ(1)=UJ(1)/SV
  89.       UJ(2)=UJ(2)/SV
  90.       UJ(3)=UJ(3)/SV
  91.       UI(1)=UJ(2)*XN(3)-UJ(3)*XN(2)
  92.       UI(2)=UJ(3)*XN(1)-UJ(1)*XN(3)
  93.       UI(3)=UJ(1)*XN(2)-UJ(2)*XN(1)
  94. C     PROJECTION CONIQUE SUR LE PLAN
  95.       DO 12 inode=1,nnode
  96.          i=imboit.num(1,inode)
  97.          DO 13 J=1,3
  98.             XP(J)=XCOOR(I*4-4+J)
  99.             XV(J)=XP(J)-XO(J)
  100.  13      CONTINUE
  101. *     XPBOIT(3,ICPR(I))=SQRT(XV(1)**2+XV(2)**2+XV(3)**2)
  102.          SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  103.          SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))*XN(3)
  104.          XPBOIT(3,inode)=-SN
  105.          DO 14 J=1,3
  106.             XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  107.  14      CONTINUE
  108.          XPBOIT(1,inode)=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  109.          XPBOIT(2,inode)=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  110.  12   CONTINUE
  111.  5502 CONTINUE
  112. * calcul des mins et max
  113.       XBMIN=1E30
  114.       XBMAX=-XBMIN
  115.       YBMIN=XBMIN
  116.       YBMAX=XBMAX
  117.       ZBMIN=XBMIN
  118.       ZBMAX=XBMAX
  119.       DO inode=1,nnode
  120.          XBMIN=MIN(XBMIN,XPBOIT(1,inode))
  121.          XBMAX=MAX(XBMAX,XPBOIT(1,inode))
  122.          YBMIN=MIN(YBMIN,XPBOIT(2,inode))
  123.          YBMAX=MAX(YBMAX,XPBOIT(2,inode))
  124.          ZBMIN=MIN(ZBMIN,XPBOIT(3,inode))
  125.          ZBMAX=MAX(ZBMAX,XPBOIT(3,inode))
  126.       ENDDO
  127. *goo      WRITE(IOIMP,*) 'PROJC2 : XBMIN,YBMIN,XBMAX,YBMAX,ZBMIN,ZBMAX=',
  128. *goo     $     XBMIN,YBMIN,XBMAX,YBMAX,ZBMIN,ZBMAX
  129.  
  130. C
  131.       XBDEC=XBMAX-XBMIN
  132.       YBDEC=YBMAX-YBMIN
  133.       ZBDEC=ZBMAX-ZBMIN
  134. *goo       WRITE(IOIMP,*) 'PROJC2 : XBDEC,YBDEC,ZBDEC=',XBDEC,YBDEC,ZBDEC
  135. * Modif des marges
  136. * Nouveau :
  137.       DDEC=MAX(XBDEC,YBDEC,ZBDEC)*0.1
  138. * MODIF JCARDO 28/02/2012 : DDEC vaut maintenant XSZPRE au minimum
  139. *                           (evite des erreurs de cancellation)
  140.       DDEC=MAX(DDEC,xszpre)
  141. *      DDEC=MAX(DDEC,xspeti)
  142.       XBMAX=XBMAX+DDEC
  143.       XBMIN=XBMIN-DDEC
  144.       YBMIN=YBMIN-DDEC
  145.       YBMAX=YBMAX+DDEC
  146.       ZBMIN=ZBMIN-DDEC
  147.       ZBMAX=ZBMAX+DDEC
  148.       SEGSUP XPBOIT
  149.       RETURN
  150.       END
  151.  
  152.  
  153.  
  154.  

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