Télécharger la plaquette Cast3M


fr en

Télécharger pos.eso

Retour à la liste

Numérotation des lignes : 

pos

  1. C POS       SOURCE    CB215821  26/08/24    21:17:51     12622          
  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.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. C
  14.        IND=0
  15.        CALL COIN(IPT1,IP1,IP2,IP3,IP4,N1,N2)
  16.        IF ((IP1.EQ.I1).AND.(IP2.EQ.I2)) IND=1
  17.        IF ((IP2.EQ.I1).AND.(IP1.EQ.I2)) IND=2
  18.        IF ((IP4.EQ.I1).AND.(IP3.EQ.I2)) IND=3
  19.        IF ((IP3.EQ.I1).AND.(IP4.EQ.I2)) IND=4
  20.        IF ((IP2.EQ.I1).AND.(IP3.EQ.I2)) IND=5
  21.        IF ((IP3.EQ.I1).AND.(IP2.EQ.I2)) IND=6
  22.        IF ((IP1.EQ.I1).AND.(IP4.EQ.I2)) IND=7
  23.        IF ((IP4.EQ.I1).AND.(IP1.EQ.I2)) IND=8
  24. 10     IF ((IND.EQ.0).OR.(IND.EQ.1)) RETURN
  25. C
  26. C    CREATION DU POINTEUR IPT2
  27.        NBSOUS=0
  28.        NBREF=IPT1.LISREF(/1)
  29.        NBNN=IPT1.NUM(/1)
  30.        NBELEM=N1*N2
  31.        SEGINI IPT2
  32.        IPT2.ITYPEL=IPT1.ITYPEL
  33. C
  34.        IF (IND.EQ.2) GOTO 20
  35.        IF (IND.EQ.3) GOTO 30
  36.        IF (IND.EQ.4) GOTO 40
  37.        GOTO 50
  38. C
  39. C    RETOURNER LA FACE : <-->
  40. 20     N3=NBNN*5/4+2
  41.        DO 57 I=1,N2
  42.        DO 56 J=1,N1
  43.        DO 25 K=1,NBNN
  44.        K1=MOD(N3-K,NBNN)
  45.        IF (K1.EQ.0) K1=NBNN
  46.        IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,I*N1+1-J)
  47. 25     CONTINUE
  48.    56  CONTINUE
  49.    57  CONTINUE
  50.        IPT3=IPT1.LISREF(1)
  51.        IPT4=IPT1.LISREF(2)
  52.        SEGACT IPT3,IPT4
  53.        CALL INVERS(IPT3,IPT5)
  54.        CALL INVERS(IPT4,IPT6)
  55.        IPT2.LISREF(1)=IPT5
  56.        IPT2.LISREF(4)=IPT6
  57.        SEGDES IPT3,IPT4,IPT5,IPT6
  58.        IPT3=IPT1.LISREF(3)
  59.        IPT4=IPT1.LISREF(4)
  60.        SEGACT IPT3,IPT4
  61.        CALL INVERS(IPT3,IPT5)
  62.        CALL INVERS(IPT4,IPT6)
  63.        IPT2.LISREF(3)=IPT5
  64.        IPT2.LISREF(2)=IPT6
  65.        SEGDES IPT3,IPT4,IPT5,IPT6
  66.        SEGDES IPT1
  67.        IPT1=IPT2
  68.        RETURN
  69. C
  70. C    RETOURNER LA FACE : ^
  71. 30     N3=NBNN*3/4+2
  72.        DO 59 I=1,N2
  73.        DO 58 J=1,N1
  74.        DO 35 K=1,NBNN
  75.        K1=MOD(N3-K,NBNN)
  76.        IF (K1.EQ.0) K1=NBNN
  77.        IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,(N2-I)*N1+J)
  78. 35     CONTINUE
  79.    58  CONTINUE
  80.    59  CONTINUE
  81.        IPT3=IPT1.LISREF(1)
  82.        IPT4=IPT1.LISREF(2)
  83.        SEGACT IPT3,IPT4
  84.        CALL INVERS(IPT3,IPT5)
  85.        CALL INVERS(IPT4,IPT6)
  86.        IPT2.LISREF(3)=IPT5
  87.        IPT2.LISREF(2)=IPT6
  88.        SEGDES IPT3,IPT4,IPT5,IPT6
  89.        IPT3=IPT1.LISREF(3)
  90.        IPT4=IPT1.LISREF(4)
  91.        SEGACT IPT3,IPT4
  92.        CALL INVERS(IPT3,IPT5)
  93.        CALL INVERS(IPT4,IPT6)
  94.        IPT2.LISREF(1)=IPT5
  95.        IPT2.LISREF(4)=IPT6
  96.        SEGDES IPT3,IPT4,IPT5,IPT6
  97.        SEGDES IPT1
  98.        IPT1=IPT2
  99.        RETURN
  100. C
  101. C    RETOURNER LA FACE : X
  102. 40     N3=NBNN/2
  103.        DO 60 I=1,NBELEM
  104.        DO 45 K=1,NBNN
  105.        K1=MOD(K+N3,NBNN)
  106.        IF (K1.EQ.0) K1=NBNN
  107.        IPT2.NUM(K,I)=IPT1.NUM(K1,NBELEM+1-I)
  108. 45     CONTINUE
  109.    60  CONTINUE
  110.        IPT2.LISREF(1)=IPT1.LISREF(3)
  111.        IPT2.LISREF(2)=IPT1.LISREF(4)
  112.        IPT2.LISREF(3)=IPT1.LISREF(1)
  113.        IPT2.LISREF(4)=IPT1.LISREF(2)
  114.        SEGDES IPT1
  115.        IPT1=IPT2
  116.        RETURN
  117. C
  118. C    RETOURNER LA FACE : <-'
  119. 50     N3=NBNN/4
  120.        DO 62 I=1,N1
  121.        DO 61 J=1,N2
  122.        DO 55 K=1,NBNN
  123.        K1=MOD(K+N3,NBNN)
  124.        IF (K1.EQ.0) K1=NBNN
  125.        IPT2.NUM(K,(I-1)*N2+J)=IPT1.NUM(K1,J*N1-I+1)
  126. 55     CONTINUE
  127.    61  CONTINUE
  128.    62  CONTINUE
  129.        IPT2.LISREF(1)=IPT1.LISREF(2)
  130.        IPT2.LISREF(2)=IPT1.LISREF(3)
  131.        IPT2.LISREF(3)=IPT1.LISREF(4)
  132.        IPT2.LISREF(4)=IPT1.LISREF(1)
  133.        SEGDES IPT1
  134.        IPT1=IPT2
  135.        IND=IND-4
  136.        N3=N1
  137.        N1=N2
  138.        N2=N3
  139.        GOTO 10
  140.        END
  141.  
  142.  
  143.  

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