Télécharger la plaquette Cast3M


fr en

Télécharger g2copy.eso

Retour à la liste

Numérotation des lignes : 

g2copy

  1. C G2COPY    SOURCE    CHAT      05/01/13    00:14:24     5004
  2. C
  3. C
  4.       SUBROUTINE G2COPY(IGR1,NBCOL1,NBLIG1,IOP,
  5.      >                  IGR2,NBCOL2,NBLIG2 )
  6. C     **********************************************************************
  7. C     OBJET G2COPY : COPIE ET REORIENTE UNE GRILLE
  8. C
  9. C     EN ENTREE   :
  10. C       IGR1(NBCOL1,NBLIG1) : TABLEAU D'INDICES DES NOEUDS (LA GRILLE)
  11. C
  12. C       IOP  :CODE DONNANT LA TRANSFORMATION A APPLIQUER A LA GRILLE
  13. C            -1 = INVERSION DES LIGNES ET DES COLONNES
  14. C             (1,2,3,4) = LES 4 ROTATIONS :
  15. C             1 = IDENTITE (COPIE SIMPLE)
  16. C             2 = (1,1) DOIT PASSER EN (NBCOL,1)
  17. C             3 = (1,1) DOIT PASSER EN (NBCOL,NBLIG)
  18. C             4 = (1,1) DOIT PASSER EN (1,NBLIG)
  19. C
  20. C     EN SORTIE   :
  21. C       IGR2(NBCOL2,NBLIG2) : TABLEAU D'INDICES DES NOEUDS (LA GRILLE)
  22. C
  23. C     **********************************************************************
  24.       IMPLICIT INTEGER(I-N)
  25.       INTEGER IGR1(*),NBCOL1,NBLIG1
  26.       INTEGER IOP
  27.       INTEGER IGR2(*),NBCOL2,NBLIG2
  28. C
  29.       INTEGER I1,I2,J1,J2
  30. C
  31.       GOTO (50,100,150,200) IOP
  32. C
  33. C       ---- (-1) INVERSION DES LIGNES ET DES COLONNES ---
  34. C
  35.         NBLIG2 = NBCOL1
  36.         NBCOL2 = NBLIG1
  37.         DO 30 I2=1,NBCOL2
  38.           DO 30 J2=1,NBLIG2
  39.             I1 = J2
  40.             J1 = I2
  41.             IGR2((J2-1)*NBCOL2+I2) = IGR1((J1-1)*NBCOL1+I1)
  42.    20     CONTINUE
  43.    30   CONTINUE
  44.         GOTO 9999
  45. C
  46. C       ---- (1) IDENTITE : COPIE SIMPLE ---
  47. C
  48.    50   NBLIG2 = NBLIG1
  49.         NBCOL2 = NBCOL1
  50.         DO 70 I2=1,NBCOL2
  51.           DO 60 J2=1,NBLIG2
  52.             I1 = I2
  53.             J1 = J2
  54.             IGR2((J2-1)*NBCOL2+I2) = IGR1((J1-1)*NBCOL1+I1)
  55.    60     CONTINUE
  56.    70   CONTINUE
  57.         GOTO 9999
  58. C
  59. C       ---- (2) I2 = J1, J2 = -I1 ---
  60. C
  61.   100   NBLIG2 = NBCOL1
  62.         NBCOL2 = NBLIG1
  63.         DO 120 I2=1,NBCOL2
  64.           DO 110 J2=1,NBLIG2
  65.             I1 = NBCOL1+1-J2
  66.             J1 = I2
  67.             IGR2((J2-1)*NBCOL2+I2) = IGR1((J1-1)*NBCOL1+I1)
  68.   110     CONTINUE
  69.   120   CONTINUE
  70.         GOTO 9999
  71. C
  72. C       ---- (3) I2 = -I1, J2 = -J1 ---
  73. C
  74.   150   NBLIG2 = NBLIG1
  75.         NBCOL2 = NBCOL1
  76.         DO 170 I2=1,NBCOL2
  77.           DO 160 J2=1,NBLIG2
  78.             I1 = NBCOL1+1-I2
  79.             J1 = NBLIG1+1-J2
  80.             IGR2((J2-1)*NBCOL2+I2) = IGR1((J1-1)*NBCOL1+I1)
  81.   160     CONTINUE
  82.   170   CONTINUE
  83.         GOTO 9999
  84. C
  85. C       ---- (4) I2 = -J1, J2 = I1 ---
  86. C
  87.   200   NBLIG2 = NBCOL1
  88.         NBCOL2 = NBLIG1
  89.         DO 220 I2=1,NBCOL2
  90.           DO 210 J2=1,NBLIG2
  91.             I1 = J2
  92.             J1 = NBLIG1+1-I2
  93.             IGR2((J2-1)*NBCOL2+I2) = IGR1((J1-1)*NBCOL1+I1)
  94.   210     CONTINUE
  95.   220   CONTINUE
  96.         GOTO 9999
  97. C
  98.  9999 END
  99.  
  100.  
  101.  

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