Télécharger g2orac.eso

Retour à la liste

Numérotation des lignes :

  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