Esope source files

   1 : C G2ORAC    SOURCE    CHAT      06/03/29    21:22:04     5360           
   2 : C
   3 :       SUBROUTINE G2ORAC(IGR1,NBCOL1,NBLIG1,COORD,IDIMC,N1,VK,
   4 :      >                  ITVL,NTIMAX,iarr )
   5 : C     **********************************************************************
   6 : C     OBJET G2ORAC : REORIENTE UNE GRILLE GEOMETRIQUE
   7 : C
   8 : C     EN ENTREE   :  
   9 : C       IGR1(NBCOL1,NBLIG1) : TABLEAU D'INDICES DES NOEUDS (LA GRILLE)
  10 : C       IDIMC : DIMENSION DE L'ESPACE (=3)
  11 : C       COORD : TABLEAU DES COORDONNEES DES NOEUDS
  12 : C       
  13 : C       N1    : ORIGINE SOUHAITE DE LA GRILLE IGR1(1,1) = IORIG
  14 : C               SI N1=0 ON N'IMPOSE PAS L'ORIGINE
  15 : C       VK    : ORIENTATION DE LA GRILLE, DIRECTION SOUHAITE EN N1
  16 : C               SI IDIMC = 0, ON N'IMPOSE PAS D'ORIENTATION.
  17 : C
  18 : C       ITVL  : TABLEAU DE TRAVAIL (ENTIERS)
  19 : C       NITMAX: TAILLE DU TABLEAU ITVL
  20 : C               ON A BESOIN DU TABLEAU DE TRAVAIL SEULEMENT SI ON CHANGE
  21 : C               SIMULTANEMENT L'ORIGINE ET L'ORIENTATION. LA PLACE NECES-
  22 : C               SAIRE EST DE / NBCOL1*NBLIG1
  23 : C
  24 : C     EN SORTIE   :
  25 : C       IGR1(NBCOL1,NBLIG1) : TABLEAU D'INDICES MODIFIES
  26 : C       iarr  : CODE D'ERREUR
  27 : C
  28 : C     APPELS : G2ORIG, G2ORIE
  29 : C     **********************************************************************
  30 :       IMPLICIT INTEGER(I-N)
  31 :       INTEGER IGR1(*),NBCOL1,NBLIG1
  32 :       REAL*8    COORD(*),VK(*)
  33 :       INTEGER IDIMC,N1,ITVL(*),NTIMAX,iarr
  34 : C
  35 :       INTEGER IOP1,IOP2,NBCOL2,NBLIG2
  36 : C
  37 :       iarr = 0
  38 : C
  39 : C     --- CALCUL DE L'ORIGINE ---
  40 : C
  41 :       IF( N1.GT.0 )THEN
  41 :          CALL G2ORIG(IGR1,NBCOL1,NBLIG1,N1,IOP1 )
  42 :          IF( IOP1.EQ. 0 )THEN
  43 :            iarr = -1
  43 :            CALL DSERRE(1,iarr,'G2ORAC',' APPEL G2ORIG')        
  43 :            CALL DSERRE(1,iarr,'G2ORAC',' TRANSFORMATION INCONNUE')        
  44 :            GOTO 9999
  45 :          ENDIF
  46 :       ELSE
  47 :          IOP1 = 1
  48 :       ENDIF
  49 : 
  50 : C
  51 :       IF( IOP1.NE.1 )THEN   
  52 : C
  53 : C     --- CHANGEMENT D'ORIGINE ---
  54 : C
  55 :         IF( (NBCOL1*NBLIG1).GT.NTIMAX )THEN
  56 :           iarr = -2
  56 :           CALL DSERRE(1,iarr,'G2ORAC','TABLEAU D ENTIER')        
  57 :           GOTO 9999
  58 :         ENDIF   
  58 :         CALL G2COPY(IGR1,NBCOL1,NBLIG1,IOP1,ITVL,NBCOL2,NBLIG2 )
  59 :         IF( IDIMC.GT.0 )THEN
  60 : C
  60 :           CALL G2ORIE(ITVL,NBCOL2,NBLIG2,IDIMC,COORD,VK,IOP2 )
  61 :           IF( IOP2.EQ. 0 )THEN
  62 : C          --- ON RECOPIE MEME SI LE TRAVAIL N'EST PAS FINI ---
  63 :            IOP2 = 1
  63 :            CALL G2COPY(ITVL,NBCOL2,NBLIG2,IOP2,
  64 :      >                     IGR1,NBCOL1,NBLIG1 )
  65 :             iarr = -1
  65 :             CALL DSERRE(1,iarr,'G2ORAC',' APPEL G2ORIE')        
  65 :             CALL DSERRE(1,iarr,'G2ORAC',' TRANSFORMATION INCONNUE')        
  66 :             GOTO 9999
  67 :           ENDIF
  68 :        ELSE
  69 : C       --- ON NE SOUHAITE PAS CHANGER L'ORIENTATION ---
  70 :          IOP2 = 1
  71 :        ENDIF
  71 :           CALL G2COPY(ITVL,NBCOL2,NBLIG2,IOP2,
  72 :      >                     IGR1,NBCOL1,NBLIG1 )
  73 : 
  74 : C
  75 :       ELSE
  76 : C
  77 : C     --- ORIGINE INCHANGEE ---
  78 : C     
  79 : C       --- ON NE SOUHAITE PAS CHANGER L'ORIENTATION => IDENTITE ---
  80 :         IF( IDIMC.LE.0 )GOTO 9999
  81 : C
  81 :         CALL G2ORIE(IGR1,NBCOL1,NBLIG1,IDIMC,COORD,VK,IOP2 )
  82 :         IF( IOP2.EQ. 0 )THEN
  83 :           iarr = -1
  83 :           CALL DSERRE(1,iarr,'G2ORAC',' APPEL G2ORIE')        
  83 :           CALL DSERRE(1,iarr,'G2ORAC',' TRANSFORMATION INCONNUE')        
  84 :           GOTO 9999
  85 :         ENDIF
  86 : C         --- IDENTITE ---
  87 :         IF(IOP2.EQ.1)GOTO 9999
  88 :         IF( (NBCOL1*NBLIG1).GT.NTIMAX )THEN
  89 :           iarr = -2
  89 :           CALL DSERRE(1,iarr,'G2ORAC',' TABLEAU D ENTIER')        
  90 :           GOTO 9999
  91 :         ENDIF 
  91 :         CALL G2COPY(IGR1,NBCOL1,NBLIG1,IOP1,
  92 :      >                 ITVL,NBCOL2,NBLIG2 )
  93 :         
  93 :         CALL G2COPY(ITVL,NBCOL2,NBLIG2,IOP2,
  94 :      >                   IGR1,NBCOL1,NBLIG1 )
  95 :       ENDIF
  96 :       
  97 : C
  98 :  9999 END
  99 :  
 100 :  
 101 :