Télécharger copier.eso

Retour à la liste

Numérotation des lignes :

copier
  1. C COPIER SOURCE CB215821 20/11/25 13:22:26 10792
  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.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC SMCHPOI
  61. -INC SMELEME
  62. -INC SMLREEL
  63. -INC SMTABLE
  64. CHARACTER*4 MOLIS(1)
  65. CHARACTER*8 MOTYPE
  66. DATA MOLIS/'GEOM'/
  67. CALL LIRMOT(MOLIS,1,IRET,0)
  68. C PP
  69. CALL LIROBJ('TABLE',IPOIN1,0,IRETOU)
  70. IF(IRETOU.EQ.0) GO TO 10
  71. MOTYPE = 'TABLE'
  72. MTAB1=IPOIN1
  73. SEGINI,MTABLE=MTAB1
  74. SEGDES,MTABLE
  75. IPOIN2=MTABLE
  76. GO TO 900
  77. 10 CONTINUE
  78. C PP
  79. CALL LIROBJ('LISTCHPO',IPOIN1,0,IRETOU)
  80. IF(IRETOU.EQ.0) GO TO 20
  81. CALL ACTOBJ('LISTCHPO',IPOIN1,1)
  82. MOTYPE = 'LISTCHPO'
  83. CALL COPIE1 (IPOIN1,IPOIN2)
  84. GO TO 900
  85. C
  86. C COPIE DE CHPOINT
  87. C
  88. 20 CONTINUE
  89. CALL LIROBJ('CHPOINT ',IPOIN1,0,IRETOU)
  90. IF(IRETOU.EQ.0) GO TO 30
  91. CALL ACTOBJ('CHPOINT ',IPOIN1,1)
  92. MOTYPE = 'CHPOINT'
  93. CALL COPIE2 (IPOIN1,IPOIN2)
  94. IF(IRET.NE.0) THEN
  95. MCHPOI=IPOIN2
  96. DO 1 I=1,IPCHP(/1)
  97. MSOUPO=IPCHP(I)
  98. IPT1=IGEOC
  99. SEGINI,MELEME=IPT1
  100. IGEOC=MELEME
  101. 1 CONTINUE
  102. ENDIF
  103. GO TO 900
  104. C
  105. C COPIE DE MCHAML
  106. C
  107. 30 CONTINUE
  108. CALL LIROBJ('MCHAML ',IPOIN1,0,IRETOU)
  109. IF(IRETOU.EQ.0) GO TO 40
  110. CALL ACTOBJ('MCHAML ',IPOIN1,1)
  111. MOTYPE = 'MCHAML'
  112. CALL COPIE8(IPOIN1,IPOIN2)
  113. GO TO 900
  114. C
  115. C COPIE DE LISTREEL
  116. C
  117. 40 CONTINUE
  118. CALL MESLIR(-148)
  119. CALL LIROBJ('LISTREEL',IPOIN1,1,IRETOU)
  120. MOTYPE = 'LISTREEL'
  121. IF(IERR.NE.0) RETURN
  122. CALL COPIE4(IPOIN1,IPOIN2)
  123. GO TO 900
  124. C
  125. 900 CONTINUE
  126. CALL ACTOBJ(MOTYPE,IPOIN2,1)
  127. CALL ECROBJ(MOTYPE,IPOIN2)
  128.  
  129. END
  130.  
  131.  
  132.  
  133.  
  134.  

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