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    CB215821  26/08/24    21:17:53     12622          
  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 112 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.   112 CONTINUE
  72.       DNORM=SQRT(XNORM**2+YNORM**2+ZNORM**2)
  73.       IF (DNORM.EQ.0.) CALL ERREUR(21)
  74.       IF (IERR.NE.0) RETURN
  75.       XNORM=XNORM/DNORM
  76.       YNORM=YNORM/DNORM
  77.       ZNORM=ZNORM/DNORM
  78. C    FORMATION DU REPERE
  79.       IREF=NFI(INCT)*(IDIM+1)-IDIM
  80.       XVEC1=XCOOR(IREF)-XGRAV
  81.       YVEC1=XCOOR(IREF+1)-YGRAV
  82.       ZVEC1=0
  83.       IF (IDIM.GE.3) ZVEC1=XCOOR(IREF+2)-ZGRAV
  84.       PVEC=XVEC1*XNORM+YVEC1*YNORM+ZVEC1*ZNORM
  85.       XVEC1=XVEC1-PVEC*XNORM
  86.       YVEC1=YVEC1-PVEC*YNORM
  87.       ZVEC1=ZVEC1-PVEC*ZNORM
  88.       DVEC1=XVEC1**2+YVEC1**2+ZVEC1**2
  89.       DVEC1=SQRT(DVEC1)
  90.       XVEC1=XVEC1/DVEC1
  91.       YVEC1=YVEC1/DVEC1
  92.       ZVEC1=ZVEC1/DVEC1
  93.       tcval(1)=xvec1
  94.       tcval(2)=yvec1
  95.       tcval(3)=zvec1
  96.       XVEC2=YNORM*ZVEC1-ZNORM*YVEC1
  97.       YVEC2=ZNORM*XVEC1-XNORM*ZVEC1
  98.       ZVEC2=XNORM*YVEC1-YNORM*XVEC1
  99.       tcval(4)=xvec2
  100.       tcval(5)=yvec2
  101.       tcval(6)=zvec2
  102. C   EN AVANT POUR LA PROJECTION
  103.       DO 40 I=INCT,max(IMCT,mai(itour+2))
  104.       II=NFI(I)
  105.       NFI(I)=I
  106.       IREF=II*(IDIM+1)-IDIM
  107.       XRE=XCOOR(IREF)-XGRAV
  108.       YRE=XCOOR(IREF+1)-YGRAV
  109.       ZRE=XCOOR(IREF+2)-ZGRAV
  110.       if (idim.eq.2) zre=0
  111.       XPROJ(1,I)=XRE*XVEC1+YRE*YVEC1+ZRE*ZVEC1
  112.       XPROJ(2,I)=XRE*XVEC2+YRE*YVEC2+ZRE*ZVEC2
  113.       XTEST     =XRE*XNORM+YRE*YNORM+ZRE*ZNORM
  114.       DRE       =SQRT(XRE*XRE+YRE*YRE+ZRE*ZRE)
  115.       IF (IDIM.EQ.3.AND.ABS(XTEST).GT.DRE*ctest.AND.
  116.      #  i.le.imct) CALL ERREUR(26)
  117.       IF (IERR.NE.0) RETURN
  118.       XPROJ(3,I)=XCOOR(IREF+IDIM)
  119.   40  CONTINUE
  120. C    SI LA DENSITE LOCALE N'EST PAS DEFINIE IL FAUT LE FAIRE
  121.       DO 113 IT=1,ITOUR
  122.       II1=MAI(IT-1+1)+1
  123.       II2=MAI(IT+1)
  124.       IAP=II2
  125.       DO 41 I=II1,II2
  126.       IF (XPROJ(3,I).NE.0) GOTO 41
  127.       XPROJ(3,I)=SQRT((XPROJ(1,I)-XPROJ(1,IAP))**2+(XPROJ(2,I)-XPROJ(2,
  128.      # IAP))**2)
  129.       IAP=I
  130.   41  CONTINUE
  131.   113 CONTINUE
  132.       RETURN
  133.  100  CONTINUE
  134.       xvec1=tcval(1)
  135.       yvec1=tcval(2)
  136.       zvec1=tcval(3)
  137.       xvec2=tcval(4)
  138.       yvec2=tcval(5)
  139.       zvec2=tcval(6)
  140.       xgrav=tcval(7)
  141.       ygrav=tcval(8)
  142.       zgrav=tcval(9)
  143. C  ON RECONSTITUE LE MAILLAGE
  144.       SEGACT MCOORD*mod
  145.       IF (NDEB.GT.NUMNP) GOTO 111
  146.       NBPTA=nbpts
  147.       NBPTS=NBPTA+NUMNP-NDEB+1
  148.       SEGADJ MCOORD
  149.       DO 110 I=NDEB,NUMNP
  150.       XCOOR(NBPTA*(IDIM+1)+1)=XPROJ(1,I)*XVEC1+XPROJ(2,I)*XVEC2+XGRAV
  151.       XCOOR(NBPTA*(IDIM+1)+2)=XPROJ(1,I)*YVEC1+XPROJ(2,I)*YVEC2+YGRAV
  152.       IF (IDIM.GE.3)
  153.      #XCOOR(NBPTA*(IDIM+1)+3)=XPROJ(1,I)*ZVEC1+XPROJ(2,I)*ZVEC2+ZGRAV
  154.       XCOOR((NBPTA+1)*(IDIM+1))=XPROJ(3,I)
  155.       NBPTA=NBPTA+1
  156.  110  CONTINUE
  157.  111  CONTINUE
  158.       SEGSUP XPROJ
  159.       RETURN
  160.       END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  

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