Télécharger la plaquette Cast3M


fr en

Télécharger kecom6.eso

Retour à la liste

Numérotation des lignes : 

kecom6

  1. C KECOM6    SOURCE    GOUNAND   24/11/06    21:15:11     12073          
  2.       SUBROUTINE KECOM6(CGEOMQ,MYLMOT,MYDISC,TYPCHA,ICHAM,LCHAM,
  3.      $     MYFALS)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM         : KECOM6
  8. C PROJET      : Noyau linéaire NLIN
  9. C DESCRIPTION :
  10. C
  11. *  On teste les noms des ddls des variables et des coefficients
  12. *  On verifie egalement qu'il n'y a pas de noeuds à numéro nul dans CGEOMQ
  13. *  qui pourrait etre utilises. Ces noeuds nuls sont eventuellement
  14. *  cree par TRQUAF (cf. PRLIN2) pour permettre l'utilisation d'un
  15. *  maillage non QUAF en entree de NLIN.
  16. C
  17. C LANGAGE     : ESOPE
  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          : KEEF (recherche de l'élément fini)
  22. C APPELE PAR       :
  23. C***********************************************************************
  24. C ENTREES            :
  25. C SORTIES            :
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION    : v1, 26/09/02, version initiale
  29. C HISTORIQUE : v1, 26/09/02, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMELEME
  41.       POINTEUR CGEOMQ.MELEME
  42.       POINTEUR SOUGEO.MELEME
  43. -INC SMLMOTS
  44.       POINTEUR MYLMOT.MLMOTS
  45. * Mes includes persos
  46. -INC TNLIN
  47. *-INC SFALRF
  48.       POINTEUR MYFALS.FALRFS
  49. *-INC SELREF
  50.       POINTEUR MYLRF.ELREF
  51. *
  52.       CHARACTER*8 TYPCHA
  53.       CHARACTER*4 MYDISC
  54.       INTEGER IMPR,IRET
  55. *
  56. * Fonctions appelées
  57. *
  58.       INTEGER IMAX
  59. *
  60.       INTEGER ICOMP ,ISOUS            ,MAXISO
  61.       INTEGER        NSOUS,NDDL,ITQUAF,MAXCMP
  62. *
  63. * Executable statements
  64. *
  65.       IMPR=0
  66.       SEGACT CGEOMQ
  67.       NSOUS=CGEOMQ.LISOUS(/1)
  68.       MAXCMP=0
  69.       DO 3 ISOUS=1,NSOUS
  70.          SOUGEO=CGEOMQ.LISOUS(ISOUS)
  71.          SEGACT SOUGEO
  72. * On cherche l'élément fini correspondant au QUAF
  73.          ITQUAF=SOUGEO.ITYPEL
  74.          CALL KEEF(ITQUAF,MYDISC,
  75.      $        MYFALS,
  76.      $        MYLRF,
  77.      $        IMPR,IRET)
  78.          IF (IRET.NE.0) GOTO 9999
  79.          SEGACT MYLRF
  80.          NDDL=MYLRF.NPQUAF(/1)
  81.          MAXISO=IMAX(MYLRF.NUMCMP,NDDL)
  82.          MAXCMP=MAX(MAXCMP,MAXISO)
  83. * Si le maillage donné à NLIN n'était pas QUAF au départ, il faut
  84. * vérifier que tous les ddls peuvent s'appuyer sur les points du
  85. * maillage donné
  86.          IF (CGEOMQ.LISREF(ISOUS).NE.0) THEN
  87. * Cas particulier : si l'espace élément fini est 'CSTE' :
  88. *     on autorise les FLOTTANT en entrée
  89. *     on n'autorise pas les CHAMELEM constant par élément en entrée : ça
  90. *       n'a pas de sens, le CHAMELEM porte sur des éléments
  91. *     on autorise les CHAMELEM constant par élément en sortie
  92.             IF (MYDISC.EQ.'CSTE') THEN
  93.                IF (ICHAM.LT.0) GOTO 33
  94. *               IF (ICHAM.GT.0.AND.TYPCHA.EQ.'MCHAML  ') GOTO 33
  95.                IF (ICHAM.EQ.0.AND.LCHAM.EQ.1) GOTO 33
  96.             ENDIF
  97. * Le test uniquement sur le 1er element doit etre suffisant
  98.             DO IDDL=1,NDDL
  99.                NNQUA=MYLRF.NPQUAF(IDDL)
  100.                NNGLO=SOUGEO.NUM(NNQUA,1)
  101.                IF (NNGLO.EQ.0) THEN
  102.                   WRITE(IOIMP,*) 'A discretization space ',MYDISC,
  103.      $                 ' is incompatible with the given mesh'
  104.                   WRITE(IOIMP,*) 'Check its element type please'
  105.                   GOTO 9999
  106.                ENDIF
  107.             ENDDO
  108.  33         CONTINUE
  109.          ENDIF
  110.          SEGDES MYLRF
  111.          SEGDES SOUGEO
  112.  3    CONTINUE
  113.       SEGACT MYLMOT
  114.       ICOMP=MYLMOT.MOTS(/2)
  115.       SEGDES MYLMOT
  116.       SEGDES CGEOMQ
  117.       IF (ICOMP.NE.MAXCMP) THEN
  118.          WRITE(IOIMP,*) 'Une variable de ddls :'
  119.          WRITE (IOIMP,2019) (MYLMOT.MOTS(I),I=1,MYLMOT.MOTS(/2))
  120.  2019 FORMAT (10(2X,A8) )
  121. *         SEGPRT,MYLMOT
  122.          WRITE(IOIMP,*)
  123.      $        'n''est pas compatible avec la discrétisation : ',
  124.      $        MYDISC
  125.          GOTO 9999
  126.       ENDIF
  127. *
  128. * Normal termination
  129. *
  130.       RETURN
  131. *
  132. * Format handling
  133. *
  134. *
  135. * Error handling
  136. *
  137.  9999 CONTINUE
  138.       MOTERR(1:8)='kecom6  '
  139.       CALL ERREUR(1127)
  140.       RETURN
  141. *
  142. * End of subroutine KECOM6
  143. *
  144.       END
  145.  
  146.  

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