Télécharger copier.eso

Retour à la liste

Numérotation des lignes :

  1. C COPIER SOURCE FANDEUR 10/12/14 21:15:36 6812
  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. MOTYPE = 'LISTCHPO'
  80. CALL COPIE1 (IPOIN1,IPOIN2)
  81. GO TO 900
  82. C
  83. C COPIE DE CHPOINT
  84. C
  85. 20 CONTINUE
  86. CALL LIROBJ('CHPOINT',IPOIN1,0,IRETOU)
  87. IF(IRETOU.EQ.0) GO TO 30
  88. MOTYPE = 'CHPOINT'
  89. CALL COPIE2 (IPOIN1,IPOIN2)
  90. IF(IRET.NE.0) THEN
  91. MCHPOI=IPOIN2
  92. SEGACT MCHPOI
  93. DO 1 I=1,IPCHP(/1)
  94. MSOUPO=IPCHP(I)
  95. SEGACT MSOUPO*MOD
  96. IPT1=IGEOC
  97. SEGINI,MELEME=IPT1
  98. SEGDES MELEME
  99. IGEOC=MELEME
  100. SEGDES MSOUPO
  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. MOTYPE = 'MCHAML'
  111. CALL COPIE8(IPOIN1,IPOIN2)
  112. GO TO 900
  113. C
  114. C COPIE DE LISTREEL
  115. C
  116. 40 CONTINUE
  117. CALL MESLIR(-148)
  118. CALL LIROBJ('LISTREEL',IPOIN1,1,IRETOU)
  119. MOTYPE = 'LISTREEL'
  120. IF(IERR.NE.0) RETURN
  121. CALL COPIE4(IPOIN1,IPOIN2)
  122. GO TO 900
  123. C
  124. 900 CONTINUE
  125. CALL ECROBJ (MOTYPE,IPOIN2)
  126.  
  127. RETURN
  128. END
  129.  
  130.  
  131.  

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