Esope source files

   1 : C MELMOF    SOURCE    MAGN      10/05/18    21:16:24     6675           
   2 :       SUBROUTINE MELMOF(IMDL,MTABD,IHV,TYPE,COEF,XPOI,MCHPOI,MCHELM,
   3 :      &KPOIND,MUG,MCHELG)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   6 : C***********************************************************************
   7 : C
   8 : C  Ce Sp crée un MCHAML a partir d'un FLOTTANT ou d'un CHPOIN
   9 : C Le MCHAML en retour est jetable et est calcule aux pts d'integrations
  10 : C Le support géométrique du MCHELM (MCHELN) est compatible avec le schema
  11 : C d'intégration de l'opérateur
  12 : C c'est le MELEME sauf pour les MACRO (INEFMD=2) avec CENTREP0
  13 : C CENTREP1 et MSOMMET où MELEME=MACRO1
  14 : C----------------------------------------------------------------------
  15 : C HISTORIQUE : 20/10/01 : Création
  16 : C
  17 : C HISTORIQUE :
  18 : C                                                                               
  19 : C                                                                               
  20 : C---------------------------
  21 : C Paramètres Entrée/Sortie :
  22 : C---------------------------
  23 : C                                                                               
  24 : C E/  MTABD  : Objet model de la zone
  25 : C E/  IHV    : 0 ou 1 Scalaire ou Vecteur
  26 : C E/  TYPE   : MOT  type du coefficient FLOTTANT VECTEUR CHPOINT
  27 : C E/  COEF   : FLOTTANT valeur du coef si flottant
  28 : C E/  XPOI   : POINT    valeur du coef si vecteur
  29 : C E/  MCHPOI : CHPOINT  valeur du coef si chpoint
  30 : C  /S MCHELM : Chamelem pts d'intégration pour le COEF
  31 : C E/  KPOIND : ENTIER type du support GÉométrique DUAL du shéma
  32 : C              d'intégration différent de KPOINC celui du coef
  33 : C              cette info sert à la construction du Chamelem
  34 : C E/  MUG=0 On rend le coefficient tel quel
  35 : C E/  MUG=1 Si le coefficient est un CHPOINT On retourne en plus le gradient
  36 : C  /S MCHELG : Chamelem pts d'intégration pour le Gradient du coef (=0 sinon)
  37 : C----------------------------------------------------------------------
  38 : C KPOIN = 0->SOMMET 1-> FACE     2-> CENTRE  3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
  39 : C INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE, INEFMD=4 LINB
  40 : C************************************************************************       
  41 : 
  42 : -INC SIZFFB
  43 :       POINTEUR IZF1.IZFFM,IZH2.IZHR,IZFD.IZFFM
  44 :       SEGMENT SAJT
  45 :       REAL*8 AJT(IDIM,IDIM,NPG)
  46 :       ENDSEGMENT
  47 : -INC SMCHAML
  48 :       POINTEUR MCHELG.MCHELM
  49 : -INC SMCHPOI
  50 : -INC SMELEME
  51 :       POINTEUR IGEOM.MELEME
  52 :       POINTEUR MELEMD.MELEME,SPGD.MELEME,MELEM1.MELEME,MELEMC.MELEME
  53 : -INC SMLENTI
  54 : -INC SMCOORD
  55 : -INC CCOPTIO
  56 : -INC CCGEOME
  57 :       CHARACTER*4 NOMD4
  58 :       CHARACTER*8 TYPE,NOM0
  59 :       DIMENSION XPOI(3)
  60 : C*****************************************************************************
  61 : CMELMOF
  62 : c     write(6,*)' DEBUT MELMOF MUG=',MUG
  63 : 
  64 :       MCHELG=0
  65 : 
  66 :       XPETI=1.D-30
  67 :       IAXI=0
  68 :       IF(IFOMOD.EQ.0)IAXI=2
  69 : C                                                                               
  69 :       CALL ACME(MTABD,'INEFMD',INEFMD)
  70 : c     write(6,*)'INEFMD=',INEFMD
  71 : 
  71 :       CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
  72 :       IF(INEFMD.EQ.2.AND.
  73 :      & (KPOIND.EQ.3.OR.KPOIND.EQ.4.OR.KPOIND.EQ.5))THEN
  73 :       CALL LEKTAB(MTABD,'MACRO1',MELEME)
  74 :       ENDIF
  75 : 
  76 :       SEGACT MELEME
  77 : 
  78 :       L1=72
  79 :       N1=MAX(1,LISOUS(/1))
  80 :       N2=1
  81 :       N3=6
  82 :       SEGINI MCHELM
  83 : 
  84 : C-------------------------------------------------------------------------
  85 : C__MCHAML
  86 : c     write(6,*)' MELMOF TYPE=',TYPE
  87 :       IF(TYPE.EQ.'MCHAML'.AND.IMDL.EQ.0)THEN
  88 : C% Le type d'inconnue %m1:8 ne convient pas.
  88 :       CALL ERREUR(927)
  89 :       RETURN
  90 :       ENDIF
  91 :       IF(TYPE.EQ.'MCHAML')THEN
  92 : 
  93 :       ITEST=0
  94 :       IREDU=0
  95 :       MCHEL1=MCHPOI
  96 :  452  CONTINUE
  97 :       SEGACT MCHEL1
  98 :       NN1=MCHEL1.IMACHE(/1)
  99 :         IF(NN1.NE.N1)THEN
 100 : c        write(6,*)' NN1 différent de N1',N1,NN1,MCHEL1,ITEST
 101 :          ITEST=ITEST+1
 102 :           IF(ITEST.GT.1)THEN
 103 : C% Le nombre de sous-zones du chamelem est supérieur au nombre de
 104 : C% sous-zones du modèle
 104 :            CALL ERREUR(553)
 105 :            RETURN
 106 :           ENDIF
 107 :         ENDIF
 108 : 
 109 :       SEGACT MELEME
 110 :       DO 455 L=1,MAX(1,LISOUS(/1))
 111 :        IPT1=MELEME
 112 :        IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
 113 :        IPT2=MCHEL1.IMACHE(L)
 114 : c       write(6,*)' IPT1=',IPT1,' IPT2=',IPT2
 115 :         IF(IPT1.NE.IPT2)THEN
 116 :          ITEST=1
 117 :          GO TO 456
 118 :         ENDIF
 119 :  455  CONTINUE
 120 :  456  CONTINUE
 121 : 
 122 :         IF(ITEST.EQ.1.AND.IREDU.EQ.0)THEN
 123 :         IREDU=1
 124 : c       write(6,*)' On reduiiit'
 124 :          CALL ECROBJ('MMODEL',IMDL)
 124 :          CALL ECROBJ('MCHAML',MCHEL1)
 124 :          CALL REDU
 124 :          CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
 125 :           IF(IRETOU.EQ.0)THEN
 125 :            CALL ERREUR(920)
 126 :            RETURN
 127 :           ENDIF
 128 :          GO TO 452
 129 :         ENDIF
 130 : 
 131 :       SEGACT MCHEL1
 132 :       MCHAM1=MCHEL1.ICHAML(1)
 133 :       SEGACT MCHAM1
 134 :       MELVA1=MCHAM1.IELVAL(1)
 135 :       SEGACT MELVA1
 136 : 
 137 : 
 138 :       SEGACT MELEME
 139 : 
 140 :       DO 371 L=1,MAX(1,LISOUS(/1))
 141 :       IPT1=MELEME
 142 :       IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
 143 :       SEGACT IPT1
 144 : 
 145 :       NOM0 = NOMS(IPT1.ITYPEL)//'    '
 145 :       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
 146 :       SEGACT IZFFM
 147 :       IZHR=KZHR(1)
 148 :       SEGACT IZHR*MOD
 149 :       IZF1=KTP(1)
 150 :       IZH2=KZHR(2)
 151 : 
 152 :       NES=GR(/1)
 153 :       NPG=GR(/3)
 154 : 
 155 :       NBNN  =IPT1.NUM(/1)
 156 :       NBELEM=IPT1.NUM(/2)
 157 :       SEGINI MCHAML
 158 :       IDU=1
 159 :       IF(IHV.EQ.1)IDU=IDIM
 160 :       SEGINI SAJT
 161 :       N1PTEL=NPG*IDU
 162 :       N1EL  =NBELEM
 163 :       N2PTEL=0
 164 :       N2EL=0
 165 : 
 166 :       IMACHE(L)=IPT1
 167 :       ICHAML(L)=MCHAML
 168 : 
 169 :       MCHAM1=MCHEL1.ICHAML(L)
 170 :       SEGACT MCHAM1
 171 :       MELVA1=MCHAM1.IELVAL(1)
 172 :       SEGACT MELVA1
 173 : 
 174 :       SEGINI MELVAL
 175 :       IELVAL(1)=MELVAL
 176 : 
 177 :       DO 375 K=1,NBELEM
 178 :       COEF=MELVA1.VELCHE(1,K)
 179 : 
 180 :       IF(IHV.EQ.0)THEN
 181 :       DO 372 LG=1,NPG
 182 :       VELCHE(LG,K)=COEF
 183 :  372  CONTINUE
 184 :       ELSEIF(IHV.EQ.1)THEN
 185 :       DO 374 N =1,IDIM
 186 :       DO 374 LG=1,NPG
 187 :       VELCHE(LG+(N-1)*NPG,1)=XPOI(N)
 188 :  374  CONTINUE
 189 :       ENDIF
 190 :  375  CONTINUE
 191 : 
 192 :       SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
 193 :       SEGDES IPT1,MCHAML,MELVAL
 194 :  371  CONTINUE
 195 :       SEGDES MCHELM,MELEME
 196 : 
 197 : 
 198 : C__FLOTTANT ENTIER ou POINT
 199 :       ELSEIF(TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER'.OR.
 200 :      &   TYPE.EQ.'POINT' )THEN
 201 : c     write(6,*)' MELMOF CAS ENTIER OU POINT : TYPE=',TYPE
 202 : 
 203 : 
 204 :       DO 171 L=1,MAX(1,LISOUS(/1))
 205 :       IPT1=MELEME
 206 :       IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
 207 :       SEGACT IPT1
 208 : 
 209 :       NOM0 = NOMS(IPT1.ITYPEL)//'    '
 209 :       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
 210 :       SEGACT IZFFM
 211 :       IZHR=KZHR(1)
 212 :       SEGACT IZHR*MOD
 213 :       IZF1=KTP(1)
 214 :       IZH2=KZHR(2)
 215 : 
 216 :       NES=GR(/1)
 217 :       NPG=GR(/3)
 218 : 
 219 :       NBNN  =IPT1.NUM(/1)
 220 :       NBELEM=IPT1.NUM(/2)
 221 :       SEGINI MCHAML
 222 :       IDU=1
 223 :       IF(IHV.EQ.1)IDU=IDIM
 224 :       SEGINI SAJT
 225 :       N1PTEL=NPG*IDU
 226 :       N1EL  =1
 227 :       N2PTEL=0
 228 :       N2EL=0
 229 : 
 230 :       IMACHE(L)=IPT1
 231 :       ICHAML(L)=MCHAML
 232 : 
 233 :       SEGINI MELVAL
 234 :       IELVAL(1)=MELVAL
 235 : 
 236 :       IF(IHV.EQ.0)THEN
 237 :       DO 172 LG=1,NPG
 238 :       VELCHE(LG,1)=COEF
 239 :  172  CONTINUE
 240 :       ELSEIF(IHV.EQ.1)THEN
 241 :       DO 174 N =1,IDIM
 242 :       DO 174 LG=1,NPG
 243 :       VELCHE(LG+(N-1)*NPG,1)=XPOI(N)
 244 :  174  CONTINUE
 245 :       ENDIF
 246 : 
 247 :       SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
 248 :       SEGDES IPT1,MCHAML,MELVAL
 249 :  171  CONTINUE
 250 :       SEGDES MCHELM,MELEME
 251 : 
 252 : C__CHPOINT
 253 :       ELSEIF(TYPE.EQ.'CHPOINT')THEN
 254 : c        write(6,*)' MELMOF CAS CHPOINT'
 255 : 
 256 :          IF(IHV.EQ.0.AND.MUG.EQ.1)THEN
 257 : C ON SORT LE GRADIENT DU COEFFICIENT EN PLUS
 258 :          MUVARI=1
 259 :       L1=72
 260 :       N1=MAX(1,LISOUS(/1))
 261 :       N2=1
 262 :       N3=6
 263 :       SEGINI MCHELG
 264 :          ELSE
 265 :          MUVARI=0
 266 :          ENDIF
 267 : 
 268 :          SEGACT MCHPOI
 269 :          NSOUPO=IPCHP(/1)
 270 : 
 271 :          IF(NSOUPO.EQ.1) THEN
 272 :          MSOUPO=IPCHP(1)
 273 :          SEGACT MSOUPO
 274 :          IGEOM=IGEOC
 275 :          MPOVAL=IPOVAL
 276 :          SEGDES MSOUPO
 277 :          SEGACT MPOVAL
 278 :          NC=VPOCHA(/2)
 279 : C On ne traite que les coefficients scalaires
 280 :          IF(IHV.EQ.0.AND.NC.NE.1)THEN
 281 : c        write(6,*)' MELMOF IHV=',IHV,' NC=',NC
 281 :          CALL ERREUR(788)
 282 :          RETURN
 283 :          ENDIF
 284 :          IF(IHV.EQ.1.AND.NC.NE.IDIM)THEN
 285 : c        write(6,*)' MELMOF IHV=',IHV,' NC=',NC
 285 :          CALL ERREUR(788)
 286 :          RETURN
 287 :          ENDIF
 288 :          ELSE
 288 :          CALL ERREUR(788)
 289 :          RETURN
 290 :          ENDIF
 291 : 
 292 : c        write(6,*)' IGEOM=',IGEOM
 292 :       CALL KRIPAD(IGEOM,MLENTI)
 293 : 
 294 :          KPOINC=0
 295 :          NOMD4= '    '
 295 :          CALL LEKTAB(MTABD,'MAILLAGE',MELEMD)
 296 : 
 297 :          IF(INEFMD.EQ.2.AND.
 298 :      &   (KPOIND.EQ.3.OR.KPOIND.EQ.4.OR.KPOIND.EQ.5))THEN
 298 :          CALL LEKTAB(MTABD,'MACRO1',MELEMD)
 299 :          ENDIF
 300 : 
 300 :          CALL LEKTAB(MTABD,'SOMMET',SPGD)
 300 :          CALL VERPAD(MLENTI,SPGD,IRET)
 301 : c        write(6,*)' SOMMET (0 OK) ',SPGD,iret
 302 :          SEGDES SPGD
 303 :         IF(IRET.EQ.0)GO TO 180
 304 :          KPOINC=2
 305 :          NOMD4= '    '
 305 :          CALL LEKTAB(MTABD,'CENTRE',MELEMD)
 305 :          CALL LEKTAB(MTABD,'CENTRE',SPGD)
 305 :          CALL VERPAD(MLENTI,SPGD,IRET)
 306 : c        write(6,*)' CENTRE (0 OK) ',SPGD,iret
 307 :          SEGDES SPGD
 308 :          IF(INEFMD.EQ.3)THEN
 309 :          KPOINC=3
 310 :          NOMD4= 'PRP0'
 311 :          ENDIF
 312 :         IF(IRET.EQ.0)GO TO 180
 313 :          KPOINC=5
 314 :          NOMD4= 'P1P1'
 315 :          IF(INEFMD.EQ.2)NOMD4= 'MCF1'
 316 :          IF(INEFMD.EQ.3)NOMD4= 'PFP1'
 316 :          CALL LEKTAB(MTABD,'MMAIL  ',MELEMD)
 316 :          CALL LEKTAB(MTABD,'MSOMMET',SPGD)
 316 :          CALL VERPAD(MLENTI,SPGD,IRET)
 317 : c        write(6,*)'MSOMMET (0 OK) ',SPGD,iret
 318 :          SEGDES SPGD
 319 :         IF(IRET.EQ.0)GO TO 180
 320 :          IF(INEFMD.EQ.2.OR.INEFMD.EQ.3)THEN
 321 :            KPOINC=4
 322 :            NOMD4= '    '
 323 :            IF(INEFMD.EQ.2)NOMD4= 'MCP1'
 324 :            IF(INEFMD.EQ.3)NOMD4= 'PRP1'
 324 :            CALL LEKTAB(MTABD,'ELTP1NC ',MELEMD)
 324 :            CALL LEKTAB(MTABD,'CENTREP1',SPGD)
 324 :            CALL VERPAD(MLENTI,SPGD,IRET)
 325 : c          write(6,*)'CENTREP1 (0 OK) ',SPGD,iret
 326 :            SEGDES SPGD
 327 :           IF(IRET.EQ.0)GO TO 180
 328 :            KPOINC=3
 329 :            NOMD4= '    '
 330 :            IF(INEFMD.EQ.2)NOMD4= 'MCP0'
 331 :            IF(INEFMD.EQ.3)NOMD4= 'PRP0'
 331 :            CALL LEKTAB(MTABD,'CENTREP0',MELEMD)
 331 :            CALL LEKTAB(MTABD,'CENTREP0',SPGD)
 331 :            CALL VERPAD(MLENTI,SPGD,IRET)
 332 :            SEGDES SPGD
 333 :           IF(IRET.EQ.0)GO TO 180
 334 :          ENDIF
 335 : 
 336 : C__CHPOINT_SUPPORT_INCONU
 337 : C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
 338 :           MOTERR(1: 8) = 'CHPOINT '
 339 :           MOTERR(9:16) = ' COEF   '
 339 :           CALL ERREUR(788)
 340 :           RETURN
 341 :  180  CONTINUE
 342 :       SEGDES IGEOM
 343 : C__CHPOINT
 344 : c      write(6,*)' CAs CHPOIN '
 345 : 
 346 :       SEGACT MELEMD
 347 : 
 348 :       NKD0=0
 349 :       DO 191 L=1,MAX(1,LISOUS(/1))
 350 :       IPT1=MELEME
 351 :       IPT2=MELEMD
 352 :       IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
 353 :       SEGACT IPT1
 354 :       IF(MELEMD.LISOUS(/1).NE.0)IPT2=MELEMD.LISOUS(L)
 355 :       SEGACT IPT2
 356 :       IF(MELEMD.LISOUS(/1).NE.0)NKD0=0
 357 :       MP=IPT2.NUM(/1)
 358 : 
 359 : C-----------------------------------------------------------------------
 360 :       IF(KPOIND.NE.2)THEN
 361 :        IF(INEFMD.EQ.3)THEN
 362 :        IF(KPOIND.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
 363 :        IF(KPOIND.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
 364 :        IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'PFP1'
 365 :        ELSEIF(INEFMD.EQ.2)THEN
 366 :        IF(KPOIND.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
 367 :        IF(KPOIND.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
 368 :        IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'MCF1'
 369 :        ELSEIF(INEFMD.EQ.1)THEN
 370 :        IF(KPOIND.EQ.5)NOM0=NOMS(IPT1.ITYPEL)//'P1P1'
 371 :        ELSEIF(INEFMD.EQ.4)THEN
 372 :        NOM0=NOMS(IPT1.ITYPEL)//'    '
 373 :        ENDIF
 374 :       ENDIF
 375 : 
 376 :       IF(KPOIND.EQ.2)THEN
 377 :       NOM0 = NOMS(IPT1.ITYPEL)//NOMD4
 378 :       ENDIF
 379 : 
 380 :       IF(KPOIND.EQ.0)THEN
 381 :       NOM0 = NOMS(IPT1.ITYPEL)
 382 :       NOM0 = NOMS(IPT1.ITYPEL)//NOMD4
 383 :       ENDIF
 384 : 
 385 : C-----------------------------------------------------------------------
 386 : cc      write(6,*)' MELMOF 2 KPOIND=',KPOIND,' NOMS=',NOMS(IPT1.ITYPEL),
 387 : cc     & ' NOMD4=',NOMD4,' NOM0=',NOM0
 387 :       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
 388 :       SEGACT IZFFM
 389 :       IZHR=KZHR(1)
 390 :       IZF1=KTP(1)
 391 :       IZH2=KZHR(2)
 392 :       SEGACT IZHR*MOD
 393 : 
 394 :       IZFD=IZF1
 395 :       IF(KPOINC.EQ.0)IZFD=IZFFM
 396 :       SEGACT IZFD*MOD
 397 :       IF(MP.NE.IZFD.FN(/1))THEN
 398 :       write(6,*)' Gross problem dans MELMOF'
 399 :       write(6,*)' INEFMD=',INEFMD,' NOMD4=',NOMD4
 400 :       write(6,*)' MP=',MP,' KPOINC.=',KPOINC,' IZFD.FN(/1)='
 401 :      & ,IZFD.FN(/1)
 402 :       ENDIF
 403 : 
 404 : 
 405 :       NES=GR(/1)
 406 :       NP =GR(/2)
 407 :       NPG=GR(/3)
 408 : 
 409 :       NBNN  =IPT1.NUM(/1)
 410 :       NBELEM=IPT1.NUM(/2)
 411 :       SEGINI MCHAML
 412 : 
 413 :       IDU=1
 414 :       IF(IHV.EQ.1)IDU=IDIM
 415 :       SEGINI SAJT
 416 :       N1PTEL=NPG*IDU
 417 :       N1EL  =NBELEM
 418 :       N2PTEL=0
 419 :       N2EL=0
 420 :       IMACHE(L)=IPT1
 421 :       ICHAML(L)=MCHAML
 422 : 
 423 :       SEGINI MELVAL
 424 :       IELVAL(1)=MELVAL
 425 : 
 426 : C......................................MUVARI..DEBUT
 427 :       IF(MUVARI.EQ.1)THEN
 428 :       N2=IDIM
 429 :       SEGINI MCHAM1
 430 :       N1PTEL=NBNN
 431 :       N1EL  =NBELEM
 432 :       N2PTEL=0
 433 :       N2EL=0
 434 :       MCHELG.IMACHE(L)=IPT1
 435 :       MCHELG.ICHAML(L)=MCHAM1
 436 : 
 437 :       SEGINI MELVA1
 438 :       MCHAM1.IELVAL(1)=MELVA1
 439 : 
 440 :       ENDIF
 441 : C......................................MUVARI..FIN
 442 : 
 443 :       ID1=1
 444 :       IF(IHV.EQ.1)ID1=IDIM
 445 : 
 446 :       NKD=NKD0
 447 :       DO 192 K=1,N1EL
 448 :       NKD=NKD+1
 449 :       DO 194 N=1,ID1
 450 :       DO 194 LG=1,NPG
 451 :       U=0.D0
 452 :       DO 193 I=1,MP
 453 :       I1=LECT(IPT2.NUM(I,NKD))
 454 :       U=U+IZFD.FN(I,LG)*VPOCHA(I1,N)
 455 :  193  CONTINUE
 456 :       VELCHE(LG+(N-1)*NPG,K)=U
 457 :  194  CONTINUE
 458 :  192  CONTINUE
 459 : 
 460 :       SEGDES MELVAL,MCHAML
 461 : 
 462 : C......................................MUVARI..DEBUT
 463 :       IF(MUVARI.EQ.1)THEN
 464 : 
 465 :       NKD=NKD0
 466 :       DO 292 K=1,N1EL
 467 :       NKD=NKD+1
 468 :       DO 293 I=1,MP
 469 :       I1=LECT(IPT2.NUM(I,NKD))
 470 :       MELVA1.VELCHE(I,K)=VPOCHA(I1,1)
 471 :  293  CONTINUE
 472 :  292  CONTINUE
 473 : 
 474 :       SEGDES MELVA1,MCHAM1
 475 : 
 476 :       ENDIF
 477 : C......................................MUVARI..FIN
 478 : 
 479 :       NKD0=NKD
 480 :       SEGDES IPT1
 481 :       SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT
 482 : 
 483 :  191  CONTINUE
 484 :       SEGDES MCHELM
 485 :       IF(MUVARI.EQ.1)SEGDES MCHELG
 486 : 
 487 :       SEGDES MCHPOI,MSOUPO,MPOVAL
 488 :       SEGDES MELEME
 489 :       SEGSUP MLENTI
 490 : 
 491 : 
 492 :       ENDIF
 493 : 
 494 : C*************************************************************************
 495 : 
 496 : c     write(6,*)' FIN MELMOF '
 497 :       RETURN
 498 :  1001 FORMAT(20(1X,I5))
 499 :  1002 FORMAT(10(1X,1PE11.4))
 500 :       END
 501 :  
 502 :  
 503 :  
 504 :  
 505 :  
 506 :  
 507 :  
 508 :  
 509 :  
 510 :  
 511 :  
 512 :  
 513 :  
 514 :  
 515 :