Download g2copy.eso

Back to the list

   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 :  

© Cast3M 2003 - All rights reserved.
Disclaimer