1 : C CTRLE SOURCE CHAT 07/10/29 21:17:39 5940 2 : C 3 : C CETTE PROCEDURE EST UTILISEE PAR PRPAVE POUR LE CONTROLE DES 4 : C ARETES DE L'OBJET; ELLE VERIFIE QUE LE COTE I1 DE IPT1 EST LE 5 : C MEME QUE LE COTE I2 DE IPT2 (IL FAUT I1<=I2). 6 : C IL FAUDRAIT TRAVAILLER SUR LES ELEMENTS ET PAS SUR LES REFERENCES 7 : C QUI NE SONT PAS FORCEMENT DANS L'ORDRE 8 : C 9 : SUBROUTINE CTRLE(IPT1,IPT2,I1,I2) 10 : IMPLICIT INTEGER(I-N) 11 : -INC SMELEME 12 : -INC CCOPTIO 13 : -INC CCGEOME 14 : SEGACT IPT1,IPT2 15 : IPT3=IPT1.LISREF(1) 16 : IPT4=IPT1.LISREF(2) 17 : IPT5=IPT2.LISREF(1) 18 : IPT6=IPT2.LISREF(2) 19 : SEGACT IPT3,IPT4,IPT5,IPT6 20 : NEL1X=IPT3.NUM(/2) 21 : NEL1Y=IPT4.NUM(/2) 22 : NEL2X=IPT5.NUM(/2) 23 : NEL2Y=IPT6.NUM(/2) 24 : SEGDES IPT3,IPT4,IPT5,IPT6 25 : NBN=KDEGRE(IPT1.ITYPEL) 25 : IF (KDEGRE(IPT2.ITYPEL).NE.NBN) CALL ERREUR(264) 26 : NEL=NEL1X 27 : IF (I1.EQ.2.OR.I1.EQ.4) NEL=NEL1Y 28 : NEL2=NEL2X 29 : IF (I2.EQ.2.OR.I2.EQ.4) NEL2=NEL2Y 29 : IF (NEL.NE.NEL2) CALL ERREUR(264) 30 : IF (IERR.NE.0) RETURN 31 : IF (((I1.EQ.1).AND.(I2.EQ.3)).OR.((I1.EQ.1).AND.(I2.EQ.4)).OR. 32 : 1 ((I1.EQ.2).AND.(I2.EQ.3)).OR.((I1.EQ.2).AND.(I2.EQ.4))) GOTO 30 33 : DO 20 J=1,NEL 34 : IF (I1.EQ.1) ITEST1=IPT1.NUM(1,J) 35 : IF (I1.EQ.2) ITEST1=IPT1.NUM(NBN,NEL1X*J) 36 : IF (I1.EQ.3) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y+1-J) 37 : IF (I1.EQ.4) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J*NEL1X) 38 : IF (I2.EQ.1) ITEST2=IPT2.NUM(1,J) 39 : IF (I2.EQ.2) ITEST2=IPT2.NUM(NBN,NEL2X*J) 40 : IF (I2.EQ.3) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y+1-J) 41 : IF (I2.EQ.4) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J*NEL2X) 41 : IF (ITEST1.NE.ITEST2) CALL ERREUR(264) 42 : IF (IERR.NE.0) RETURN 43 : IF (I1.EQ.1) ITEST1=IPT1.NUM(NBN,J) 44 : IF (I1.EQ.2) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*J) 45 : IF (I1.EQ.3) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J) 46 : IF (I1.EQ.4) ITEST1=IPT1.NUM(1,NEL1X*NEL1Y+1-J*NEL1X) 47 : IF (I2.EQ.1) ITEST2=IPT2.NUM(NBN,J) 48 : IF (I2.EQ.2) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*J) 49 : IF (I2.EQ.3) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J) 50 : IF (I2.EQ.4) ITEST2=IPT2.NUM(1,NEL2X*NEL2Y+1-J*NEL2X) 50 : IF (ITEST1.NE.ITEST2) CALL ERREUR(264) 51 : IF (IERR.NE.0) RETURN 52 : 20 CONTINUE 53 : SEGDES IPT3,IPT4 54 : RETURN 55 : 30 DO 40 J=1,NEL 56 : IF (I1.EQ.1) ITEST1=IPT1.NUM(1,J) 57 : IF (I1.EQ.2) ITEST1=IPT1.NUM(NBN,NEL1X*J) 58 : IF (I1.EQ.3) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y+1-J) 59 : IF (I1.EQ.4) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J*NEL1X) 60 : IF (I2.EQ.1) ITEST2=IPT2.NUM(NBN,NEL2X+1-J) 61 : IF (I2.EQ.2) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y-(J-1)*NEL2X) 62 : IF (I2.EQ.3) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*(NEL2Y-1)+J) 63 : IF (I2.EQ.4) ITEST2=IPT2.NUM(1,(J-1)*NEL2X+1) 63 : IF (ITEST1.NE.ITEST2) CALL ERREUR(264) 64 : IF (IERR.NE.0) RETURN 65 : IF (I1.EQ.1) ITEST1=IPT1.NUM(NBN,NEL1X+1-J) 66 : IF (I1.EQ.2) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y-(J-1)*NEL1X) 67 : IF (I1.EQ.3) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*(NEL1Y-1)+J) 68 : IF (I1.EQ.4) ITEST1=IPT1.NUM(1,(J-1)*NEL1X+1) 69 : IF (I2.EQ.1) ITEST2=IPT2.NUM(1,J) 70 : IF (I2.EQ.2) ITEST2=IPT2.NUM(NBN,NEL2X*J) 71 : IF (I2.EQ.3) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y+1-J) 72 : IF (I2.EQ.4) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J*NEL2X) 72 : IF (ITEST1.NE.ITEST2) CALL ERREUR(264) 73 : IF (IERR.NE.0) RETURN 74 : 40 CONTINUE 75 : SEGDES IPT3,IPT4 76 : RETURN 77 : END 78 : 79 : 80 : 81 : 82 : 83 : 84 :
© Cast3M 2003 - All rights reserved.
Disclaimer