Download lekmif.eso

Back to the list

   1 : C LEKMIF    SOURCE    PV        09/03/12    21:27:22     6325           
   2 :       SUBROUTINE LEKMIF(NUCOEF,MTABD,IHV,MCHELM,KPOIND)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C***********************************************************************
   6 : C
   7 : C Ce sous programme lit un coefficient dans la pile des objets GIBIANE
   8 : C Le coefficient attendu peut etre de type ENTIER, FLOTTANT, POINT, ou
   9 : C CHPOINT.
  10 : C Ce SP rend un MCHAML quoi qu'il arrive
  11 : C Le MCHAML en retour est jetable et est calcule aux pts d'integrations
  12 : C----------------------------------------------------------------------
  13 : C HISTORIQUE : 20/10/01 : Création
  14 : C
  15 : C HISTORIQUE :
  16 : C                                                                               
  17 : C---------------------------
  18 : C Paramètres Entrée/Sortie :
  19 : C---------------------------
  20 : C                                                                               
  21 : C E/  NUCOEF : Rang du coefficient à aller chercher (ENTIER)
  22 : C E/  MTABD  : Objet model de la zone
  23 : C E/  IHV=0 CHPOINT SCALAIRE ou FLOTTANT
  24 : C     IHV=1 CHPOINT VECTEUR  ou POINT
  25 : C  /S MCHELM : Chamelem pts d'intégration pour le COEF
  26 : C E/  KPOIND : ENTIER type du support GÉométrique DUAL du shéma
  27 : C              d'intégration => pour la création du Chamelem
  28 : C----------------------------------------------------------------------
  29 : C KPOIN = 0->SOMMET 1-> FACE     2-> CENTRE  3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
  30 : C----------------------------------------------------------------------
  31 : C************************************************************************       
  32 : 
  33 : -INC SMCHAML
  34 : -INC SMCHPOI
  35 : -INC SMELEME
  36 : -INC SMCOORD
  37 : -INC CCOPTIO
  38 : -INC CCGEOME
  39 :       CHARACTER*8 TYPE,TYPM
  40 :       DIMENSION XPOI(3)
  41 : C*****************************************************************************
  42 : CLEKMIF
  43 : C      write(6,*)' DEBUT LEKMIF NUCOEF=',NUCOEF,
  44 : C     &'MTABD=',MTABD
  45 :       XPETI=1.D-30
  46 :       IAXI=0
  47 :       IF(IFOMOD.EQ.0)IAXI=2
  48 :       TYPE=' '
  48 :       CALL QUETYP(TYPE,0,IRET)
  49 :       IF(IRET.EQ.0)THEN
  50 : C Tache impossible. Probablement données erronées
  50 : C     CALL ERREUR(26)
  51 : C Il manque la donnee du CHPOINT , MCHAML ou de la TABLE.
  51 : C     CALL ERREUR(686)
  52 : C Il manque une donnée
  52 :       CALL ERREUR(641)
  53 :       RETURN
  54 :       ENDIF
  55 : C     write(6,*)' LEKMIF TYPE=',TYPE,ihv
  56 : 
  57 :       IF(TYPE.NE.'FLOTTANT'.AND.TYPE.NE.'ENTIER'.AND.
  58 :      &   TYPE.NE.'CHPOINT '.AND.IHV.EQ.0)THEN
  59 : C On ne veut pas d'objet de type %m1:8
  60 :       MOTERR(1: 8) = TYPE
  60 :       CALL ERREUR(39)
  61 :       RETURN
  62 :       ENDIF
  63 : 
  64 :       IF(TYPE.NE.'POINT'.AND.
  65 :      &   TYPE.NE.'CHPOINT '.AND.IHV.EQ.1)THEN
  66 : C On ne veut pas d'objet de type %m1:8
  67 :       MOTERR(1: 8) = TYPE
  67 :       CALL ERREUR(39)
  68 :       RETURN
  69 :       ENDIF
  70 : 
  71 : C-------------------------------------------------------------------------
  72 : C__FLOTTANT
  73 :       IF(TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER'.OR.
  74 :      &   TYPE.EQ.'POINT' )THEN
  75 : 
  76 :           IF(TYPE.EQ.'FLOTTANT')THEN
  76 :           CALL LIRREE(COEF,0,IRET)
  77 :           ELSEIF(TYPE.EQ.'ENTIER')THEN
  77 :           CALL LIRENT(IVAL,0,IRET)
  78 :           COEF=FLOAT(IVAL)
  79 :           ELSEIF(TYPE.EQ.'POINT')THEN
  79 :           CALL LIROBJ(TYPE,IP,0,IRET)
  80 :           XPOI(1) = XCOOR((IP-1)*(IDIM+1) +1)
  81 :           XPOI(2) = XCOOR((IP-1)*(IDIM+1) +2)
  82 :           IF (IDIM.EQ.3) XPOI(3) = XCOOR((IP-1)*(IDIM+1) +3)
  83 :           ENDIF
  84 : 
  85 : C__CHPOINT
  86 :       ELSEIF(TYPE.EQ.'CHPOINT')THEN
  86 :          CALL LIROBJ(TYPE,MCHPOI,0,IRET)
  87 :          SEGACT MCHPOI
  88 :       ENDIF
  89 : 
  90 :       IMDL=0
  90 :       CALL MELMOF(IMDL,MTABD,IHV,TYPE,COEF,XPOI,MCHPOI,MCHELM,KPOIND,
  91 :      & 0,MCHELG)
  92 : 
  93 : 
  94 : C     write(6,*)' FIN LEKMIF '
  95 :       RETURN
  96 :  1001 FORMAT(20(1X,I5))
  97 :  1002 FORMAT(10(1X,1PE11.4))
  98 :       END
  99 :  
 100 :  
 101 :  
 102 :  
 103 :  
 104 :  
 105 :  
 106 :  
 107 :  
 108 :  
 109 :  
 110 :  
 111 :  

© Cast3M 2003 - All rights reserved.
Disclaimer