Numérotation des lignes :

C DEDU2     SOURCE    PV        13/04/12    21:15:30     7756C DEDU2CC VERIFIE QUE LES POINTS DE LA GEOMETRIE ELEMENTAIRE IPT7C SONT BIEN POINTES DANS ICP1C APPELE PAR PROPER, POUR EXECUTION OPTIONS 'TRANS' ET 'ROTA' DE DEDUCC VERIFIE POUR DEDU ROTA QUE LES POINTS IMAGES SUPPOSES CORRESPONDENTC EGALEMENT A LA ROTATION DES POINTS ANTECEDENTS POUR L ANGLE ET L AXEC SPECIFIESC  97/11 : KICH       SUBROUTINE DEDU2(IPT7,ICP1,IRETOU,ITYP)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)-INC CCOPTIO-INC SMCOORD-INC SMELEME      SEGMENT ICP1(XCOOR(/1)/(IDIM+1))      COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,     #   ZVEC,ANGLE,ICLE         IF (ITYP.EQ.5) SEGACT MCOORD        IRETOU=0        SEGINI,IPT3=IPT7        IF (IPT3.LISOUS(/1).NE.0) THEN          IRETOU = 10* on ne verifie que les geometries elementaires (dedu2)          CALL ERREUR(879)          GOTO 200        ENDIF        CALL CHANGE(IPT3,1)        SEGACT ICP1        N = IPT3.NUM(/2)        DO IJN=1,N*      write(6,*)'noeud',IPT3.NUM(1,IJN),'pointe',ICP1(IPT3.NUM(1,IJN))          IF (ICP1(IPT3.NUM(1,IJN)).EQ.0) THEN            IRETOU=20            GOTO 100          ENDIFc verification pour ROTA          IF (ITYP.EQ.5) THENc image par la rotation      IREF=IPT3.NUM(1,IJN)*(IDIM+1)      IREF=IREF-IDIM      XD=XCOOR(IREF)-XPT1      YD=XCOOR(IREF+1)-YPT1      ZD=XCOOR(IREF+2)-ZPT1      IF (IDIM.EQ.2) ZD=0.      XDENS=XCOOR(IREF+IDIM)      CO=COS(ANGLE)      SI=SIN(ANGLE)      XE=XD*XV1+YD*YV1+ZD*ZV1      YE=XD*XV2+YD*YV2+ZD*ZV2      ZE=XD*XVEC+YD*YVEC+ZD*ZVEC      XD=XE*CO-YE*SI      YD=XE*SI+YE*CO      ZD=ZE      XIMA=XD*XV1+YD*XV2+ZD*XVEC+XPT1      YIMA=XD*YV1+YD*YV2+ZD*YVEC+YPT1      IF (IDIM.NE.2) ZIMA=XD*ZV1+YD*ZV2+ZD*ZVEC+ZPT1c image pointee      IREF=ICP1(IPT3.NUM(1,IJN))*(IDIM+1)      IREF=IREF-IDIM      XPOIN=XCOOR(IREF)      YPOIN=XCOOR(IREF+1)      ZPOIN=XCOOR(IREF+2)            DELTX = ABS(XIMA - XPOIN)            DELTY = ABS(YIMA - YPOIN)            IF (IDIM.EQ.3) DELTZ = ABS(ZIMA - ZPOIN)            IF (IDIM.LT.3) THEN              IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))     2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))) THEN                CONTINUE              ELSE                CALL ERREUR(885)                RETURN              ENDIF            ELSE IF (IDIM.EQ.3) THEN              IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))     2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))     3.AND.(DELTZ.LE.(1.E-4*ABS(ZPOIN)))) THEN                CONTINUE              ELSE                CALL ERREUR(885)                RETURN              ENDIF            ENDIF          ENDIF        ENDDO  100  CONTINUE       SEGDES ICP1   200  CONTINUE       RETURN       END

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