Télécharger pos.eso

Retour à la liste

pos
C POS       SOURCE    CHAT      05/01/13    02:18:05     5004
C
C     CETTE PROCEDURE RENVOIE IND=1 SI LES EXTREMITES D'UN COTE DE LA
C     FACE (POINTEE PAR IPT1) SONT EGALES A I1I2 ET ORIENTE LA FACE
C     POUR QUE SON COTE 1 SOIT I1I2; ELLE RENVOIE IND=0 SINON.
C
       SUBROUTINE POS(IPT1,I1,I2,IND)
      IMPLICIT INTEGER(I-N)
-INC SMELEME
 
-INC PPARAM
-INC CCOPTIO
C
       IND=0
       CALL COIN(IPT1,IP1,IP2,IP3,IP4,N1,N2)
       IF ((IP1.EQ.I1).AND.(IP2.EQ.I2)) IND=1
       IF ((IP2.EQ.I1).AND.(IP1.EQ.I2)) IND=2
       IF ((IP4.EQ.I1).AND.(IP3.EQ.I2)) IND=3
       IF ((IP3.EQ.I1).AND.(IP4.EQ.I2)) IND=4
       IF ((IP2.EQ.I1).AND.(IP3.EQ.I2)) IND=5
       IF ((IP3.EQ.I1).AND.(IP2.EQ.I2)) IND=6
       IF ((IP1.EQ.I1).AND.(IP4.EQ.I2)) IND=7
       IF ((IP4.EQ.I1).AND.(IP1.EQ.I2)) IND=8
10     IF ((IND.EQ.0).OR.(IND.EQ.1)) RETURN
C
C    CREATION DU POINTEUR IPT2
       NBSOUS=0
       NBREF=IPT1.LISREF(/1)
       NBNN=IPT1.NUM(/1)
       NBELEM=N1*N2
       SEGINI IPT2
       IPT2.ITYPEL=IPT1.ITYPEL
C
       IF (IND.EQ.2) GOTO 20
       IF (IND.EQ.3) GOTO 30
       IF (IND.EQ.4) GOTO 40
       GOTO 50
C
C    RETOURNER LA FACE : <-->
20     N3=NBNN*5/4+2
       DO 25 I=1,N2
       DO 25 J=1,N1
       DO 25 K=1,NBNN
       K1=MOD(N3-K,NBNN)
       IF (K1.EQ.0) K1=NBNN
       IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,I*N1+1-J)
25     CONTINUE
       IPT3=IPT1.LISREF(1)
       IPT4=IPT1.LISREF(2)
       SEGACT IPT3,IPT4
       CALL INVERS(IPT3,IPT5)
       CALL INVERS(IPT4,IPT6)
       IPT2.LISREF(1)=IPT5
       IPT2.LISREF(4)=IPT6
       SEGDES IPT3,IPT4,IPT5,IPT6
       IPT3=IPT1.LISREF(3)
       IPT4=IPT1.LISREF(4)
       SEGACT IPT3,IPT4
       CALL INVERS(IPT3,IPT5)
       CALL INVERS(IPT4,IPT6)
       IPT2.LISREF(3)=IPT5
       IPT2.LISREF(2)=IPT6
       SEGDES IPT3,IPT4,IPT5,IPT6
       SEGDES IPT1
       IPT1=IPT2
       RETURN
C
C    RETOURNER LA FACE : ^
30     N3=NBNN*3/4+2
       DO 35 I=1,N2
       DO 35 J=1,N1
       DO 35 K=1,NBNN
       K1=MOD(N3-K,NBNN)
       IF (K1.EQ.0) K1=NBNN
       IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,(N2-I)*N1+J)
35     CONTINUE
       IPT3=IPT1.LISREF(1)
       IPT4=IPT1.LISREF(2)
       SEGACT IPT3,IPT4
       CALL INVERS(IPT3,IPT5)
       CALL INVERS(IPT4,IPT6)
       IPT2.LISREF(3)=IPT5
       IPT2.LISREF(2)=IPT6
       SEGDES IPT3,IPT4,IPT5,IPT6
       IPT3=IPT1.LISREF(3)
       IPT4=IPT1.LISREF(4)
       SEGACT IPT3,IPT4
       CALL INVERS(IPT3,IPT5)
       CALL INVERS(IPT4,IPT6)
       IPT2.LISREF(1)=IPT5
       IPT2.LISREF(4)=IPT6
       SEGDES IPT3,IPT4,IPT5,IPT6
       SEGDES IPT1
       IPT1=IPT2
       RETURN
C
C    RETOURNER LA FACE : X
40     N3=NBNN/2
       DO 45 I=1,NBELEM
       DO 45 K=1,NBNN
       K1=MOD(K+N3,NBNN)
       IF (K1.EQ.0) K1=NBNN
       IPT2.NUM(K,I)=IPT1.NUM(K1,NBELEM+1-I)
45     CONTINUE
       IPT2.LISREF(1)=IPT1.LISREF(3)
       IPT2.LISREF(2)=IPT1.LISREF(4)
       IPT2.LISREF(3)=IPT1.LISREF(1)
       IPT2.LISREF(4)=IPT1.LISREF(2)
       SEGDES IPT1
       IPT1=IPT2
       RETURN
C
C    RETOURNER LA FACE : <-'
50     N3=NBNN/4
       DO 55 I=1,N1
       DO 55 J=1,N2
       DO 55 K=1,NBNN
       K1=MOD(K+N3,NBNN)
       IF (K1.EQ.0) K1=NBNN
       IPT2.NUM(K,(I-1)*N2+J)=IPT1.NUM(K1,J*N1-I+1)
55     CONTINUE
       IPT2.LISREF(1)=IPT1.LISREF(2)
       IPT2.LISREF(2)=IPT1.LISREF(3)
       IPT2.LISREF(3)=IPT1.LISREF(4)
       IPT2.LISREF(4)=IPT1.LISREF(1)
       SEGDES IPT1
       IPT1=IPT2
       IND=IND-4
       N3=N1
       N1=N2
       N2=N3
       GOTO 10
       END
 
 

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