C COPIER SOURCE CB215821 20/11/25 13:22:26 10792 SUBROUTINE COPIER ************************************************************************ * * C O P I E R * ----------- * * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "COPIER" * * FONCTION: * --------- * * CREER UN 2-IEME OBJET IDENTIQUE A UN OBJET DONNE. * * PHRASE D'APPEL (EN GIBIANE): * ---------------------------- * * OBJ2 = COPIER OBJ1 ; * * OPERANDE ET RESULTAT: * --------------------- * * OBJ1 TYPE-1 OBJET DONT ON VEUT UNE COPIE. * OBJ2 TYPE-1 COPIE DE "OBJ1". * * TYPE-1 VAUT 'LISTCHPO' OU 'CHPOINT' OU 'LISTREEL' OU 'MCHAML' * (A COMPLETER AU FUR ET A MESURE) * * LEXIQUE: (ORDRE ALPHABETIQUE) * -------- * * MODE DE FONCTIONNEMENT: * ----------------------- * * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET QUE * L'ON COPIE. * * SOUS-PROGRAMMES APPELES: * ------------------------ * * ECROBJ,COPIE1,COPIE2,COPIE3,COPIE4 * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 11 AVRIL 1985 * * LANGAGE: * -------- * * FORTRAN77 + EXTENSION * ************************************************************************ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMELEME -INC SMLREEL -INC SMTABLE CHARACTER*4 MOLIS(1) CHARACTER*8 MOTYPE DATA MOLIS/'GEOM'/ CALL LIRMOT(MOLIS,1,IRET,0) C PP CALL LIROBJ('TABLE',IPOIN1,0,IRETOU) IF(IRETOU.EQ.0) GO TO 10 MOTYPE = 'TABLE' MTAB1=IPOIN1 SEGINI,MTABLE=MTAB1 SEGDES,MTABLE IPOIN2=MTABLE GO TO 900 10 CONTINUE C PP CALL LIROBJ('LISTCHPO',IPOIN1,0,IRETOU) IF(IRETOU.EQ.0) GO TO 20 CALL ACTOBJ('LISTCHPO',IPOIN1,1) MOTYPE = 'LISTCHPO' CALL COPIE1 (IPOIN1,IPOIN2) GO TO 900 C C COPIE DE CHPOINT C 20 CONTINUE CALL LIROBJ('CHPOINT ',IPOIN1,0,IRETOU) IF(IRETOU.EQ.0) GO TO 30 CALL ACTOBJ('CHPOINT ',IPOIN1,1) MOTYPE = 'CHPOINT' CALL COPIE2 (IPOIN1,IPOIN2) IF(IRET.NE.0) THEN MCHPOI=IPOIN2 DO 1 I=1,IPCHP(/1) MSOUPO=IPCHP(I) IPT1=IGEOC SEGINI,MELEME=IPT1 IGEOC=MELEME 1 CONTINUE ENDIF GO TO 900 C C COPIE DE MCHAML C 30 CONTINUE CALL LIROBJ('MCHAML ',IPOIN1,0,IRETOU) IF(IRETOU.EQ.0) GO TO 40 CALL ACTOBJ('MCHAML ',IPOIN1,1) MOTYPE = 'MCHAML' CALL COPIE8(IPOIN1,IPOIN2) GO TO 900 C C COPIE DE LISTREEL C 40 CONTINUE CALL MESLIR(-148) CALL LIROBJ('LISTREEL',IPOIN1,1,IRETOU) MOTYPE = 'LISTREEL' IF(IERR.NE.0) RETURN CALL COPIE4(IPOIN1,IPOIN2) GO TO 900 C 900 CONTINUE CALL ACTOBJ(MOTYPE,IPOIN2,1) CALL ECROBJ(MOTYPE,IPOIN2) END