Télécharger copier.eso

Retour à la liste

Numérotation des lignes :

  1. C COPIER SOURCE CB215821 19/08/20 21:16:24 10287
  2. SUBROUTINE COPIER
  3. ************************************************************************
  4. *
  5. * C O P I E R
  6. * -----------
  7. *
  8. * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "COPIER"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CREER UN 2-IEME OBJET IDENTIQUE A UN OBJET DONNE.
  14. *
  15. * PHRASE D'APPEL (EN GIBIANE):
  16. * ----------------------------
  17. *
  18. * OBJ2 = COPIER OBJ1 ;
  19. *
  20. * OPERANDE ET RESULTAT:
  21. * ---------------------
  22. *
  23. * OBJ1 TYPE-1 OBJET DONT ON VEUT UNE COPIE.
  24. * OBJ2 TYPE-1 COPIE DE "OBJ1".
  25. *
  26. * TYPE-1 VAUT 'LISTCHPO' OU 'CHPOINT' OU 'LISTREEL' OU 'MCHAML'
  27. * (A COMPLETER AU FUR ET A MESURE)
  28. *
  29. * LEXIQUE: (ORDRE ALPHABETIQUE)
  30. * --------
  31. *
  32. * MODE DE FONCTIONNEMENT:
  33. * -----------------------
  34. *
  35. * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET QUE
  36. * L'ON COPIE.
  37. *
  38. * SOUS-PROGRAMMES APPELES:
  39. * ------------------------
  40. *
  41. * ECROBJ,COPIE1,COPIE2,COPIE3,COPIE4
  42. *
  43. * AUTEUR, DATE DE CREATION:
  44. * -------------------------
  45. *
  46. * PASCAL MANIGOT 11 AVRIL 1985
  47. *
  48. * LANGAGE:
  49. * --------
  50. *
  51. * FORTRAN77 + EXTENSION
  52. *
  53. ************************************************************************
  54. *
  55. IMPLICIT INTEGER(I-N)
  56. IMPLICIT REAL*8(A-H,O-Z)
  57. -INC CCOPTIO
  58. -INC SMCHPOI
  59. -INC SMELEME
  60. -INC SMLREEL
  61. -INC SMTABLE
  62. CHARACTER*4 MOLIS(1)
  63. CHARACTER*8 MOTYPE
  64. DATA MOLIS/'GEOM'/
  65. CALL LIRMOT(MOLIS,1,IRET,0)
  66. C PP
  67. CALL LIROBJ('TABLE',IPOIN1,0,IRETOU)
  68. IF(IRETOU.EQ.0) GO TO 10
  69. MOTYPE = 'TABLE'
  70. MTAB1=IPOIN1
  71. SEGINI,MTABLE=MTAB1
  72. SEGDES,MTABLE
  73. IPOIN2=MTABLE
  74. GO TO 900
  75. 10 CONTINUE
  76. C PP
  77. CALL LIROBJ('LISTCHPO',IPOIN1,0,IRETOU)
  78. IF(IRETOU.EQ.0) GO TO 20
  79. CALL ACTOBJ('LISTCHPO',IPOIN1,1)
  80. MOTYPE = 'LISTCHPO'
  81. CALL COPIE1 (IPOIN1,IPOIN2)
  82. GO TO 900
  83. C
  84. C COPIE DE CHPOINT
  85. C
  86. 20 CONTINUE
  87. CALL LIROBJ('CHPOINT ',IPOIN1,0,IRETOU)
  88. IF(IRETOU.EQ.0) GO TO 30
  89. CALL ACTOBJ('CHPOINT ',IPOIN1,1)
  90. MOTYPE = 'CHPOINT'
  91. CALL COPIE2 (IPOIN1,IPOIN2)
  92. IF(IRET.NE.0) THEN
  93. MCHPOI=IPOIN2
  94. DO 1 I=1,IPCHP(/1)
  95. MSOUPO=IPCHP(I)
  96. IPT1=IGEOC
  97. SEGINI,MELEME=IPT1
  98. IGEOC=MELEME
  99. 1 CONTINUE
  100. ENDIF
  101. GO TO 900
  102. C
  103. C COPIE DE MCHAML
  104. C
  105. 30 CONTINUE
  106. CALL LIROBJ('MCHAML ',IPOIN1,0,IRETOU)
  107. IF(IRETOU.EQ.0) GO TO 40
  108. CALL ACTOBJ('MCHAML ',IPOIN1,1)
  109. MOTYPE = 'MCHAML'
  110. CALL COPIE8(IPOIN1,IPOIN2)
  111. GO TO 900
  112. C
  113. C COPIE DE LISTREEL
  114. C
  115. 40 CONTINUE
  116. CALL MESLIR(-148)
  117. CALL LIROBJ('LISTREEL',IPOIN1,1,IRETOU)
  118. MOTYPE = 'LISTREEL'
  119. IF(IERR.NE.0) RETURN
  120. CALL COPIE4(IPOIN1,IPOIN2)
  121. GO TO 900
  122. C
  123. 900 CONTINUE
  124. CALL ACTOBJ(MOTYPE,IPOIN2,1)
  125. CALL ECROBJ(MOTYPE,IPOIN2)
  126.  
  127. END
  128.  
  129.  
  130.  
  131.  

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