Télécharger mkcoo1.eso

Retour à la liste

Numérotation des lignes :

  1. C MKCOO1 SOURCE GOUNAND 05/12/21 21:34:15 5281
  2. SUBROUTINE MKCOO1(NNOEU,NELEM,NXCO,NDDL,NDIM,
  3. $ SOUGEO,NCOORD,NPQUAF,
  4. $ JCOOR,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : MKCOO1
  10. C PROJET : Noyau linéaire NLIN
  11. C DESCRIPTION : On remplit les valeurs du champ par éléments contenant
  12. C les coordonnées des points servant pour la
  13. C transformation géométrique (ddl de la transformation
  14. C géométrique)... Ceci pour le maillage élémentaire
  15. C SOUGEO.
  16. C
  17. C LANGAGE : FORTRAN 77 (sauf E/S)
  18. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19. C mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES : -
  22. C APPELE PAR : MKCOOR
  23. C***********************************************************************
  24. C ENTREES : * NNOEU (type entier) : nombre de noeuds par
  25. C élément.
  26. C * NELEM (type entier) : nombre d'éléments de
  27. C SOUGEO
  28. C * NXCO (type entier) : dimension du tableau des
  29. C coordonnées des points (cf. include SMCOORD).
  30. C * NDDL (type entier) : nombre de ddl de
  31. C l'élément fini courant.
  32. C * NDIM (type entier) : dimension de l'espace
  33. C géométrique.
  34. C * SOUGEO (type entier) : tableau des numéros de
  35. C noeuds des éléments.
  36. C * NCOORD (type réel) : tableau des coordonnées
  37. C des noeuds (cf. include SMCOORD).
  38. C * NPQUAF (type entier) : tableau de
  39. C correspondance (numéro du ddl) -> numéro du
  40. C noeud du QUAF (cf. include SELREF)
  41. C ENTREES/SORTIES : * JCOOR (type réel) : valeurs du champ par
  42. C éléments contenant les coordonnées des points
  43. C servant pour la transformation géométrique (ddl
  44. C de la transformation géométrique)...
  45. C SORTIES : -
  46. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  47. C***********************************************************************
  48. C VERSION : v1, 03/09/99, version initiale
  49. C HISTORIQUE : v1, 03/09/99, création
  50. C HISTORIQUE :
  51. C HISTORIQUE :
  52. C***********************************************************************
  53. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  54. C en cas de modification de ce sous-programme afin de faciliter
  55. C la maintenance !
  56. C***********************************************************************
  57. -INC CCOPTIO
  58. *
  59. INTEGER NNOEU,NELEM,NXCO,NDDL,NDIM
  60. INTEGER SOUGEO(NNOEU,NELEM)
  61. REAL*8 NCOORD(NXCO)
  62. INTEGER NPQUAF(NDDL)
  63. REAL*8 JCOOR(NDDL,NDIM,NELEM)
  64. *
  65. INTEGER IMPR,IRET
  66. *
  67. INTEGER IELEM,INDDL,INDIM
  68. INTEGER NUMNO
  69. *
  70. * Executable statements
  71. *
  72. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkcoo1'
  73. DO 1 IELEM=1,NELEM
  74. DO 12 INDDL=1,NDDL
  75. NUMNO=SOUGEO(NPQUAF(INDDL),IELEM)
  76. DO 122 INDIM=1,NDIM
  77. JCOOR(INDDL,INDIM,IELEM)=
  78. $ NCOORD(((NUMNO-1)*(NDIM+1)) + INDIM)
  79. 1222 CONTINUE
  80. 122 CONTINUE
  81. 12 CONTINUE
  82. 1 CONTINUE
  83. *
  84. * Normal termination
  85. *
  86. IRET=0
  87. RETURN
  88. *
  89. * Format handling
  90. *
  91. *
  92. * Error handling
  93. *
  94. 9999 CONTINUE
  95. IRET=1
  96. WRITE(IOIMP,*) 'An error was detected in subroutine mkcoo1'
  97. RETURN
  98. *
  99. * End of subroutine MKCOO1
  100. *
  101. END
  102.  
  103.  
  104.  

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