Esope source files

   1 : C NOMC2     SOURCE    FANDEUR   11/07/19    21:16:49     7039           
   2 : 
   3 : *-----------------------------------------------------------------------
   4 : *
   5 : * Renommer certaines composantes d'un CHPOINT
   6 : *
   7 : * IPCH1 (e)     pointeur sur un champ par points (type CHPOINT)
   8 : * IPLM1 (e)     liste des composantes a remplacer (type LISTMOTS)
   9 : * IPLM2 (e)     liste des nouvelles composantes (type LISTMOTS)
  10 : * IPCH2 (s)     objet resultat (type CHPOINT) 
  11 : *
  12 : * D. R.-M. le 4/2/94
  13 : *-----------------------------------------------------------------------
  14 : *                                                  
  15 :       SUBROUTINE NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)   
  16 : 
  17 :       IMPLICIT INTEGER(I-N)
  18 :       IMPLICIT REAL*8(A-H,O-Z)
  19 : 
  20 : -INC CCOPTIO
  21 : -INC SMCHPOI
  22 : -INC SMLMOTS
  23 : 
  24 :       IPCH2 = 0
  25 : *
  26 :       MLMOT1 = IPLM1
  27 :       MLMOT2 = IPLM2
  28 :       SEGACT,MLMOT1,MLMOT2
  29 :       JGM1 = MLMOT1.MOTS(/2)
  30 :       JGM2 = MLMOT2.MOTS(/2)
  31 :       IF (JGM1.NE.JGM2) THEN
  31 :          CALL ERREUR(217)
  32 :          GOTO 900
  33 :       ENDIF
  34 : 
  35 :       MCHPO1 = IPCH1
  36 :       SEGINI,MCHPOI=MCHPO1
  37 : *
  38 :       NSOUPO = IPCHP(/1)
  39 :       DO 20 J=1,NSOUPO
  40 :          MSOUP1 = IPCHP(J)
  41 :          SEGINI,MSOUPO=MSOUP1
  42 :          IPCHP(J) = MSOUPO
  43 : *
  44 :          NC = NOCOMP(/2)
  45 :          DO 30 K=1,NC
  45 :             CALL PLACE(MLMOT1.MOTS,JGM1,IMO,NOCOMP(K))
  46 :             IF (IMO.NE.0) THEN
  47 :                NOCOMP(K) = MLMOT2.MOTS(IMO)
  48 :             ENDIF
  49 :  30      CONTINUE
  50 : *
  51 :          MPOVA1 = IPOVAL
  52 :          SEGINI,MPOVAL=MPOVA1
  53 :          IPOVAL = MPOVAL
  54 : *
  55 :          SEGDES,MPOVAL,MSOUPO
  56 : *
  57 :  20   CONTINUE
  58 :       SEGDES,MCHPOI
  59 : *
  60 :       IPCH2 = MCHPOI
  61 : 
  62 :  900  CONTINUE
  63 :       SEGDES,MLMOT1,MLMOT2
  64 : *
  65 :       RETURN
  66 :       END
  67 : 
  68 :