Télécharger la plaquette Cast3M


fr en

Télécharger nomc3.eso

Retour à la liste

Numérotation des lignes : 

nomc3

  1. C NOMC3     SOURCE    PV090527  25/01/07    14:42:51     12115          
  2.  
  3. *-----------------------------------------------------------------------
  4. * Renommer certaines composantes d'un MCHAML
  5. *
  6. * IPCH1 (e)     pointeur sur un champ par element (type MCHAML)
  7. * IPLM1 (e)     liste des composantes a remplacer (type LISTMOTS)
  8. * IPLM2 (e)     liste des nouvelles composantes   (type LISTMOTS)
  9. * IPCH2 (s)     objet resultat                    (type MCHAML)
  10. * MOT           nouveau nom de composante
  11. *
  12. * kich 01/99
  13. * nouveau paradigme sans segdes SG 2019/12/10
  14. *-----------------------------------------------------------------------
  15.       SUBROUTINE NOMC3(IPCH1,IPLM1,IPLM2,IPCH2,MOT)
  16.  
  17.       IMPLICIT INTEGER(I-N)
  18.       IMPLICIT REAL*8(A-H,O-Z)
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCOORD
  23.  
  24. -INC SMCHAML
  25. -INC SMLMOTS
  26.  
  27.       CHARACTER*(*) MOT
  28.  
  29.       IPCH2 = 0
  30.  
  31.       mchel1 = IPCH1
  32.       SEGINI,mchelm = mchel1
  33.       n1 = mchelm.ichaml(/1)
  34.  
  35. * Le MCHAML ne doit avoir qu un constituant
  36. *      n3 = mchelm.infche(/2)
  37. *      do icha = 2, n1
  38. *        if (mchelm.conche(icha).ne.mchelm.conche(1)) then
  39. *          call erreur(716)
  40. *          return
  41. *        endif
  42. *      enddo
  43.  
  44. * 1 - Cas MOT : MCHAML a une composante
  45.       IF (IPLM1.EQ.-1) THEN
  46.         DO icha = 1, n1
  47.           mcham1 = mchelm.ichaml(icha)
  48.           segini,mchaml = mcham1
  49.           mchelm.ichaml(icha) = mchaml
  50.           n2 = mchaml.ielval(/1)
  51.           if (n2.ne.1) then
  52.             moterr(1: 8) = mot
  53.             moterr(9:16) = 'MCHAML  '
  54.             call erreur(784)
  55.             return
  56.           endif
  57.           mchaml.nomche(1) = mot
  58. *new-paradigm       segdes mchaml
  59.         ENDDO
  60.  
  61. * 2 - Cas Liste de composantes a renommer :
  62. *      ELSE IF (IPLM1.NE.-1) THEN
  63.       ELSE
  64. * Verification des listes des composantes si fournies
  65.         MLMOT1 = IPLM1
  66.         MLMOT2 = IPLM2
  67.         SEGACT MLMOT1,MLMOT2
  68.         JGM1 = MLMOT1.MOTS(/2)
  69.         JGM2 = MLMOT2.MOTS(/2)
  70.         IF (JGM1.NE.JGM2) THEN
  71.           CALL ERREUR(217)
  72. *new-paradigm         SEGDES MLMOT1,MLMOT2
  73.           RETURN
  74.         ENDIF
  75.  
  76.         DO icha = 1, n1
  77.           mcham1 = mchelm.ichaml(icha)
  78.           segini,mchaml = mcham1
  79.           mchelm.ichaml(icha) = mchaml
  80.           n2 = mchaml.ielval(/1)
  81.           DO k = 1, n2
  82.             CALL PLACE(MLMOT1.MOTS,JGM1,IMO,mchaml.nomche(k))
  83.             IF (IMO.NE.0) THEN
  84.               mchaml.nomche(k) = MLMOT2.MOTS(IMO)
  85.             ELSE
  86. C             Deja fait par le segini,mchaml = mcham1
  87.             ENDIF
  88.           ENDDO
  89. *new-paradigm       segdes mchaml
  90.         ENDDO
  91.       ENDIF
  92.  
  93. *new-paradigm       segdes mchelm
  94.       IPCH2 = MCHELM
  95.  
  96. c      RETURN
  97.       END
  98.  
  99.  
  100.  
  101.  

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