Télécharger nomc2.eso

Retour à la liste

Numérotation des lignes :

  1. C NOMC2 SOURCE CB215821 17/12/01 21:15:11 9643
  2.  
  3. *-----------------------------------------------------------------------
  4. *
  5. * Renommer certaines composantes d'un CHPOINT
  6. *
  7. * IPCH1 (e) pointeur sur un champ par points (type CHPOINT)
  8. * IPLM1 (e) liste des composantes a remplacer (type LISTMOTS)
  9. * IPLM2 (e) liste des nouvelles composantes (type LISTMOTS)
  10. * IPCH2 (s) objet resultat (type CHPOINT)
  11. *
  12. * D. R.-M. le 4/2/94
  13. *-----------------------------------------------------------------------
  14. *
  15. SUBROUTINE NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)
  16.  
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19.  
  20. -INC CCOPTIO
  21. -INC SMCHPOI
  22. -INC SMLMOTS
  23.  
  24. IPCH2 = 0
  25. *
  26. MLMOT1 = IPLM1
  27. MLMOT2 = IPLM2
  28. SEGACT,MLMOT1,MLMOT2
  29. JGM1 = MLMOT1.MOTS(/2)
  30. JGM2 = MLMOT2.MOTS(/2)
  31. IF (JGM1.NE.JGM2) THEN
  32. CALL ERREUR(217)
  33. GOTO 900
  34. ENDIF
  35.  
  36. MCHPO1 = IPCH1
  37. SEGINI,MCHPOI=MCHPO1
  38. *
  39. NSOUPO = IPCHP(/1)
  40. DO 20 J=1,NSOUPO
  41. MSOUP1 = IPCHP(J)
  42. SEGINI,MSOUPO=MSOUP1
  43. IPCHP(J) = MSOUPO
  44. *
  45. NC = NOCOMP(/2)
  46. DO 30 K=1,NC
  47. CALL PLACE(MLMOT1.MOTS,JGM1,IMO,NOCOMP(K))
  48. IF (IMO.NE.0) THEN
  49. NOCOMP(K) = MLMOT2.MOTS(IMO)
  50. ENDIF
  51. 30 CONTINUE
  52. SEGDES,MSOUPO
  53. 20 CONTINUE
  54. SEGDES,MCHPOI
  55. *
  56. IPCH2 = MCHPOI
  57.  
  58. 900 CONTINUE
  59. SEGDES,MLMOT1,MLMOT2
  60. *
  61. RETURN
  62. END
  63.  
  64.  
  65.  

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