Télécharger la plaquette Cast3M


fr en

Télécharger pplan.eso

Retour à la liste

Numérotation des lignes : 

pplan

  1. C PPLAN     SOURCE    PV        20/03/24    21:20:16     10554          
  2. C  CE SOUS-PROGRAMME RAMENE UN PLAN SUR DES COORDONNEES INTRINSEQUES
  3. C
  4.       SUBROUTINE PPLAN(IOP,FER,XPROJ,NDEB,NUMNP,tcval)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC SMCOORD
  11.       real*8 tcval(*)
  12.       SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER
  13.       SEGMENT XPROJ(3,IMAX)
  14. *             tcval   (1)   2     3     4     5     6
  15. *      COMMON/CPPLAN/XVEC1,YVEC1,ZVEC1,XVEC2,YVEC2,ZVEC2,XNORM,YNORM,
  16. *
  17. *     # ZNORM
  18. *             7     8     9
  19. *      SAVE XGRAV,YGRAV,ZGRAV
  20.       IF (IOP.EQ.2) GOTO 100
  21.       ctest=1d-2
  22.       if (idim.eq.3) call lirree(ctest,0,iretou)
  23.       IMCT=MAI(ITOUR+1)
  24.       INCT=MAI(1)+1
  25.       IMAX=(IMCT**2)+10
  26.       CALL LIRENT(IMAX,0,IRETOU)
  27.       IF (IRETOU.NE.0) IMAX=MAX(1,IMAX)
  28.       NDEB=IMCT+1
  29.       SEGINI XPROJ
  30.       SEGACT MCOORD*mod
  31. C  CENTRE DE GRAVITE
  32.       XGRAV=0
  33.       YGRAV=0
  34.       ZGRAV=0
  35.       DO 1 I=INCT,IMCT
  36.       IREF=(NFI(I))*(IDIM+1)-IDIM
  37.       XGRAV=XGRAV+XCOOR(IREF)
  38.       YGRAV=YGRAV+XCOOR(IREF+1)
  39.       ZGRAV=ZGRAV+XCOOR(IREF+2)
  40.    1  CONTINUE
  41.       XGRAV=XGRAV/(IMCT-INCT+1)
  42.       YGRAV=YGRAV/(IMCT-INCT+1)
  43.       ZGRAV=ZGRAV/(IMCT-INCT+1)
  44.       IF (IDIM.EQ.2) ZGRAV=0
  45.       tcval(7)=xgrav
  46.       tcval(8)=ygrav
  47.       tcval(9)=zgrav
  48. C  VECTEUR NORMAL
  49.       XNORM=0
  50.       YNORM=0
  51.       ZNORM=0
  52.       DO 2 IT=1,ITOUR
  53.       IPR=NFI(MAI(IT+1))*(IDIM+1)-IDIM
  54.       XV1=XCOOR(IPR)-XGRAV
  55.       YV1=XCOOR(IPR+1)-YGRAV
  56.       ZV1=XCOOR(IPR+2)-ZGRAV
  57.       IF (IDIM.EQ.2) ZV1=0
  58.       DO 2 I=MAI(IT-1+1)+1,MAI(IT+1)
  59.       IREF=(NFI(I))*(IDIM+1)-IDIM
  60.       XV2=XCOOR(IREF)-XGRAV
  61.       YV2=XCOOR(IREF+1)-YGRAV
  62.       ZV2=0
  63.       IF (IDIM.GE.3) ZV2=XCOOR(IREF+2)-ZGRAV
  64.       XNORM=XNORM+YV1*ZV2-ZV1*YV2
  65.       YNORM=YNORM+ZV1*XV2-XV1*ZV2
  66.       ZNORM=ZNORM+XV1*YV2-XV2*YV1
  67.       XV1=XV2
  68.       YV1=YV2
  69.       ZV1=ZV2
  70.    2  CONTINUE
  71.       DNORM=SQRT(XNORM**2+YNORM**2+ZNORM**2)
  72.       IF (DNORM.EQ.0.) CALL ERREUR(21)
  73.       IF (IERR.NE.0) RETURN
  74.       XNORM=XNORM/DNORM
  75.       YNORM=YNORM/DNORM
  76.       ZNORM=ZNORM/DNORM
  77. C    FORMATION DU REPERE
  78.       IREF=NFI(INCT)*(IDIM+1)-IDIM
  79.       XVEC1=XCOOR(IREF)-XGRAV
  80.       YVEC1=XCOOR(IREF+1)-YGRAV
  81.       ZVEC1=0
  82.       IF (IDIM.GE.3) ZVEC1=XCOOR(IREF+2)-ZGRAV
  83.       PVEC=XVEC1*XNORM+YVEC1*YNORM+ZVEC1*ZNORM
  84.       XVEC1=XVEC1-PVEC*XNORM
  85.       YVEC1=YVEC1-PVEC*YNORM
  86.       ZVEC1=ZVEC1-PVEC*ZNORM
  87.       DVEC1=XVEC1**2+YVEC1**2+ZVEC1**2
  88.       DVEC1=SQRT(DVEC1)
  89.       XVEC1=XVEC1/DVEC1
  90.       YVEC1=YVEC1/DVEC1
  91.       ZVEC1=ZVEC1/DVEC1
  92.       tcval(1)=xvec1
  93.       tcval(2)=yvec1
  94.       tcval(3)=zvec1
  95.       XVEC2=YNORM*ZVEC1-ZNORM*YVEC1
  96.       YVEC2=ZNORM*XVEC1-XNORM*ZVEC1
  97.       ZVEC2=XNORM*YVEC1-YNORM*XVEC1
  98.       tcval(4)=xvec2
  99.       tcval(5)=yvec2
  100.       tcval(6)=zvec2
  101. C   EN AVANT POUR LA PROJECTION
  102.       DO 40 I=INCT,max(IMCT,mai(itour+2))
  103.       II=NFI(I)
  104.       NFI(I)=I
  105.       IREF=II*(IDIM+1)-IDIM
  106.       XRE=XCOOR(IREF)-XGRAV
  107.       YRE=XCOOR(IREF+1)-YGRAV
  108.       ZRE=XCOOR(IREF+2)-ZGRAV
  109.       if (idim.eq.2) zre=0
  110.       XPROJ(1,I)=XRE*XVEC1+YRE*YVEC1+ZRE*ZVEC1
  111.       XPROJ(2,I)=XRE*XVEC2+YRE*YVEC2+ZRE*ZVEC2
  112.       XTEST     =XRE*XNORM+YRE*YNORM+ZRE*ZNORM
  113.       DRE       =SQRT(XRE*XRE+YRE*YRE+ZRE*ZRE)
  114.       IF (IDIM.EQ.3.AND.ABS(XTEST).GT.DRE*ctest.AND.
  115.      #  i.le.imct) CALL ERREUR(26)
  116.       IF (IERR.NE.0) RETURN
  117.       XPROJ(3,I)=XCOOR(IREF+IDIM)
  118.   40  CONTINUE
  119. C    SI LA DENSITE LOCALE N'EST PAS DEFINIE IL FAUT LE FAIRE
  120.       DO 41 IT=1,ITOUR
  121.       II1=MAI(IT-1+1)+1
  122.       II2=MAI(IT+1)
  123.       IAP=II2
  124.       DO 41 I=II1,II2
  125.       IF (XPROJ(3,I).NE.0) GOTO 41
  126.       XPROJ(3,I)=SQRT((XPROJ(1,I)-XPROJ(1,IAP))**2+(XPROJ(2,I)-XPROJ(2,
  127.      # IAP))**2)
  128.       IAP=I
  129.   41  CONTINUE
  130.       RETURN
  131.  100  CONTINUE
  132.       xvec1=tcval(1)
  133.       yvec1=tcval(2)
  134.       zvec1=tcval(3)
  135.       xvec2=tcval(4)
  136.       yvec2=tcval(5)
  137.       zvec2=tcval(6)
  138.       xgrav=tcval(7)
  139.       ygrav=tcval(8)
  140.       zgrav=tcval(9)
  141. C  ON RECONSTITUE LE MAILLAGE
  142.       SEGACT MCOORD*mod
  143.       IF (NDEB.GT.NUMNP) GOTO 111
  144.       NBPTA=nbpts
  145.       NBPTS=NBPTA+NUMNP-NDEB+1
  146.       SEGADJ MCOORD
  147.       DO 110 I=NDEB,NUMNP
  148.       XCOOR(NBPTA*(IDIM+1)+1)=XPROJ(1,I)*XVEC1+XPROJ(2,I)*XVEC2+XGRAV
  149.       XCOOR(NBPTA*(IDIM+1)+2)=XPROJ(1,I)*YVEC1+XPROJ(2,I)*YVEC2+YGRAV
  150.       IF (IDIM.GE.3)
  151.      #XCOOR(NBPTA*(IDIM+1)+3)=XPROJ(1,I)*ZVEC1+XPROJ(2,I)*ZVEC2+ZGRAV
  152.       XCOOR((NBPTA+1)*(IDIM+1))=XPROJ(3,I)
  153.       NBPTA=NBPTA+1
  154.  110  CONTINUE
  155.  111  CONTINUE
  156.       SEGSUP XPROJ
  157.       RETURN
  158.       END
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  

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