1 : C DEDU2 SOURCE PV 13/04/12 21:15:30 7756 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 : -INC CCOPTIO 16 : -INC SMCOORD 17 : -INC SMELEME 18 : SEGMENT ICP1(XCOOR(/1)/(IDIM+1)) 19 : COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC, 20 : # ZVEC,ANGLE,ICLE 21 : 22 : IF (ITYP.EQ.5) SEGACT MCOORD 23 : IRETOU=0 24 : SEGINI,IPT3=IPT7 25 : IF (IPT3.LISOUS(/1).NE.0) THEN 26 : IRETOU = 10 27 : * on ne verifie que les geometries elementaires (dedu2) 27 : CALL ERREUR(879) 28 : GOTO 200 29 : ENDIF 29 : CALL CHANGE(IPT3,1) 30 : SEGACT ICP1 31 : N = IPT3.NUM(/2) 32 : DO IJN=1,N 33 : * write(6,*)'noeud',IPT3.NUM(1,IJN),'pointe',ICP1(IPT3.NUM(1,IJN)) 34 : IF (ICP1(IPT3.NUM(1,IJN)).EQ.0) THEN 35 : IRETOU=20 36 : GOTO 100 37 : ENDIF 38 : c verification pour ROTA 39 : IF (ITYP.EQ.5) THEN 40 : c image par la rotation 41 : IREF=IPT3.NUM(1,IJN)*(IDIM+1) 42 : IREF=IREF-IDIM 43 : XD=XCOOR(IREF)-XPT1 44 : YD=XCOOR(IREF+1)-YPT1 45 : ZD=XCOOR(IREF+2)-ZPT1 46 : IF (IDIM.EQ.2) ZD=0. 47 : XDENS=XCOOR(IREF+IDIM) 48 : CO=COS(ANGLE) 49 : SI=SIN(ANGLE) 50 : XE=XD*XV1+YD*YV1+ZD*ZV1 51 : YE=XD*XV2+YD*YV2+ZD*ZV2 52 : ZE=XD*XVEC+YD*YVEC+ZD*ZVEC 53 : XD=XE*CO-YE*SI 54 : YD=XE*SI+YE*CO 55 : ZD=ZE 56 : XIMA=XD*XV1+YD*XV2+ZD*XVEC+XPT1 57 : YIMA=XD*YV1+YD*YV2+ZD*YVEC+YPT1 58 : IF (IDIM.NE.2) ZIMA=XD*ZV1+YD*ZV2+ZD*ZVEC+ZPT1 59 : c image pointee 60 : IREF=ICP1(IPT3.NUM(1,IJN))*(IDIM+1) 61 : IREF=IREF-IDIM 62 : XPOIN=XCOOR(IREF) 63 : YPOIN=XCOOR(IREF+1) 64 : ZPOIN=XCOOR(IREF+2) 65 : DELTX = ABS(XIMA - XPOIN) 66 : DELTY = ABS(YIMA - YPOIN) 67 : IF (IDIM.EQ.3) DELTZ = ABS(ZIMA - ZPOIN) 68 : IF (IDIM.LT.3) THEN 69 : IF ((DELTX.LE.(1.E-4*ABS(XPOIN))) 70 : 2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))) THEN 71 : CONTINUE 72 : ELSE 72 : CALL ERREUR(885) 73 : RETURN 74 : ENDIF 75 : ELSE IF (IDIM.EQ.3) THEN 76 : IF ((DELTX.LE.(1.E-4*ABS(XPOIN))) 77 : 2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN))) 78 : 3.AND.(DELTZ.LE.(1.E-4*ABS(ZPOIN)))) THEN 79 : CONTINUE 80 : ELSE 80 : CALL ERREUR(885) 81 : RETURN 82 : ENDIF 83 : ENDIF 84 : ENDIF 85 : ENDDO 86 : 100 CONTINUE 87 : SEGDES ICP1 88 : 89 : 200 CONTINUE 90 : RETURN 91 : END 92 : 93 : 94 : 95 :
© Cast3M 2003 - All rights reserved.
Disclaimer