1 : C POS SOURCE CHAT 05/01/13 02:18:05 5004 2 : C 3 : C CETTE PROCEDURE RENVOIE IND=1 SI LES EXTREMITES D'UN COTE DE LA 4 : C FACE (POINTEE PAR IPT1) SONT EGALES A I1I2 ET ORIENTE LA FACE 5 : C POUR QUE SON COTE 1 SOIT I1I2; ELLE RENVOIE IND=0 SINON. 6 : C 7 : SUBROUTINE POS(IPT1,I1,I2,IND) 8 : IMPLICIT INTEGER(I-N) 9 : -INC SMELEME 10 : -INC CCOPTIO 11 : C 12 : IND=0 12 : CALL COIN(IPT1,IP1,IP2,IP3,IP4,N1,N2) 13 : IF ((IP1.EQ.I1).AND.(IP2.EQ.I2)) IND=1 14 : IF ((IP2.EQ.I1).AND.(IP1.EQ.I2)) IND=2 15 : IF ((IP4.EQ.I1).AND.(IP3.EQ.I2)) IND=3 16 : IF ((IP3.EQ.I1).AND.(IP4.EQ.I2)) IND=4 17 : IF ((IP2.EQ.I1).AND.(IP3.EQ.I2)) IND=5 18 : IF ((IP3.EQ.I1).AND.(IP2.EQ.I2)) IND=6 19 : IF ((IP1.EQ.I1).AND.(IP4.EQ.I2)) IND=7 20 : IF ((IP4.EQ.I1).AND.(IP1.EQ.I2)) IND=8 21 : 10 IF ((IND.EQ.0).OR.(IND.EQ.1)) RETURN 22 : C 23 : C CREATION DU POINTEUR IPT2 24 : NBSOUS=0 25 : NBREF=IPT1.LISREF(/1) 26 : NBNN=IPT1.NUM(/1) 27 : NBELEM=N1*N2 28 : SEGINI IPT2 29 : IPT2.ITYPEL=IPT1.ITYPEL 30 : C 31 : IF (IND.EQ.2) GOTO 20 32 : IF (IND.EQ.3) GOTO 30 33 : IF (IND.EQ.4) GOTO 40 34 : GOTO 50 35 : C 36 : C RETOURNER LA FACE : <--> 37 : 20 N3=NBNN*5/4+2 38 : DO 25 I=1,N2 39 : DO 25 J=1,N1 40 : DO 25 K=1,NBNN 41 : K1=MOD(N3-K,NBNN) 42 : IF (K1.EQ.0) K1=NBNN 43 : IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,I*N1+1-J) 44 : 25 CONTINUE 45 : IPT3=IPT1.LISREF(1) 46 : IPT4=IPT1.LISREF(2) 47 : SEGACT IPT3,IPT4 47 : CALL INVERS(IPT3,IPT5) 47 : CALL INVERS(IPT4,IPT6) 48 : IPT2.LISREF(1)=IPT5 49 : IPT2.LISREF(4)=IPT6 50 : SEGDES IPT3,IPT4,IPT5,IPT6 51 : IPT3=IPT1.LISREF(3) 52 : IPT4=IPT1.LISREF(4) 53 : SEGACT IPT3,IPT4 53 : CALL INVERS(IPT3,IPT5) 53 : CALL INVERS(IPT4,IPT6) 54 : IPT2.LISREF(3)=IPT5 55 : IPT2.LISREF(2)=IPT6 56 : SEGDES IPT3,IPT4,IPT5,IPT6 57 : SEGDES IPT1 58 : IPT1=IPT2 59 : RETURN 60 : C 61 : C RETOURNER LA FACE : ^ 62 : 30 N3=NBNN*3/4+2 63 : DO 35 I=1,N2 64 : DO 35 J=1,N1 65 : DO 35 K=1,NBNN 66 : K1=MOD(N3-K,NBNN) 67 : IF (K1.EQ.0) K1=NBNN 68 : IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,(N2-I)*N1+J) 69 : 35 CONTINUE 70 : IPT3=IPT1.LISREF(1) 71 : IPT4=IPT1.LISREF(2) 72 : SEGACT IPT3,IPT4 72 : CALL INVERS(IPT3,IPT5) 72 : CALL INVERS(IPT4,IPT6) 73 : IPT2.LISREF(3)=IPT5 74 : IPT2.LISREF(2)=IPT6 75 : SEGDES IPT3,IPT4,IPT5,IPT6 76 : IPT3=IPT1.LISREF(3) 77 : IPT4=IPT1.LISREF(4) 78 : SEGACT IPT3,IPT4 78 : CALL INVERS(IPT3,IPT5) 78 : CALL INVERS(IPT4,IPT6) 79 : IPT2.LISREF(1)=IPT5 80 : IPT2.LISREF(4)=IPT6 81 : SEGDES IPT3,IPT4,IPT5,IPT6 82 : SEGDES IPT1 83 : IPT1=IPT2 84 : RETURN 85 : C 86 : C RETOURNER LA FACE : X 87 : 40 N3=NBNN/2 88 : DO 45 I=1,NBELEM 89 : DO 45 K=1,NBNN 90 : K1=MOD(K+N3,NBNN) 91 : IF (K1.EQ.0) K1=NBNN 92 : IPT2.NUM(K,I)=IPT1.NUM(K1,NBELEM+1-I) 93 : 45 CONTINUE 94 : IPT2.LISREF(1)=IPT1.LISREF(3) 95 : IPT2.LISREF(2)=IPT1.LISREF(4) 96 : IPT2.LISREF(3)=IPT1.LISREF(1) 97 : IPT2.LISREF(4)=IPT1.LISREF(2) 98 : SEGDES IPT1 99 : IPT1=IPT2 100 : RETURN 101 : C 102 : C RETOURNER LA FACE : <-' 103 : 50 N3=NBNN/4 104 : DO 55 I=1,N1 105 : DO 55 J=1,N2 106 : DO 55 K=1,NBNN 107 : K1=MOD(K+N3,NBNN) 108 : IF (K1.EQ.0) K1=NBNN 109 : IPT2.NUM(K,(I-1)*N2+J)=IPT1.NUM(K1,J*N1-I+1) 110 : 55 CONTINUE 111 : IPT2.LISREF(1)=IPT1.LISREF(2) 112 : IPT2.LISREF(2)=IPT1.LISREF(3) 113 : IPT2.LISREF(3)=IPT1.LISREF(4) 114 : IPT2.LISREF(4)=IPT1.LISREF(1) 115 : SEGDES IPT1 116 : IPT1=IPT2 117 : IND=IND-4 118 : N3=N1 119 : N1=N2 120 : N2=N3 121 : GOTO 10 122 : END 123 :
© Cast3M 2003 - All rights reserved.
Disclaimer