Télécharger kecom6.eso

Retour à la liste

Numérotation des lignes :

  1. C KECOM6 SOURCE GOUNAND 11/07/21 21:15:20 7046
  2. SUBROUTINE KECOM6(CGEOME,MYLMOT,MYDISC,
  3. $ MYFALS,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : KECOM6
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION :
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES : KEEF (recherche de l'élément fini)
  17. C APPELE PAR :
  18. C***********************************************************************
  19. C ENTREES :
  20. C SORTIES :
  21. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22. C***********************************************************************
  23. C VERSION : v1, 26/09/02, version initiale
  24. C HISTORIQUE : v1, 26/09/02, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29. C en cas de modification de ce sous-programme afin de faciliter
  30. C la maintenance !
  31. C***********************************************************************
  32. -INC CCOPTIO
  33. -INC SMELEME
  34. POINTEUR CGEOME.MELEME
  35. POINTEUR SOUGEO.MELEME
  36. -INC SMLMOTS
  37. POINTEUR MYLMOT.MLMOTS
  38. * Mes includes persos
  39. CBEGININCLUDE SFALRF
  40. SEGMENT FALRF
  41. CHARACTER*(LNNFA) NOMFA
  42. INTEGER NUQUAF(NBLRF)
  43. POINTEUR ELEMF(NBLRF).ELREF
  44. ENDSEGMENT
  45. SEGMENT FALRFS
  46. POINTEUR LISFA(0).FALRF
  47. ENDSEGMENT
  48. CENDINCLUDE SFALRF
  49. POINTEUR MYFALS.FALRFS
  50. CBEGININCLUDE SELREF
  51. SEGMENT ELREF
  52. CHARACTER*(LNNOM) NOMLRF
  53. CHARACTER*(LNFORM) FORME
  54. CHARACTER*(LNTYPL) TYPEL
  55. CHARACTER*(LNESP) ESPACE
  56. INTEGER DEGRE
  57. REAL*8 XCONOD(NDIMEL,NBNOD)
  58. INTEGER NPQUAF(NBDDL)
  59. INTEGER NUMCMP(NBDDL)
  60. INTEGER QUENOD(NBDDL)
  61. INTEGER ORDDER(NDIMEL,NBDDL)
  62. POINTEUR MBPOLY.POLYNS
  63. ENDSEGMENT
  64. SEGMENT ELREFS
  65. POINTEUR LISEL(0).ELREF
  66. ENDSEGMENT
  67. CENDINCLUDE SELREF
  68. POINTEUR MYLRF.ELREF
  69. *
  70. CHARACTER*4 MYDISC
  71. INTEGER IMPR,IRET
  72. *
  73. * Fonctions appelées
  74. *
  75. INTEGER IMAX
  76. *
  77. INTEGER ICOMP ,ISOUS ,MAXISO
  78. INTEGER NSOUS,NDDL,ITQUAF,MAXCMP
  79. *
  80. * Executable statements
  81. *
  82. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans kecom6'
  83. *
  84. SEGACT CGEOME
  85. NSOUS=CGEOME.LISOUS(/1)
  86. MAXCMP=0
  87. DO 3 ISOUS=1,NSOUS
  88. SOUGEO=CGEOME.LISOUS(ISOUS)
  89. SEGACT SOUGEO
  90. * On cherche l'élément fini correspondant au QUAF
  91. ITQUAF=SOUGEO.ITYPEL
  92. CALL KEEF(ITQUAF,MYDISC,
  93. $ MYFALS,
  94. $ MYLRF,
  95. $ IMPR,IRET)
  96. IF (IRET.NE.0) GOTO 9999
  97. SEGACT MYLRF
  98. NDDL=MYLRF.NPQUAF(/1)
  99. MAXISO=IMAX(MYLRF.NUMCMP,NDDL)
  100. MAXCMP=MAX(MAXCMP,MAXISO)
  101. SEGDES MYLRF
  102. SEGDES SOUGEO
  103. 3 CONTINUE
  104. SEGACT MYLMOT
  105. ICOMP=MYLMOT.MOTS(/2)
  106. SEGDES MYLMOT
  107. SEGDES CGEOME
  108. IF (ICOMP.NE.MAXCMP) THEN
  109. WRITE(IOIMP,*) 'Une variable de ddls :'
  110. WRITE (IOIMP,2019) (MYLMOT.MOTS(I),I=1,MYLMOT.MOTS(/2))
  111. 2019 FORMAT (10(2X,A8) )
  112. * SEGPRT,MYLMOT
  113. WRITE(IOIMP,*)
  114. $ 'n''est pas compatible avec la discrétisation : ',
  115. $ MYDISC
  116. GOTO 9999
  117. ENDIF
  118. *
  119. * Normal termination
  120. *
  121. IRET=0
  122. RETURN
  123. *
  124. * Format handling
  125. *
  126. *
  127. * Error handling
  128. *
  129. 9999 CONTINUE
  130. IRET=1
  131. WRITE(IOIMP,*) 'An error was detected in subroutine kecom6'
  132. RETURN
  133. *
  134. * End of subroutine KECOM6
  135. *
  136. END
  137.  
  138.  
  139.  
  140.  
  141.  

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