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    GOUNAND   25/04/30    21:15:23     12258          
  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. * verif que le resultat n'aura pas de composantes en double SG 2025/04/30
  15. *-----------------------------------------------------------------------
  16. *
  17.       SUBROUTINE NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)
  18.  
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMCHPOI
  26. -INC SMLMOTS
  27.       POINTEUR MLCOMP.MLMOTS,MLCOM2.MLMOTS
  28. *
  29.       CHARACTER*(LOCHPO) CNC
  30.  
  31. *      write(ioimp,*) 'nomc2'
  32.       IPCH2 = 0
  33. *
  34.       MLMOT1 = IPLM1
  35.       MLMOT2 = IPLM2
  36.       SEGACT,MLMOT1,MLMOT2
  37.       JGM1 = MLMOT1.MOTS(/2)
  38.       JGM2 = MLMOT2.MOTS(/2)
  39.       IF (JGM1.NE.JGM2) THEN
  40.          CALL ERREUR(217)
  41.          GOTO 900
  42.       ENDIF
  43. *
  44. * Transformation des noms de composantes et verification pas de doublons
  45. *
  46.       call extr11(IPCH1,MLCOMP)
  47.       if (ierr.ne.0) return
  48.       NCOMP=MLCOMP.MOTS(/2)
  49.       DO ICOMP=1,NCOMP
  50.          CNC=MLCOMP.MOTS(ICOMP)
  51.          CALL PLACE(MLMOT1.MOTS,JGM1,IMO,CNC)
  52.          IF (IMO.NE.0) THEN
  53.             MLCOMP.MOTS(ICOMP) = MLMOT2.MOTS(IMO)
  54.          ENDIF
  55.       ENDDO
  56.       call cuniq2(mlcomp,mlcom2)
  57.       if (ierr.ne.0) return
  58.       NCOM2=MLCOM2.MOTS(/2)
  59.       IF (NCOM2.LT.NCOMP) THEN
  60.          CALL ECROBJ('LISTMOTS',mlcomp)
  61.          CALL PRLIST
  62.          CALL ERREUR(674)
  63.          RETURN
  64.       ENDIF
  65.       segsup mlcomp
  66.       segsup mlcom2
  67. *
  68.       MCHPO1 = IPCH1
  69.       SEGINI,MCHPOI=MCHPO1
  70. *
  71.       NSOUPO = IPCHP(/1)
  72.       DO 20 J=1,NSOUPO
  73.          MSOUP1 = IPCHP(J)
  74.          SEGINI,MSOUPO=MSOUP1
  75.          IPCHP(J) = MSOUPO
  76. *
  77.          NC = NOCOMP(/2)
  78.          DO 30 K=1,NC
  79.             CALL PLACE(MLMOT1.MOTS,JGM1,IMO,NOCOMP(K))
  80.             IF (IMO.NE.0) THEN
  81.                NOCOMP(K) = MLMOT2.MOTS(IMO)
  82.             ENDIF
  83.  30      CONTINUE
  84.  20   CONTINUE
  85.  
  86.       IPCH2 = MCHPOI
  87.  
  88.  900  CONTINUE
  89.  
  90.       RETURN
  91.       END
  92.  
  93.  

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