Télécharger nomc2.eso

Retour à la liste

Numérotation des lignes :

  1. C NOMC2 SOURCE FANDEUR 11/07/19 21:16:49 7039
  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. *
  53. MPOVA1 = IPOVAL
  54. SEGINI,MPOVAL=MPOVA1
  55. IPOVAL = MPOVAL
  56. *
  57. SEGDES,MPOVAL,MSOUPO
  58. *
  59. 20 CONTINUE
  60. SEGDES,MCHPOI
  61. *
  62. IPCH2 = MCHPOI
  63.  
  64. 900 CONTINUE
  65. SEGDES,MLMOT1,MLMOT2
  66. *
  67. RETURN
  68. END
  69.  
  70.  
  71.  

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