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    OF166741  23/07/05    21:15:05     11699          
  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.  
  23. -INC SMCHAML
  24. -INC SMLMOTS
  25.  
  26.       CHARACTER*(*) MOT
  27.  
  28.       IPCH2 = 0
  29.  
  30.       mchel1 = IPCH1
  31.       SEGINI,mchelm = mchel1
  32.       n1 = mchelm.ichaml(/1)
  33.  
  34. * Le MCHAML ne doit avoir qu un constituant
  35. *      n3 = mchelm.infche(/2)
  36. *      do icha = 2, n1
  37. *        if (mchelm.conche(icha).ne.mchelm.conche(1)) then
  38. *          call erreur(716)
  39. *          return
  40. *        endif
  41. *      enddo
  42.  
  43. * 1 - Cas MOT : MCHAML a une composante
  44.       IF (IPLM1.EQ.-1) THEN
  45.         DO icha = 1, n1
  46.           mcham1 = mchelm.ichaml(icha)
  47.           segini,mchaml = mcham1
  48.           mchelm.ichaml(icha) = mchaml
  49.           n2 = mchaml.ielval(/1)
  50.           if (n2.ne.1) then
  51.             moterr(1: 8) = mot
  52.             moterr(9:16) = 'MCHAML  '
  53.             call erreur(784)
  54.             return
  55.           endif
  56.           mchaml.nomche(1) = mot
  57. *new-paradigm       segdes mchaml
  58.         ENDDO
  59.  
  60. * 2 - Cas Liste de composantes a renommer :
  61. *      ELSE IF (IPLM1.NE.-1) THEN
  62.       ELSE
  63. * Verification des listes des composantes si fournies
  64.         MLMOT1 = IPLM1
  65.         MLMOT2 = IPLM2
  66.         SEGACT MLMOT1,MLMOT2
  67.         JGM1 = MLMOT1.MOTS(/2)
  68.         JGM2 = MLMOT2.MOTS(/2)
  69.         IF (JGM1.NE.JGM2) THEN
  70.           CALL ERREUR(217)
  71. *new-paradigm         SEGDES MLMOT1,MLMOT2
  72.           RETURN
  73.         ENDIF
  74.  
  75.         DO icha = 1, n1
  76.           mcham1 = mchelm.ichaml(icha)
  77.           segini,mchaml = mcham1
  78.           mchelm.ichaml(icha) = mchaml
  79.           n2 = mchaml.ielval(/1)
  80.           DO k = 1, n2
  81.             CALL PLACE(MLMOT1.MOTS,JGM1,IMO,mchaml.nomche(k))
  82.             IF (IMO.NE.0) THEN
  83.               mchaml.nomche(k) = MLMOT2.MOTS(IMO)
  84.             ELSE
  85. C             Deja fait par le segini,mchaml = mcham1
  86.             ENDIF
  87.           ENDDO
  88. *new-paradigm       segdes mchaml
  89.         ENDDO
  90.       ENDIF
  91.  
  92. *new-paradigm       segdes mchelm
  93.       IPCH2 = MCHELM
  94.  
  95. c      RETURN
  96.       END
  97.  
  98.  
  99.  

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