1 : C CONCAT SOURCE PV 07/11/23 21:16:01 5978 2 : SUBROUTINE CONCAT 3 : C 4 : C ================================================================== 5 : C = CONCATENATION DE 2 OBJETS EVOLUTION MEVOL1 ET MEVOL2 = 6 : C = LE RESULTAT EST RANGE DANS MEVOLL = 7 : C = = 8 : C = APPEL DU SOUS-PROGRAMME FUSPRO = 9 : C ================================================================== 10 : C 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT real*8 (a-h,o-z) 13 : -INC CCOPTIO 14 : -INC SMEVOLL 15 : -INC SMLREEL 16 : C 17 : CHARACTER*8 ITEVOL,ITCOUR 18 : DATA ITEVOL,ITCOUR/'EVOLUTIO','COURBES '/ 19 : C 19 : CALL LIROBJ('EVOLUTIO',IR1,1,IRETOU) 20 : IF(IERR.NE.0)RETURN 20 : CALL LIROBJ('EVOLUTIO',IR2,1,IRETOU) 21 : IF(IERR.NE.0)RETURN 22 : C 23 : MEVOL1=IR1 24 : MEVOL2=IR2 25 : SEGACT MEVOL1,MEVOL2 26 : N1=MEVOL1.IEVOLL(/1) 27 : N2=MEVOL2.IEVOLL(/1) 28 : C LES MEVOL DOIVENT AVOIR LE MEME NOMBRE DE COURBES 29 : IF(N1.NE.N2) THEN 30 : MOTERR(1:8)=ITEVOL(1:8) 31 : MOTERR(9:16)=ITCOUR(1:8) 31 : CALL ERREUR(403) 32 : RETURN 33 : ENDIF 34 : C 35 : N=N1 36 : SEGINI MEVOLL 37 : IRET=MEVOLL 38 : ITYEVO=MEVOL1.ITYEVO 39 : IEVTEX=TITREE 40 : C 41 : C 42 : DO 1 IC=1,N1 43 : C INITIALISATION DU MEVOL RESULTAT 44 : SEGINI KEVOLL 45 : IEVOLL(IC)=KEVOLL 46 : TYPX='LISTREEL' 47 : TYPY='LISTREEL' 48 : KEVTEX=TITREE(1:72) 49 : C 50 : KEVOL1=MEVOL1.IEVOLL(IC) 51 : KEVOL2=MEVOL2.IEVOLL(IC) 52 : SEGACT KEVOL1,KEVOL2 53 : NOMEVX=KEVOL1.NOMEVX 54 : NOMEVY=KEVOL1.NOMEVY 55 : NUMEVX=KEVOL1.NUMEVX 56 : NUMEVY=KEVOL1.NUMEVY 57 : MLREE1=KEVOL1.IPROGX 58 : MLREE2=KEVOL2.IPROGX 59 : SEGACT MLREE1,MLREE2 60 : C 61 : IL1=MLREE1 62 : IL2=MLREE2 63 : V1=MLREE1.PROG(1) 64 : V2=MLREE2.PROG(1) 65 : C ACTIVATION DE MLREE1 ET MLREE2 DANS FUSPRO 66 : SEGDES MLREE1,MLREE2 67 : IF(V2.GE.V1) THEN 67 : CALL FUSPRO(IL1,IL2,IRETOU) 68 : ELSE 68 : CALL FUSPRO(IL2,IL1,IRETOU) 69 : ENDIF 70 : IPROGX=IRETOU 71 : C 72 : C 73 : MLREE1=KEVOL1.IPROGY 74 : MLREE2=KEVOL2.IPROGY 75 : IL1=MLREE1 76 : IL2=MLREE2 77 : IF(V2.GE.V1) THEN 77 : CALL FUSPRO(IL1,IL2,IRETOU) 78 : ELSE 78 : CALL FUSPRO(IL2,IL1,IRETOU) 79 : ENDIF 80 : IPROGY=IRETOU 81 : SEGDES KEVOL1,KEVOL2 82 : C 83 : C 84 : SEGDES KEVOLL 85 : 1 CONTINUE 86 : C 87 : C 88 : SEGDES MEVOLL 89 : SEGDES MEVOL1,MEVOL2 89 : CALL ECROBJ('EVOLUTIO',IRET) 90 : RETURN 91 : END 92 : 93 :
© Cast3M 2003 - All rights reserved.
Disclaimer