Esope source files

   1 : C NOMC3     SOURCE    PV        11/03/08    21:15:44     6888           
   2 :       SUBROUTINE NOMC3(IPCH1,IPLM1,IPLM2,IPCH2,MOT)   
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : *-----------------------------------------------------------------------
   6 : *
   7 : * Renommer certaines composantes d'un MCHAML
   8 : *
   9 : * IPCH1 (e)     pointeur sur un champ par points (type MCHAML)
  10 : * IPLM1 (e)     liste des composantes a remplacer (type LISTMOTS)
  11 : * IPLM2 (e)     liste des nouvelles composantes (type LISTMOTS)
  12 : * IPCH2 (s)     objet resultat (type MCHAML) 
  13 : * MOT           nouveau nom de composante
  14 : *
  15 : * kich 01/99
  16 : *-----------------------------------------------------------------------
  17 : -INC CCOPTIO
  18 : -INC SMCHAML
  19 : -INC SMLMOTS
  20 : *
  21 :        CHARACTER*(*) MOT
  22 : 
  23 : * le MCHAML ne doit avoir qu un constituant
  24 :        mchel1 = ipch1
  25 :        segact mchel1
  26 :        n1 = mchel1.ichaml(/1)
  27 :        n3 = mchel1.infche(/2)
  28 : *       if (n1.gt.1) then 
  29 : *         do ico = 2,n1 
  30 : *           if (mchel1.conche(ico).ne.mchel1.conche(1)) then
  30 : *             call erreur(716)
  31 : *             goto 990
  32 : *           endif
  33 : *         enddo
  34 : *       endif
  35 :        segini,mchelm = mchel1
  36 :       
  37 :       do 1 icha = 1,n1 
  38 :        mcham1 = mchel1.ichaml(icha)
  39 :        segact mcham1
  40 :        n2 = mcham1.ielval(/1)
  41 : 
  42 :        IF (IPLM1.NE.-1) goto 100
  43 : * cas du MCHAML a une composante 
  44 :        if (n2.gt.1) then
  45 :           moterr(1:8) = mot
  46 :           moterr(9:16) = 'MCHAML  '
  46 :           call erreur(784)
  47 :           goto 980
  48 :        endif
  49 :        segini,mchaml = mcham1
  50 :        ichaml(icha) = mchaml
  51 :        nomche(1) = mot
  52 : 
  53 :        melva1 = mcham1.ielval(1)
  54 :        segact melva1
  55 :        n1ptel = melva1.velche(/1)
  56 :        n1el = melva1.velche(/2)
  57 :        n2ptel = melva1.ielche(/1)
  58 :        n2el = melva1.ielche(/2)
  59 :        segini,melval=melva1
  60 : 
  61 :        ielval(1) = melval
  62 :        segdes melva1, melval
  63 :        goto 900
  64 : 
  65 :  100   continue
  66 : * cas du MCHAML a plusieurs composantes
  67 :       MLMOT1 = IPLM1
  68 :       SEGACT MLMOT1
  69 :       JGM1 = MLMOT1.MOTS(/2)
  70 :       MLMOT2 = IPLM2
  71 :       SEGACT MLMOT2
  72 :       JGM2 = MLMOT2.MOTS(/2)
  73 :       IF (JGM1.NE.JGM2) THEN
  73 :          CALL ERREUR(217)
  74 :          SEGDES MLMOT1,MLMOT2
  75 :          goto 980
  76 :       ENDIF
  77 :        segini,mchaml = mcham1
  78 :        ichaml(icha) = mchaml
  79 :          DO 130 K=1,n2
  79 :             CALL PLACE(MLMOT1.MOTS,JGM1,IMO,mcham1.nomche(k))
  80 :             IF (IMO.NE.0) THEN
  81 :                nomche(k) = MLMOT2.MOTS(IMO)
  82 :             ELSE
  83 :                nomche(k) = mcham1.nomche(k)
  84 :             ENDIF
  85 :            melva1 = mcham1.ielval(k)   
  86 :        segact melva1
  87 :        n1ptel = melva1.velche(/1)
  88 :        n1el = melva1.velche(/2)
  89 :        n2ptel = melva1.ielche(/1)
  90 :        n2el = melva1.ielche(/2)
  91 :        segini,melval = melva1
  92 :            
  93 :           ielval(k) = melval
  94 :           segdes melva1, melval
  95 :  130     CONTINUE
  96 : 
  97 :        
  98 :  900   continue
  99 :        segdes mchaml,mcham1
 100 :    1   continue 
 101 : 
 102 :        segdes mchelm,mchel1
 103 :        IPCH2 = MCHELM
 104 :        return
 105 : 
 106 :  980   continue
 107 :        segdes mcham1
 108 :        do ik = 1,n1
 109 :          mchaml = ichaml(ik)
 110 :          if (mchaml.gt.-1) then
 111 :          segact mchaml
 112 :          do il = 1,ielval(/1)
 113 :            melval = ielval(il)
 114 :            if (melval.gt.-1) segsup melval
 115 :          enddo
 116 :          segsup mchaml
 117 :          endif
 118 :        enddo
 119 :        segsup mchelm
 120 :  990   continue
 121 :        segdes mchel1
 122 :        return
 123 :        end
 124 : 
 125 : 
 126 :  
 127 :  
 128 :  
 129 :  
 130 :  
 131 :