Télécharger nomc3.eso

Retour à la liste

Numérotation des lignes :

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

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