Esope source files

   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
  91 :          CALL KEEF(ITQUAF,MYDISC,
  92 :      $        MYFALS,
  93 :      $        MYLRF,
  94 :      $        IMPR,IRET)
  95 :          IF (IRET.NE.0) GOTO 9999
  96 :          SEGACT MYLRF
  97 :          NDDL=MYLRF.NPQUAF(/1)
  98 :          MAXISO=IMAX(MYLRF.NUMCMP,NDDL)
  99 :          MAXCMP=MAX(MAXCMP,MAXISO)
 100 :          SEGDES MYLRF
 101 :          SEGDES SOUGEO
 102 :  3    CONTINUE
 103 :       SEGACT MYLMOT
 104 :       ICOMP=MYLMOT.MOTS(/2)
 105 :       SEGDES MYLMOT
 106 :       SEGDES CGEOME
 107 :       IF (ICOMP.NE.MAXCMP) THEN
 108 :          WRITE(IOIMP,*) 'Une variable de ddls :'
 109 :          WRITE (IOIMP,2019) (MYLMOT.MOTS(I),I=1,MYLMOT.MOTS(/2))
 110 :  2019 FORMAT (10(2X,A8) )      
 111 : *         SEGPRT,MYLMOT
 112 :          WRITE(IOIMP,*) 
 113 :      $        'n''est pas compatible avec la discrétisation : ',
 114 :      $        MYDISC
 115 :          GOTO 9999
 116 :       ENDIF
 117 : *
 118 : * Normal termination
 119 : *
 120 :       IRET=0
 121 :       RETURN
 122 : *
 123 : * Format handling
 124 : *
 125 : *
 126 : * Error handling
 127 : *
 128 :  9999 CONTINUE
 129 :       IRET=1
 130 :       WRITE(IOIMP,*) 'An error was detected in subroutine kecom6'
 131 :       RETURN
 132 : *
 133 : * End of subroutine KECOM6
 134 : *
 135 :       END
 136 : 
 137 : 
 138 :  
 139 :