Télécharger nomc3.eso

Retour à la liste

Numérotation des lignes :

  1. C NOMC3 SOURCE PV 11/03/08 21:15:44 6888
  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) segsup melval
  119. enddo
  120. segsup mchaml
  121. endif
  122. enddo
  123. segsup mchelm
  124. 990 continue
  125. segdes mchel1
  126. return
  127. end
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  

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