Sources Esope | Cast3M

lekmif
C LEKMIF    SOURCE    CB215821  20/11/25    13:33:34     10792          
      SUBROUTINE LEKMIF(NUCOEF,MTABD,IHV,MCHELM,KPOIND)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C
C Ce sous programme lit un coefficient dans la pile des objets GIBIANE
C Le coefficient attendu peut etre de type ENTIER, FLOTTANT, POINT, ou
C CHPOINT.
C Ce SP rend un MCHAML quoi qu'il arrive
C Le MCHAML en retour est jetable et est calcule aux pts d'integrations
C----------------------------------------------------------------------
C HISTORIQUE : 20/10/01 : Création
C
C HISTORIQUE :
C
C---------------------------
C Paramètres Entrée/Sortie :
C---------------------------
C
C E/  NUCOEF : Rang du coefficient à aller chercher (ENTIER)
C E/  MTABD  : Objet model de la zone
C E/  IHV=0 CHPOINT SCALAIRE ou FLOTTANT
C     IHV=1 CHPOINT VECTEUR  ou POINT
C  /S MCHELM : Chamelem pts d'intégration pour le COEF
C E/  KPOIND : ENTIER type du support GÉométrique DUAL du shéma
C              d'intégration => pour la création du Chamelem
C----------------------------------------------------------------------
C KPOIN = 0->SOMMET 1-> FACE     2-> CENTRE  3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
C----------------------------------------------------------------------
C************************************************************************
 
-INC SMCHAML
-INC SMCHPOI
-INC SMELEME
-INC SMCOORD
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
      CHARACTER*8 TYPE,TYPM
      DIMENSION XPOI(3)
C*****************************************************************************
CLEKMIF
C      write(6,*)' DEBUT LEKMIF NUCOEF=',NUCOEF,
C     &'MTABD=',MTABD
      XPETI=1.D-30
      IAXI=0
      IF(IFOMOD.EQ.0)IAXI=2
      TYPE=' '
      CALL QUETYP(TYPE,0,IRET)
      IF(IRET.EQ.0)THEN
C Tache impossible. Probablement données erronées
C     CALL ERREUR(26)
C Il manque la donnee du CHPOINT , MCHAML ou de la TABLE.
C     CALL ERREUR(686)
C Il manque une donnée
      CALL ERREUR(641)
      RETURN
      ENDIF
C     write(6,*)' LEKMIF TYPE=',TYPE,ihv
 
      IF(TYPE.NE.'FLOTTANT'.AND.TYPE.NE.'ENTIER'.AND.
     &   TYPE.NE.'CHPOINT '.AND.IHV.EQ.0)THEN
C On ne veut pas d'objet de type %m1:8
      MOTERR(1: 8) = TYPE
      CALL ERREUR(39)
      RETURN
      ENDIF
 
      IF(TYPE.NE.'POINT'.AND.
     &   TYPE.NE.'CHPOINT '.AND.IHV.EQ.1)THEN
C On ne veut pas d'objet de type %m1:8
      MOTERR(1: 8) = TYPE
      CALL ERREUR(39)
      RETURN
      ENDIF
 
C-------------------------------------------------------------------------
C__FLOTTANT
      IF(TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER'.OR.
     &   TYPE.EQ.'POINT' )THEN
 
          IF(TYPE.EQ.'FLOTTANT')THEN
          CALL LIRREE(COEF,0,IRET)
          ELSEIF(TYPE.EQ.'ENTIER')THEN
          CALL LIRENT(IVAL,0,IRET)
          COEF=FLOAT(IVAL)
          ELSEIF(TYPE.EQ.'POINT')THEN
          CALL LIROBJ(TYPE,IP,0,IRET)
          XPOI(1) = XCOOR((IP-1)*(IDIM+1) +1)
          XPOI(2) = XCOOR((IP-1)*(IDIM+1) +2)
          IF (IDIM.EQ.3) XPOI(3) = XCOOR((IP-1)*(IDIM+1) +3)
          ENDIF
 
C__CHPOINT
      ELSEIF(TYPE.EQ.'CHPOINT')THEN
         CALL LIROBJ(TYPE,MCHPOI,0,IRET)
         SEGACT MCHPOI
      ENDIF
 
      IMDL=0
      CALL MELMOF(IMDL,MTABD,IHV,TYPE,COEF,XPOI,MCHPOI,MCHELM,KPOIND,
     & 0,MCHELG)
 
 
C     write(6,*)' FIN LEKMIF '
      RETURN
 1001 FORMAT(20(1X,I5))
 1002 FORMAT(10(1X,1PE11.4))
      END