1 : C MUFLEV SOURCE CHAT 05/01/13 01:55:03 5004 2 : SUBROUTINE MUFLEV(IPO1,XFLOT,IRET,IEPS) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : CHARACTER *72 TI 6 : C===================================================================== 7 : C 8 : C MULTIPLIE UN OBJET EVOLUTIO PAR XFLO 9 : C L'OBJET EVOLUTIO RESULTANT VOIT SON POINTEUR STOCKE DANS IRET 10 : C ENTREES 11 : C IPO1=POINTEUR SUR L'OBJET EVOLUTIO 12 : C XFLOT=SCALAIRE 13 : C IEPS = 1 MULTIPLICATION = -1 DIVISION 14 : C SORTIES 15 : C IRET=POINTEUR SUR L'OBJET EVOL*XFLOT 16 : C 17 : C 18 : C CREATION : 10/04/87 19 : C PROGRAMMEUR : BEAUFILS 20 : C===================================================================== 21 : -INC SMEVOLL 22 : -INC SMLREEL 23 : C 24 : IF(IEPS.EQ.-1)THEN 25 : XFLOT = 1.D0/XFLOT 26 : ENDIF 27 : C 28 : MEVOL1=IPO1 29 : SEGACT MEVOL1 30 : TI=MEVOL1.IEVTEX 31 : NCOU=MEVOL1.IEVOLL(/1) 32 : N=NCOU 33 : SEGINI MEVOLL 34 : IRET=MEVOLL 35 : IEVTEX=TI 36 : ITYEVO=MEVOL1.ITYEVO 37 : C 38 : DO 100 NC=1,NCOU 39 : KEVOL1=MEVOL1.IEVOLL(NC) 40 : SEGACT KEVOL1 41 : MLREE1=KEVOL1.IPROGY 42 : C 43 : IF(KEVOL1.TYPY.EQ.'LISTMOTS') THEN 44 : SEGINI,KEVOLL=KEVOL1 45 : IEVOLL(NC)=KEVOLL 46 : SEGDES KEVOLL 47 : ELSE 48 : SEGACT MLREE1 49 : NBPT=MLREE1.PROG(/1) 50 : SEGINI KEVOLL 51 : KEVTEX=TI 52 : IEVOLL(NC)=KEVOLL 53 : TYPX='LISTREEL' 54 : TYPY='LISTREEL' 55 : JG=NBPT 56 : SEGINI MLREEL 57 : IPROGX=KEVOL1.IPROGX 58 : NOMEVX=KEVOL1.NOMEVX 59 : IPROGY=MLREEL 60 : NOMEVY=KEVOL1.NOMEVY 61 : NUMEVX=KEVOL1.NUMEVX 62 : NUMEVY=KEVOL1.NUMEVY 63 : C 64 : DO 1 II=1,NBPT 65 : PROG(II)=XFLOT*MLREE1.PROG(II) 66 : 1 CONTINUE 67 : C 68 : SEGDES MLREE1 69 : SEGDES KEVOLL,MLREEL 70 : ENDIF 71 : SEGDES KEVOL1 72 : C 73 : 100 CONTINUE 74 : C 75 : SEGDES MEVOL1 76 : SEGDES MEVOLL 77 : C 78 : RETURN 79 : END 80 : 81 :
© Cast3M 2003 - All rights reserved.
Disclaimer