Télécharger la plaquette Cast3M


fr en

Télécharger nomc2.eso

Retour à la liste

Numérotation des lignes : 

nomc2

  1. C NOMC2     SOURCE    CB215821  20/11/25    13:34:52     10792          
  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. * nouveau paradigme sans segdes SG 2019/12/10
  14. *-----------------------------------------------------------------------
  15. *
  16.       SUBROUTINE NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)
  17.  
  18.       IMPLICIT INTEGER(I-N)
  19.       IMPLICIT REAL*8(A-H,O-Z)
  20.  
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC SMCHPOI
  25. -INC SMLMOTS
  26.  
  27.       IPCH2 = 0
  28. *
  29.       MLMOT1 = IPLM1
  30.       MLMOT2 = IPLM2
  31.       SEGACT,MLMOT1,MLMOT2
  32.       JGM1 = MLMOT1.MOTS(/2)
  33.       JGM2 = MLMOT2.MOTS(/2)
  34.       IF (JGM1.NE.JGM2) THEN
  35.          CALL ERREUR(217)
  36.          GOTO 900
  37.       ENDIF
  38.  
  39.       MCHPO1 = IPCH1
  40.       SEGINI,MCHPOI=MCHPO1
  41. *
  42.       NSOUPO = IPCHP(/1)
  43.       DO 20 J=1,NSOUPO
  44.          MSOUP1 = IPCHP(J)
  45.          SEGINI,MSOUPO=MSOUP1
  46.          IPCHP(J) = MSOUPO
  47. *
  48.          NC = NOCOMP(/2)
  49.          DO 30 K=1,NC
  50.             CALL PLACE(MLMOT1.MOTS,JGM1,IMO,NOCOMP(K))
  51.             IF (IMO.NE.0) THEN
  52.                NOCOMP(K) = MLMOT2.MOTS(IMO)
  53.             ENDIF
  54.  30      CONTINUE
  55.  20   CONTINUE
  56.  
  57.       IPCH2 = MCHPOI
  58.  
  59.  900  CONTINUE
  60.  
  61.       RETURN
  62.       END
  63.  
  64.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales