Télécharger la plaquette Cast3M


fr en

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