Télécharger mkcoor.eso

Retour à la liste

Numérotation des lignes :

  1. C MKCOOR SOURCE BP208322 16/11/18 21:19:15 9177
  2. SUBROUTINE MKCOOR(CGEOME,MDISCR,
  3. $ MYFALS,
  4. $ ICOOR,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : MKCOOR
  10. C PROJET : Noyau linéaire NLIN
  11. C DESCRIPTION : On crée le champ par éléments contenant les coordonnées
  12. C des points servant pour la transformation géométrique
  13. C (ddl de la transformation géométrique)...
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES : KEEF (recherche de l'élément fini)
  20. C NOMINC (nommage des inconnues)
  21. C MKCOO1 (remplissage du sous-champ par élément
  22. C (fortran 77))
  23. C PRCAEL (impression du champ créé)
  24. C APPELE PAR : PRNLI2
  25. C***********************************************************************
  26. C ENTREES : * CGEOME (type MELEME) : maillage de QUAFs
  27. C partitionné.
  28. C * MDISCR (type CH*(*)) : nom d'espace de
  29. C discrétisation (cf. NOMFA dans l'include
  30. C SFALRF)
  31. C * MYFALS (type FALRFS) : segment de description
  32. C des familles d'éléments de références.
  33. C SORTIES : * ICOOR (type MCHAEL) : champ par éléments de
  34. C coordonnées de points (degrés de liberté de la
  35. C transformation géométrique).
  36. C TRAVAIL : * SOUGEO (type MELEME) : maillage élémentaire.
  37. C * JCOOR (type MCHEVA) : valeurs du champ ICOOR
  38. C sur le maillage élémentaire.
  39. C Structure (cf.include SMCHAEL) :
  40. C (1, nb. ddl, 1, dim. esp. réel, 1, nb. élément)
  41. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  42. C***********************************************************************
  43. C VERSION : v1, 01/09/99, version initiale
  44. C HISTORIQUE : v1, 01/09/99, création
  45. C HISTORIQUE :
  46. C HISTORIQUE :
  47. C***********************************************************************
  48. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  49. C en cas de modification de ce sous-programme afin de faciliter
  50. C la maintenance !
  51. C***********************************************************************
  52. -INC CCOPTIO
  53. -INC CCGEOME
  54. -INC SMCOORD
  55. -INC SMELEME
  56. POINTEUR CGEOME.MELEME
  57. POINTEUR SOUGEO.MELEME
  58. * Segments à moi
  59. CBEGININCLUDE SMCHAEL
  60. SEGMENT MCHAEL
  61. POINTEUR IMACHE(N1).MELEME
  62. POINTEUR ICHEVA(N1).MCHEVA
  63. ENDSEGMENT
  64. SEGMENT MCHEVA
  65. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  66. ENDSEGMENT
  67. SEGMENT LCHEVA
  68. POINTEUR LISCHE(NBCHE).MCHEVA
  69. ENDSEGMENT
  70. CENDINCLUDE SMCHAEL
  71. INTEGER N1
  72. POINTEUR ICOOR.MCHAEL
  73. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  74. POINTEUR JCOOR.MCHEVA
  75. CBEGININCLUDE SFALRF
  76. SEGMENT FALRF
  77. CHARACTER*(LNNFA) NOMFA
  78. INTEGER NUQUAF(NBLRF)
  79. POINTEUR ELEMF(NBLRF).ELREF
  80. ENDSEGMENT
  81. SEGMENT FALRFS
  82. POINTEUR LISFA(0).FALRF
  83. ENDSEGMENT
  84. CENDINCLUDE SFALRF
  85. POINTEUR MYFALS.FALRFS
  86. CBEGININCLUDE SELREF
  87. SEGMENT ELREF
  88. CHARACTER*(LNNOM) NOMLRF
  89. CHARACTER*(LNFORM) FORME
  90. CHARACTER*(LNTYPL) TYPEL
  91. CHARACTER*(LNESP) ESPACE
  92. INTEGER DEGRE
  93. REAL*8 XCONOD(NDIMEL,NBNOD)
  94. INTEGER NPQUAF(NBDDL)
  95. INTEGER NUMCMP(NBDDL)
  96. INTEGER QUENOD(NBDDL)
  97. INTEGER ORDDER(NDIMEL,NBDDL)
  98. POINTEUR MBPOLY.POLYNS
  99. ENDSEGMENT
  100. SEGMENT ELREFS
  101. POINTEUR LISEL(0).ELREF
  102. ENDSEGMENT
  103. CENDINCLUDE SELREF
  104. POINTEUR MYLRF.ELREF
  105. *
  106. CHARACTER*(*) MDISCR
  107. INTEGER IMPR,IRET
  108. *
  109. INTEGER ISOUS
  110. INTEGER NSOUS,NNOEU,NELEM,NDDL,NXCO
  111. INTEGER ITQUAF
  112. *
  113. * Executable statements
  114. *
  115. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkcoor'
  116. SEGACT CGEOME
  117. NSOUS=CGEOME.LISOUS(/1)
  118. N1=NSOUS
  119. SEGINI ICOOR
  120. NXCO=MCOORD.XCOOR(/1)
  121. * Par sous-domaine...
  122. DO 1 ISOUS=1,NSOUS
  123. SOUGEO=CGEOME.LISOUS(ISOUS)
  124. SEGACT SOUGEO
  125. * On cherche l'élément fini correspondant au QUAF
  126. ITQUAF=SOUGEO.ITYPEL
  127. CALL KEEF(ITQUAF,MDISCR,
  128. $ MYFALS,
  129. $ MYLRF,
  130. $ IMPR,IRET)
  131. IF (IRET.NE.0) GOTO 9999
  132. SEGACT MYLRF
  133. NDDL=MYLRF.NPQUAF(/1)
  134. NNOEU=SOUGEO.NUM(/1)
  135. NELEM=SOUGEO.NUM(/2)
  136. NBLIG=1
  137. NBCOL=NDDL
  138. N2LIG=1
  139. N2COL=IDIM
  140. NBPOI=1
  141. NBELM=NELEM
  142. SEGINI JCOOR
  143. CALL MKCOO1(NNOEU,NELEM,NXCO,NDDL,IDIM,
  144. $ SOUGEO.NUM,MCOORD.XCOOR,MYLRF.NPQUAF,
  145. $ JCOOR.VELCHE,
  146. $ IMPR,IRET)
  147. IF (IRET.NE.0) GOTO 9999
  148. SEGDES JCOOR
  149. ICOOR.ICHEVA(ISOUS)=JCOOR
  150. SEGDES MYLRF
  151. SEGDES SOUGEO
  152. ICOOR.IMACHE(ISOUS)=SOUGEO
  153. 1 CONTINUE
  154. SEGDES ICOOR
  155. SEGDES CGEOME
  156. IF (IMPR.GT.3) THEN
  157. WRITE(IOIMP,*) 'On a créé',
  158. $ ' ICOOR(élément ,1, coor.esp ,1, ddl ,1)=',ICOOR
  159. CALL PRCAEL(ICOOR,IMPR,IRET)
  160. IF (IRET.NE.0) GOTO 9999
  161. ENDIF
  162. *
  163. * Normal termination
  164. *
  165. IRET=0
  166. RETURN
  167. *
  168. * Format handling
  169. *
  170. *
  171. * Error handling
  172. *
  173. 9999 CONTINUE
  174. IRET=1
  175. WRITE(IOIMP,*) 'An error was detected in subroutine mkcoor'
  176. RETURN
  177. *
  178. * End of subroutine MKCOOR
  179. *
  180. END
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  

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