Télécharger la plaquette Cast3M


fr en

Télécharger g2orac.eso

Retour à la liste

Numérotation des lignes : 

g2orac

  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
  42.          CALL G2ORIG(IGR1,NBCOL1,NBLIG1,N1,IOP1 )
  43.          IF( IOP1.EQ. 0 )THEN
  44.            iarr = -1
  45.            CALL DSERRE(1,iarr,'G2ORAC',' APPEL G2ORIG')
  46.            CALL DSERRE(1,iarr,'G2ORAC',' TRANSFORMATION INCONNUE')
  47.            GOTO 9999
  48.          ENDIF
  49.       ELSE
  50.          IOP1 = 1
  51.       ENDIF
  52.  
  53. C
  54.       IF( IOP1.NE.1 )THEN
  55. C
  56. C     --- CHANGEMENT D'ORIGINE ---
  57. C
  58.         IF( (NBCOL1*NBLIG1).GT.NTIMAX )THEN
  59.           iarr = -2
  60.           CALL DSERRE(1,iarr,'G2ORAC','TABLEAU D ENTIER')
  61.           GOTO 9999
  62.         ENDIF
  63.         CALL G2COPY(IGR1,NBCOL1,NBLIG1,IOP1,ITVL,NBCOL2,NBLIG2 )
  64.         IF( IDIMC.GT.0 )THEN
  65. C
  66.           CALL G2ORIE(ITVL,NBCOL2,NBLIG2,IDIMC,COORD,VK,IOP2 )
  67.           IF( IOP2.EQ. 0 )THEN
  68. C          --- ON RECOPIE MEME SI LE TRAVAIL N'EST PAS FINI ---
  69.            IOP2 = 1
  70.            CALL G2COPY(ITVL,NBCOL2,NBLIG2,IOP2,
  71.      >                     IGR1,NBCOL1,NBLIG1 )
  72.             iarr = -1
  73.             CALL DSERRE(1,iarr,'G2ORAC',' APPEL G2ORIE')
  74.             CALL DSERRE(1,iarr,'G2ORAC',' TRANSFORMATION INCONNUE')
  75.             GOTO 9999
  76.           ENDIF
  77.        ELSE
  78. C       --- ON NE SOUHAITE PAS CHANGER L'ORIENTATION ---
  79.          IOP2 = 1
  80.        ENDIF
  81.           CALL G2COPY(ITVL,NBCOL2,NBLIG2,IOP2,
  82.      >                     IGR1,NBCOL1,NBLIG1 )
  83.  
  84. C
  85.       ELSE
  86. C
  87. C     --- ORIGINE INCHANGEE ---
  88. C
  89. C       --- ON NE SOUHAITE PAS CHANGER L'ORIENTATION => IDENTITE ---
  90.         IF( IDIMC.LE.0 )GOTO 9999
  91. C
  92.         CALL G2ORIE(IGR1,NBCOL1,NBLIG1,IDIMC,COORD,VK,IOP2 )
  93.         IF( IOP2.EQ. 0 )THEN
  94.           iarr = -1
  95.           CALL DSERRE(1,iarr,'G2ORAC',' APPEL G2ORIE')
  96.           CALL DSERRE(1,iarr,'G2ORAC',' TRANSFORMATION INCONNUE')
  97.           GOTO 9999
  98.         ENDIF
  99. C         --- IDENTITE ---
  100.         IF(IOP2.EQ.1)GOTO 9999
  101.         IF( (NBCOL1*NBLIG1).GT.NTIMAX )THEN
  102.           iarr = -2
  103.           CALL DSERRE(1,iarr,'G2ORAC',' TABLEAU D ENTIER')
  104.           GOTO 9999
  105.         ENDIF
  106.         CALL G2COPY(IGR1,NBCOL1,NBLIG1,IOP1,
  107.      >                 ITVL,NBCOL2,NBLIG2 )
  108.  
  109.         CALL G2COPY(ITVL,NBCOL2,NBLIG2,IOP2,
  110.      >                   IGR1,NBCOL1,NBLIG1 )
  111.       ENDIF
  112.  
  113. C
  114.  9999 END
  115.  
  116.  
  117.  
  118.  

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