Télécharger nomc3.eso

Retour à la liste

Numérotation des lignes :

  1. C NOMC3 SOURCE CB215821 17/06/14 21:15:01 9457
  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 points (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.  
  55. melva1 = mcham1.ielval(1)
  56. segact melva1
  57. n1ptel = melva1.velche(/1)
  58. n1el = melva1.velche(/2)
  59. n2ptel = melva1.ielche(/1)
  60. n2el = melva1.ielche(/2)
  61. segini,melval=melva1
  62.  
  63. ielval(1) = melval
  64. segdes melva1, melval
  65. goto 900
  66.  
  67. 100 continue
  68. * cas du MCHAML a plusieurs composantes
  69. MLMOT1 = IPLM1
  70. SEGACT MLMOT1
  71. JGM1 = MLMOT1.MOTS(/2)
  72. MLMOT2 = IPLM2
  73. SEGACT MLMOT2
  74. JGM2 = MLMOT2.MOTS(/2)
  75. IF (JGM1.NE.JGM2) THEN
  76. CALL ERREUR(217)
  77. SEGDES MLMOT1,MLMOT2
  78. goto 980
  79. ENDIF
  80. segini,mchaml = mcham1
  81. ichaml(icha) = mchaml
  82. DO 130 K=1,n2
  83. CALL PLACE(MLMOT1.MOTS,JGM1,IMO,mcham1.nomche(k))
  84. IF (IMO.NE.0) THEN
  85. nomche(k) = MLMOT2.MOTS(IMO)
  86. ELSE
  87. nomche(k) = mcham1.nomche(k)
  88. ENDIF
  89. melva1 = mcham1.ielval(k)
  90. segact melva1
  91. n1ptel = melva1.velche(/1)
  92. n1el = melva1.velche(/2)
  93. n2ptel = melva1.ielche(/1)
  94. n2el = melva1.ielche(/2)
  95. segini,melval = melva1
  96.  
  97. ielval(k) = melval
  98. segdes melva1, melval
  99. 130 CONTINUE
  100.  
  101.  
  102. 900 continue
  103. segdes mchaml,mcham1
  104. 1 continue
  105.  
  106. segdes mchelm,mchel1
  107. IPCH2 = MCHELM
  108. return
  109.  
  110. 980 continue
  111. segdes mcham1
  112. do ik = 1,n1
  113. mchaml = ichaml(ik)
  114. if (mchaml.gt.-1) then
  115. segact mchaml
  116. do il = 1,ielval(/1)
  117. melval = ielval(il)
  118. if (melval.gt.-1) segdes melval
  119. enddo
  120. segdes mchaml
  121. endif
  122. enddo
  123. segsup mchelm
  124. 990 continue
  125. segdes mchel1
  126. return
  127. end
  128.  
  129.  
  130.  

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