Télécharger la plaquette Cast3M


fr en

Télécharger promod.eso

Retour à la liste

Numérotation des lignes : 

promod

  1. C PROMOD    SOURCE    PV        20/03/24    21:20:28     10554          
  2. C  PROJECTION SPECIALE POUR MODI
  3.       SUBROUTINE PROMOD(ICPR,XPROJ,IOEIL,ICLE,IBOUJ)
  4.       IMPLICIT INTEGER(I-N)
  5. -INC SMCOORD
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9.       SEGMENT ICPR(0)
  10.       SEGMENT IBOUJ(ITE)
  11.       SEGMENT XPROJ(3,0)
  12.       DIMENSION XBAR(3),OEIL(3),XMAT(3,3),XINT(3),YINT(3)
  13.       SAVE XBAR,XMAT,RPREC
  14.       ITE=ICPR(/1)
  15.       SEGADJ IBOUJ
  16.       IF (ICLE.NE.1) GOTO 100
  17.       IF (IDIM.EQ.2) THEN
  18.        DO 10 I=1,ICPR(/1)
  19.        IP=ICPR(I)
  20.        IF (IP.EQ.0) GOTO 10
  21.        IREF=(IDIM+1)*(I-1)
  22.        DO 20 J=1,2
  23.        XPROJ(J,IP)=XCOOR(IREF+J)
  24.   20   CONTINUE
  25.        XPROJ(J,IP)=0.
  26.   10   CONTINUE
  27.        RETURN
  28.       ENDIF
  29. *  CALCUL DE LA MATRICE DE PROJECTION
  30. *  RECHERCHE DU BARYCENTRE GENERAL
  31.       RPREC=0.
  32.       XBAR(1)=0.
  33.       XBAR(2)=0.
  34.       XBAR(3)=0.
  35.       NP=0
  36.       DO 30 I=1,ICPR(/1)
  37.       IP=ICPR(I)
  38.       IF (IP.EQ.0) GOTO 30
  39.       NP=NP+1
  40.       IREF=(IDIM+1)*(I-1)
  41.       DO 50 J=1,3
  42.       XXX=XCOOR(IREF+J)
  43.       RPREC=MAX(RPREC,ABS(XXX))
  44.       XBAR(J)=XXX+XBAR(J)
  45.   50  CONTINUE
  46.   30  CONTINUE
  47.       RPREC=RPREC*1E-5
  48.       XBAR(1)=XBAR(1)/NP
  49.       XBAR(2)=XBAR(2)/NP
  50.       XBAR(3)=XBAR(3)/NP
  51. * OEIL
  52.       IREF=(IDIM+1)*(IOEIL-1)
  53.       OEIL(1)=XCOOR(IREF+1)
  54.       OEIL(2)=XCOOR(IREF+2)
  55.       OEIL(3)=XCOOR(IREF+3)
  56.       XMAT(1,3)=OEIL(1)-XBAR(1)
  57.       XMAT(2,3)=OEIL(2)-XBAR(2)
  58.       XMAT(3,3)=OEIL(3)-XBAR(3)
  59.       SMAT=SQRT(XMAT(1,3)**2+XMAT(2,3)**2+XMAT(3,3)**2)
  60.       IF (SMAT.EQ.0.) CALL ERREUR(21)
  61.       IF (IERR.NE.0) RETURN
  62.       XMAT(1,3)=XMAT(1,3)/SMAT
  63.       XMAT(2,3)=XMAT(2,3)/SMAT
  64.       XMAT(3,3)=XMAT(3,3)/SMAT
  65.       SEGAct MCOORD*mod
  66.       NBPTS=nbpts+1
  67.       SEGADJ MCOORD
  68.       XCOOR((NBPTS-1)*4+1)=XMAT(1,3)
  69.       XCOOR((NBPTS-1)*4+2)=XMAT(2,3)
  70.       XCOOR((NBPTS-1)*4+3)=XMAT(3,3)
  71.       XCOOR((NBPTS-1)*4+4)=1.
  72.       ICPR(**)=0
  73. * AXE DES Z DONNE AXE DES Y
  74.       ZCOMP=XMAT(3,3)
  75.       XMAT(1,2)= (0.-XMAT(1,3)*ZCOMP)
  76.       XMAT(2,2)= (0.-XMAT(2,3)*ZCOMP)
  77.       XMAT(3,2)= (1.-XMAT(3,3)*ZCOMP)
  78.       SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)
  79. * SI PAS POSSIBLE PRENDRE AXE Y
  80.       IF (SMAT.LE.0.1) THEN
  81.        YCOMP=XMAT(2,3)
  82.        XMAT(1,2)= (0.-XMAT(1,3)*YCOMP)
  83.        XMAT(2,2)= (1.-XMAT(2,3)*YCOMP)
  84.        XMAT(3,2)= (0.-XMAT(3,3)*YCOMP)
  85.        SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)
  86.       ENDIF
  87.       XMAT(1,2)=XMAT(1,2)/SMAT
  88.       XMAT(2,2)=XMAT(2,2)/SMAT
  89.       XMAT(3,2)=XMAT(3,2)/SMAT
  90. *  TROISIEME VECTEUR
  91.       XMAT(1,1)= (XMAT(2,2)*XMAT(3,3)-XMAT(3,2)*XMAT(2,3))
  92.       XMAT(2,1)= (XMAT(3,2)*XMAT(1,3)-XMAT(1,2)*XMAT(3,3))
  93.       XMAT(3,1)= (XMAT(1,2)*XMAT(2,3)-XMAT(2,2)*XMAT(1,3))
  94. *  PROJECTION
  95.        DO 40 I=1,ICPR(/1)
  96.        IP=ICPR(I)
  97.        IF (IP.EQ.0) GOTO 40
  98.        IREF=(IDIM+1)*(I-1)
  99.        XINT(1)=XCOOR(IREF+1)-XBAR(1)
  100.        XINT(2)=XCOOR(IREF+2)-XBAR(2)
  101.        XINT(3)=XCOOR(IREF+3)-XBAR(3)
  102.        XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)
  103.        XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)
  104.        XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)
  105.        XPROJ(3,IP)=-XPROJ(3,IP)
  106.   40   CONTINUE
  107.        RETURN
  108.  100  CONTINUE
  109.       IF (ICLE.NE.2) GOTO 200
  110.       IF (IDIM.EQ.2) THEN
  111.        DO 110 I=1,ICPR(/1)
  112.        IP=ICPR(I)
  113.        IF (IP.EQ.0) GOTO 110
  114.        IREF=(IDIM+1)*(I-1)
  115.        DO 120 J=1,2
  116.        XCOOR(IREF+J)=XPROJ(J,IP)
  117.  120   CONTINUE
  118.  110   CONTINUE
  119.        RETURN
  120.       ENDIF
  121. *  DEPROJECTION
  122.        DO 140 I=1,ICPR(/1)
  123.        IP=ICPR(I)
  124.        IF (IP.EQ.0) GOTO 140
  125.        IREF=(IDIM+1)*(I-1)
  126.        YINT(1)=XPROJ(1,IP)
  127.        YINT(2)=XPROJ(2,IP)
  128.        YINT(3)=-XPROJ(3,IP)
  129.        XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)
  130.        XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)
  131.        XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)
  132.        XINT(1)=XINT(1)+XBAR(1)
  133.        XINT(2)=XINT(2)+XBAR(2)
  134.        XINT(3)=XINT(3)+XBAR(3)
  135.        IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.
  136.      #     ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.
  137.      #     ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN
  138.         XCOOR(1+IREF)=XINT(1)
  139.         XCOOR(2+IREF)=XINT(2)
  140.         XCOOR(3+IREF)=XINT(3)
  141.         IBOUJ(IP)=1
  142.        ENDIF
  143.  140   CONTINUE
  144.        RETURN
  145.  200  CONTINUE
  146.       IF (ICLE.NE.3) GOTO 300
  147.       IF (IDIM.EQ.2) THEN
  148.        IPP=ICPR(IOEIL)
  149.        IREF=(IDIM+1)*(IOEIL-1)
  150.        DO 210 J=1,2
  151.        XPROJ(J,IPP)=XCOOR(IREF+J)
  152.  210   CONTINUE
  153.        RETURN
  154.       ENDIF
  155. *  REPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)
  156.        IP=ICPR(IOEIL)
  157.        IF (IP.EQ.0) RETURN
  158.        IREF=(IDIM+1)*(IOEIL-1)
  159.        XINT(1)=XCOOR(IREF+1)-XBAR(1)
  160.        XINT(2)=XCOOR(IREF+2)-XBAR(2)
  161.        XINT(3)=XCOOR(IREF+3)-XBAR(3)
  162.        XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)
  163.        XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)
  164.        XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)
  165.        XPROJ(3,IP)=-XPROJ(3,IP)
  166.        RETURN
  167.  300  CONTINUE
  168.       IF (IDIM.EQ.2) THEN
  169.        IPP=ICPR(IOEIL)
  170.        IREF=(IDIM+1)*(IOEIL-1)
  171.        DO 310 J=1,2
  172.        XCOOR(IREF+J)=XPROJ(J,IPP)
  173.  310   CONTINUE
  174.        RETURN
  175.       ENDIF
  176. *  DEPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)
  177.        IP=ICPR(IOEIL)
  178.        IF (IP.EQ.0) RETURN
  179.        IREF=(IDIM+1)*(IOEIL-1)
  180.        YINT(1)=XPROJ(1,IP)
  181.        YINT(2)=XPROJ(2,IP)
  182.        YINT(3)=-XPROJ(3,IP)
  183.        XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)
  184.        XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)
  185.        XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)
  186.        XINT(1)=XINT(1)+XBAR(1)
  187.        XINT(2)=XINT(2)+XBAR(2)
  188.        XINT(3)=XINT(3)+XBAR(3)
  189.        IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.
  190.      #     ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.
  191.      #     ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN
  192.         XCOOR(1+IREF)=XINT(1)
  193.         XCOOR(2+IREF)=XINT(2)
  194.         XCOOR(3+IREF)=XINT(3)
  195.         IBOUJ(IP)=1
  196.        ENDIF
  197.        END
  198.  
  199.  
  200.  

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