Numérotation des lignes :

C PROMOD    SOURCE    PV        20/03/24    21:20:28     10554          C  PROJECTION SPECIALE POUR MODI      SUBROUTINE PROMOD(ICPR,XPROJ,IOEIL,ICLE,IBOUJ)      IMPLICIT INTEGER(I-N)-INC SMCOORD -INC PPARAM-INC CCOPTIO      SEGMENT ICPR(0)      SEGMENT IBOUJ(ITE)      SEGMENT XPROJ(3,0)      DIMENSION XBAR(3),OEIL(3),XMAT(3,3),XINT(3),YINT(3)      SAVE XBAR,XMAT,RPREC      ITE=ICPR(/1)      SEGADJ IBOUJ      IF (ICLE.NE.1) GOTO 100      IF (IDIM.EQ.2) THEN       DO 10 I=1,ICPR(/1)       IP=ICPR(I)       IF (IP.EQ.0) GOTO 10       IREF=(IDIM+1)*(I-1)       DO 20 J=1,2       XPROJ(J,IP)=XCOOR(IREF+J)  20   CONTINUE       XPROJ(J,IP)=0.  10   CONTINUE       RETURN      ENDIF*  CALCUL DE LA MATRICE DE PROJECTION*  RECHERCHE DU BARYCENTRE GENERAL      RPREC=0.      XBAR(1)=0.      XBAR(2)=0.      XBAR(3)=0.      NP=0      DO 30 I=1,ICPR(/1)      IP=ICPR(I)      IF (IP.EQ.0) GOTO 30      NP=NP+1      IREF=(IDIM+1)*(I-1)      DO 50 J=1,3      XXX=XCOOR(IREF+J)      RPREC=MAX(RPREC,ABS(XXX))      XBAR(J)=XXX+XBAR(J)  50  CONTINUE  30  CONTINUE      RPREC=RPREC*1E-5      XBAR(1)=XBAR(1)/NP      XBAR(2)=XBAR(2)/NP      XBAR(3)=XBAR(3)/NP* OEIL      IREF=(IDIM+1)*(IOEIL-1)      OEIL(1)=XCOOR(IREF+1)      OEIL(2)=XCOOR(IREF+2)      OEIL(3)=XCOOR(IREF+3)      XMAT(1,3)=OEIL(1)-XBAR(1)      XMAT(2,3)=OEIL(2)-XBAR(2)      XMAT(3,3)=OEIL(3)-XBAR(3)      SMAT=SQRT(XMAT(1,3)**2+XMAT(2,3)**2+XMAT(3,3)**2)      IF (SMAT.EQ.0.) CALL ERREUR(21)      IF (IERR.NE.0) RETURN      XMAT(1,3)=XMAT(1,3)/SMAT      XMAT(2,3)=XMAT(2,3)/SMAT      XMAT(3,3)=XMAT(3,3)/SMAT      SEGAct MCOORD*mod      NBPTS=nbpts+1      SEGADJ MCOORD      XCOOR((NBPTS-1)*4+1)=XMAT(1,3)      XCOOR((NBPTS-1)*4+2)=XMAT(2,3)      XCOOR((NBPTS-1)*4+3)=XMAT(3,3)      XCOOR((NBPTS-1)*4+4)=1.      ICPR(**)=0* AXE DES Z DONNE AXE DES Y      ZCOMP=XMAT(3,3)      XMAT(1,2)= (0.-XMAT(1,3)*ZCOMP)      XMAT(2,2)= (0.-XMAT(2,3)*ZCOMP)      XMAT(3,2)= (1.-XMAT(3,3)*ZCOMP)      SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)* SI PAS POSSIBLE PRENDRE AXE Y      IF (SMAT.LE.0.1) THEN       YCOMP=XMAT(2,3)       XMAT(1,2)= (0.-XMAT(1,3)*YCOMP)       XMAT(2,2)= (1.-XMAT(2,3)*YCOMP)       XMAT(3,2)= (0.-XMAT(3,3)*YCOMP)       SMAT=SQRT(XMAT(1,2)**2+XMAT(2,2)**2+XMAT(3,2)**2)      ENDIF      XMAT(1,2)=XMAT(1,2)/SMAT      XMAT(2,2)=XMAT(2,2)/SMAT      XMAT(3,2)=XMAT(3,2)/SMAT*  TROISIEME VECTEUR      XMAT(1,1)= (XMAT(2,2)*XMAT(3,3)-XMAT(3,2)*XMAT(2,3))      XMAT(2,1)= (XMAT(3,2)*XMAT(1,3)-XMAT(1,2)*XMAT(3,3))      XMAT(3,1)= (XMAT(1,2)*XMAT(2,3)-XMAT(2,2)*XMAT(1,3))*  PROJECTION       DO 40 I=1,ICPR(/1)       IP=ICPR(I)       IF (IP.EQ.0) GOTO 40       IREF=(IDIM+1)*(I-1)       XINT(1)=XCOOR(IREF+1)-XBAR(1)       XINT(2)=XCOOR(IREF+2)-XBAR(2)       XINT(3)=XCOOR(IREF+3)-XBAR(3)       XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)       XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)       XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)       XPROJ(3,IP)=-XPROJ(3,IP)  40   CONTINUE       RETURN 100  CONTINUE      IF (ICLE.NE.2) GOTO 200      IF (IDIM.EQ.2) THEN       DO 110 I=1,ICPR(/1)       IP=ICPR(I)       IF (IP.EQ.0) GOTO 110       IREF=(IDIM+1)*(I-1)       DO 120 J=1,2       XCOOR(IREF+J)=XPROJ(J,IP) 120   CONTINUE 110   CONTINUE       RETURN      ENDIF*  DEPROJECTION       DO 140 I=1,ICPR(/1)       IP=ICPR(I)       IF (IP.EQ.0) GOTO 140       IREF=(IDIM+1)*(I-1)       YINT(1)=XPROJ(1,IP)       YINT(2)=XPROJ(2,IP)       YINT(3)=-XPROJ(3,IP)       XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)       XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)       XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)       XINT(1)=XINT(1)+XBAR(1)       XINT(2)=XINT(2)+XBAR(2)       XINT(3)=XINT(3)+XBAR(3)       IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.     #     ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.     #     ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN        XCOOR(1+IREF)=XINT(1)        XCOOR(2+IREF)=XINT(2)        XCOOR(3+IREF)=XINT(3)        IBOUJ(IP)=1       ENDIF 140   CONTINUE       RETURN 200  CONTINUE      IF (ICLE.NE.3) GOTO 300      IF (IDIM.EQ.2) THEN       IPP=ICPR(IOEIL)       IREF=(IDIM+1)*(IOEIL-1)       DO 210 J=1,2       XPROJ(J,IPP)=XCOOR(IREF+J) 210   CONTINUE       RETURN      ENDIF*  REPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)       IP=ICPR(IOEIL)       IF (IP.EQ.0) RETURN       IREF=(IDIM+1)*(IOEIL-1)       XINT(1)=XCOOR(IREF+1)-XBAR(1)       XINT(2)=XCOOR(IREF+2)-XBAR(2)       XINT(3)=XCOOR(IREF+3)-XBAR(3)       XPROJ(1,IP)=XINT(1)*XMAT(1,1)+XINT(2)*XMAT(2,1)+XINT(3)*XMAT(3,1)       XPROJ(2,IP)=XINT(1)*XMAT(1,2)+XINT(2)*XMAT(2,2)+XINT(3)*XMAT(3,2)       XPROJ(3,IP)=XINT(1)*XMAT(1,3)+XINT(2)*XMAT(2,3)+XINT(3)*XMAT(3,3)       XPROJ(3,IP)=-XPROJ(3,IP)       RETURN 300  CONTINUE      IF (IDIM.EQ.2) THEN       IPP=ICPR(IOEIL)       IREF=(IDIM+1)*(IOEIL-1)       DO 310 J=1,2       XCOOR(IREF+J)=XPROJ(J,IPP) 310   CONTINUE       RETURN      ENDIF*  DEPROJECTION DU POINT IOEIL (NON CE N'EST PAS LE MEME)       IP=ICPR(IOEIL)       IF (IP.EQ.0) RETURN       IREF=(IDIM+1)*(IOEIL-1)       YINT(1)=XPROJ(1,IP)       YINT(2)=XPROJ(2,IP)       YINT(3)=-XPROJ(3,IP)       XINT(1)=YINT(1)*XMAT(1,1)+YINT(2)*XMAT(1,2)+YINT(3)*XMAT(1,3)       XINT(2)=YINT(1)*XMAT(2,1)+YINT(2)*XMAT(2,2)+YINT(3)*XMAT(2,3)       XINT(3)=YINT(1)*XMAT(3,1)+YINT(2)*XMAT(3,2)+YINT(3)*XMAT(3,3)       XINT(1)=XINT(1)+XBAR(1)       XINT(2)=XINT(2)+XBAR(2)       XINT(3)=XINT(3)+XBAR(3)       IF (ABS(XINT(1)-XCOOR(1+IREF)).GE.RPREC.OR.     #     ABS(XINT(2)-XCOOR(2+IREF)).GE.RPREC.OR.     #     ABS(XINT(3)-XCOOR(3+IREF)).GE.RPREC) THEN        XCOOR(1+IREF)=XINT(1)        XCOOR(2+IREF)=XINT(2)        XCOOR(3+IREF)=XINT(3)        IBOUJ(IP)=1       ENDIF       END

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