Télécharger la plaquette Cast3M


fr en

Télécharger dedu2.eso

Retour à la liste

Numérotation des lignes : 

dedu2

  1. C DEDU2     SOURCE    SP204843  24/03/15    21:15:03     11871          
  2. C DEDU2
  3. C
  4. C VERIFIE QUE LES POINTS DE LA GEOMETRIE ELEMENTAIRE IPT7
  5. C SONT BIEN POINTES DANS ICP1
  6. C APPELE PAR PROPER, POUR EXECUTION OPTIONS 'TRANS' ET 'ROTA' DE DEDU
  7. C
  8. C VERIFIE POUR DEDU ROTA QUE LES POINTS IMAGES SUPPOSES CORRESPONDENT
  9. C EGALEMENT A LA ROTATION DES POINTS ANTECEDENTS POUR L ANGLE ET L AXE
  10. C SPECIFIES
  11. C  97/11 : KICH
  12.        SUBROUTINE DEDU2(IPT7,ICP1,IRETOU,ITYP)
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8 (A-H,O-Z)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC SMCOORD
  19. -INC SMELEME
  20.       SEGMENT ICP1(nbpts)
  21.       COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,
  22.      #   ZVEC,ANGLE,ICLE,XP1,YP1,ZP1
  23.  
  24.         IF (ITYP.EQ.5) SEGACT MCOORD
  25.         IRETOU=0
  26.         SEGINI,IPT3=IPT7
  27.         IF (IPT3.LISOUS(/1).NE.0) THEN
  28.           IRETOU = 10
  29. * on ne verifie que les geometries elementaires (dedu2)
  30.           CALL ERREUR(879)
  31.           GOTO 200
  32.         ENDIF
  33.         CALL CHANGE(IPT3,1)
  34.         SEGACT ICP1
  35.         N = IPT3.NUM(/2)
  36.         DO IJN=1,N
  37. *      write(6,*)'noeud',IPT3.NUM(1,IJN),'pointe',ICP1(IPT3.NUM(1,IJN))
  38.           IF (ICP1(IPT3.NUM(1,IJN)).EQ.0) THEN
  39.             IRETOU=20
  40.             GOTO 100
  41.           ENDIF
  42. c verification pour ROTA
  43.           IF (ITYP.EQ.5) THEN
  44. c image par la rotation
  45.       IREF=IPT3.NUM(1,IJN)*(IDIM+1)
  46.       IREF=IREF-IDIM
  47.       XD=XCOOR(IREF)-XPT1
  48.       YD=XCOOR(IREF+1)-YPT1
  49.       ZD=XCOOR(IREF+2)-ZPT1
  50.       IF (IDIM.EQ.2) ZD=0.
  51.       XDENS=XCOOR(IREF+IDIM)
  52.       CO=COS(ANGLE)
  53.       SI=SIN(ANGLE)
  54.       XE=XD*XV1+YD*YV1+ZD*ZV1
  55.       YE=XD*XV2+YD*YV2+ZD*ZV2
  56.       ZE=XD*XVEC+YD*YVEC+ZD*ZVEC
  57.       XD=XE*CO-YE*SI
  58.       YD=XE*SI+YE*CO
  59.       ZD=ZE
  60.       XIMA=XD*XV1+YD*XV2+ZD*XVEC+XPT1
  61.       YIMA=XD*YV1+YD*YV2+ZD*YVEC+YPT1
  62.       IF (IDIM.NE.2) ZIMA=XD*ZV1+YD*ZV2+ZD*ZVEC+ZPT1
  63. c image pointee
  64.       IREF=ICP1(IPT3.NUM(1,IJN))*(IDIM+1)
  65.       IREF=IREF-IDIM
  66.       XPOIN=XCOOR(IREF)
  67.       YPOIN=XCOOR(IREF+1)
  68.       ZPOIN=XCOOR(IREF+2)
  69.             DELTX = ABS(XIMA - XPOIN)
  70.             DELTY = ABS(YIMA - YPOIN)
  71.             IF (IDIM.EQ.3) DELTZ = ABS(ZIMA - ZPOIN)
  72.             IF (IDIM.LT.3) THEN
  73.               IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))
  74.      2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))) THEN
  75.                 CONTINUE
  76.               ELSE
  77.                 CALL ERREUR(885)
  78.                 RETURN
  79.               ENDIF
  80.             ELSE IF (IDIM.EQ.3) THEN
  81.               IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))
  82.      2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))
  83.      3.AND.(DELTZ.LE.(1.E-4*ABS(ZPOIN)))) THEN
  84.                 CONTINUE
  85.               ELSE
  86.                 CALL ERREUR(885)
  87.                 RETURN
  88.               ENDIF
  89.             ENDIF
  90.           ENDIF
  91.         ENDDO
  92.   100  CONTINUE
  93.        SEGDES ICP1
  94.  
  95.   200  CONTINUE
  96.        RETURN
  97.        END
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  

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