Download lekmof.eso

Back to the list

   1 : C LEKMOF    SOURCE    PV        09/03/12    21:27:24     6325           
   2 :       SUBROUTINE LEKMOF(MTABD,NU,MTABX,KINC,IHV,MCHELM,KPOIND,
   3 :      &MUG,MCHELG)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   6 : C***********************************************************************
   7 : C
   8 : C Ce sous programme lit le NUième coefficient d'un opérateur, stocké
   9 : C à l'indice ARGnu de la table KIZX de pointeur MTABX associée à
  10 : C l'opérateur en cours de traitement.
  11 : C Le coefficient est de type ENTIER, FLOTTANT, POINT, CHPOINT ou MOT.
  12 : C Dans le cas MOT, on récupère la donnée se trouvant à l'indice MOT
  13 : C de la table INCO.
  14 : C Ce Sp lit lit le coefficient et rend un MCHAML quoi qu'il arrive
  15 : C Le MCHAML en retour est jetable il est calcule aux pts d'integrations
  16 : C----------------------------------------------------------------------
  17 : C HISTORIQUE : 20/10/01 : Création
  18 : C
  19 : C HISTORIQUE :
  20 : C                                                                               
  21 : C                                                                               
  22 : C---------------------------
  23 : C Paramètres Entrée/Sortie :
  24 : C---------------------------
  25 : C                                                                               
  26 : C E/  MTABD  : Objet model de la zone
  27 : C E/  NU     : Rang du coefficient à aller chercher (ENTIER)
  28 : C E/  MTABX  : Pointeur de la table contenant le coefficient
  29 : C E/  KINC   : Pointeur de la table INCO dans laquelle on va chercher
  30 : C              les valeurs des indices lorsque ceux-ci sont des MOTS.
  31 : C E/  IHV=0 CHPOINT SCALAIRE ou FLOTTANT
  32 : C     IHV=1 CHPOINT VECTEUR  ou POINT
  33 : C E/  MUG=0 On rend le coefficient tel quel
  34 : C E/  MUG=1 Si le coefficient est un CHPOINT On retourne en plus le gradient
  35 : C  /S MCHELM : Chamelem pts d'intégration pour le COEF
  36 : C  /S MCHELG : Chamelem pts d'intégration pour le Gradient du coef (=0 sinon)
  37 : C E/  KPOIND : ENTIER type du support GÉométrique DUAL du shéma
  38 : C              d'intégration => pour la création du Chamelem
  39 : C----------------------------------------------------------------------
  40 : C KPOIN = 0->SOMMET 1-> FACE     2-> CENTRE  3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
  41 : C----------------------------------------------------------------------
  42 : C************************************************************************       
  43 : 
  44 : -INC SMCHAML
  45 : -INC SMCHPOI
  46 : -INC SMELEME
  47 : -INC SMCOORD
  48 : -INC CCOPTIO
  49 : -INC CCGEOME
  50 :       CHARACTER*8 TYPE,NOM,NARG,TYPM
  51 :       LOGICAL LOGI
  52 :       DIMENSION XPOI(3)
  53 : C*****************************************************************************
  54 : CLEKMOF
  55 : C                                                                               
  56 : C- Récupération du TYPE du NUième argument de l'opérateur
  57 : C                                                                               
  58 : C     write(6,*)' DEBUT LEKMOF NU=',NU
  59 : 
  60 :       IF (NU.LE.0 .OR. NU.GE.100) THEN
  61 :          INTERR(1) = NU
  62 :          INTERR(2) = 1
  63 :          INTERR(3) = 99
  63 :          CALL ERREUR(789)
  64 :          RETURN
  65 :       ENDIF
  66 :       IF (NU.LE.9) THEN
  67 :          WRITE(NARG,FMT='(A3,I1)')'ARG',Nu
  68 :       ELSE
  69 :          WRITE(NARG,FMT='(A3,I2)')'ARG',Nu
  70 :       ENDIF
  71 :       TYPE = ' '
  71 :       CALL LENCHA(NARG,LC)
  72 : c     write(6,*)' AVANT ACCTAB type=',type,NARG(1:LC),nom
  72 :       CALL ACCTAB(MTABX,'MOT',   0,0.D0,NARG(1:LC),LOGI,     0,
  73 :      &                  TYPE ,IVAL,COEF,       NOM,LOGI,MCHPOI)
  74 : 
  75 : c     write(6,*)' TYPE,COEF,MCHPOI,IVAL=',TYPE,COEF,MCHPOI,IVAL
  76 :       IF(TYPE.EQ.'ENTIER')COEF=FLOAT(IVAL)
  77 :       IF(TYPE.EQ.'MOT')THEN
  78 :       TYPE=' '
  78 :       CALL ACMO(KINC,NOM,TYPE,MCHPOI)
  79 : 
  80 : c     write(6,*)' NOM=',NOM,' TYPE,ip=',TYPE,MCHPOI
  81 :        IF(TYPE.EQ.'ENTIER')THEN
  81 :         CALL ACME(KINC,NOM,IVAL)
  82 :         COEF=FLOAT(IVAL)
  83 :         ELSEIF(TYPE.EQ.'FLOTTANT')THEN
  83 :         CALL ACMF(KINC,NOM,COEF)
  84 :        ENDIF
  85 :       ENDIF
  86 : 
  87 : 
  88 :        IF(TYPE.EQ.'POINT')THEN
  89 :         IP=MCHPOI
  90 :         XPOI(1) = XCOOR((IP-1)*(IDIM+1) +1)
  91 :         XPOI(2) = XCOOR((IP-1)*(IDIM+1) +2)
  92 :         IF (IDIM.EQ.3) XPOI(3) = XCOOR((IP-1)*(IDIM+1) +3)
  93 :        ENDIF
  94 : 
  95 : c       write(6,*)'TYPE=',TYPE
  96 :       IF(TYPE.NE.'FLOTTANT'.AND.TYPE.NE.'ENTIER'.AND.
  97 :      &   TYPE.NE.'CHPOINT '.AND.TYPE.NE.'MCHAML  '.AND.IHV.EQ.0)THEN
  98 : C On ne veut pas d'objet de type %m1:8
  99 :       MOTERR(1: 8) = TYPE
  99 :       CALL ERREUR(39)
 100 :       RETURN
 101 :       ENDIF
 102 : 
 103 :       IF(TYPE.NE.'POINT'.AND.
 104 :      &   TYPE.NE.'CHPOINT '.AND.TYPE.NE.'MCHAML  '.AND.IHV.EQ.1)THEN
 105 : C On ne veut pas d'objet de type %m1:8
 106 :       MOTERR(1: 8) = TYPE
 106 :       CALL ERREUR(39)
 107 :       RETURN
 108 :       ENDIF
 109 : 
 110 :          TYPM=' '
 110 :          CALL ACMO(MTABX,'DOMZ',TYPM,IMDL)
 110 :       CALL MELMOF(IMDL,MTABD,IHV,TYPE,COEF,XPOI,MCHPOI,MCHELM,KPOIND,
 111 :      &MUG,MCHELG)
 112 : 
 113 : c     write(6,*)' FIN LEKMOF MUG=',MUG
 114 :       RETURN
 115 :  1001 FORMAT(20(1X,I5))
 116 :  1002 FORMAT(10(1X,1PE11.4))
 117 :       END
 118 :  
 119 :  
 120 :  
 121 :  
 122 :  
 123 :  
 124 :  
 125 :  
 126 :  
 127 :  

© Cast3M 2003 - All rights reserved.
Disclaimer