1 : C SOMM SOURCE CHAT 05/01/13 03:22:12 5004 2 : SUBROUTINE SOMM 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C======================================================================= 7 : C = = 8 : C = INTEGRATION DE L'ORDONNEE SUR LES ABSCISSES D'UN OBJET DE TYPE = 9 : C = EVOLUTION = 10 : C = = 11 : C = SYNTAXE : LREEL1 = SOMM EVOL1 (ABSO) = 12 : C = = 13 : C = L'INTEGRATION EST EFFECTUEE PAR LA METHODE DES TRAPEZES, LE = 14 : C = PAS D'INTEGRATION ETANT CALCULE A CHAQUE INSTANT = 15 : C = LE RESULTAT EST UN LISTREEL, CONTENANT LES INTEGRALES DE = 16 : C = CHACUNE DES COURBES DE L'OBJET EVOLUTION OPERANDE D'ENTREE = 17 : C = = 18 : C = SI ABSO EST PRECISE, ON INTEGRE LA VALEUR ABSOLUE DES ORDONNEES = 19 : C = = 20 : C = = 21 : C = CREATION : 24/03/87 = 22 : C = PROGRAMMATEUR : BEAUFILS = 23 : C======================================================================= 24 : C 25 : -INC CCOPTIO 26 : -INC SMEVOLL 27 : -INC SMLREEL 28 : C 29 : CHARACTER*4 ITABSO(1) 30 : DATA ITABSO/'ABSO'/ 31 : C 31 : CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET) 32 : IF(IERR.NE.0) GOTO 100 33 : C 33 : CALL LIRMOT(ITABSO,1,IABSO,0) 34 : IF(IERR.NE.0) GOTO 100 35 : C 36 : C CREATION DU LISTREEL SOLUTION 37 : C 38 : C BOUCLE SUR LES KEVOLL 39 : C 40 : MEVOLL=IPEVO 41 : SEGACT MEVOLL 42 : NEVOLL=IEVOLL(/1) 43 : JG=0 44 : SEGINI MLREEL 45 : ITRAV=MLREEL 46 : IF(NEVOLL.EQ.0) THEN 47 : MOTERR(1:8)='EVOLUTIO' 47 : CALL ERREUR(555) 48 : RETURN 49 : ENDIF 50 : DO 1 IK=1,NEVOLL 51 : KEVOLL=IEVOLL(IK) 52 : SEGACT KEVOLL 53 : IF(TYPX(1:8).NE.'LISTMOTS'.AND.TYPY(1:8).NE.'LISTMOTS') THEN 54 : JG=JG+1 55 : SEGADJ MLREEL 56 : MLREE1=IPROGX 57 : SEGACT MLREE1 58 : MLREE2=IPROGY 59 : SEGACT MLREE2 60 : L1=MLREE1.PROG(/1) 61 : IF(L1.EQ.0) THEN 62 : MOTERR(1:8)='LISTREEL' 62 : CALL ERREUR(555) 63 : RETURN 64 : ENDIF 65 : TRAV=0.D0 66 : C 67 : C EFFECTUE LE CALCUL 68 : C 69 : IF(IABSO.EQ.1) THEN 70 : DO 2 I=1,(L1-1) 71 : Y2=DABS(MLREE2.PROG(I+1)) 72 : Y1=DABS(MLREE2.PROG(I)) 73 : FORC=(Y2+Y1)/2.D0 74 : VPAS=MLREE1.PROG(I+1)-MLREE1.PROG(I) 75 : TRAV=TRAV+FORC*VPAS 76 : 2 CONTINUE 77 : ELSE 78 : DO 3 I=1,(L1-1) 79 : FORC=(MLREE2.PROG(I)+MLREE2.PROG(I+1))/2.D0 80 : VPAS=MLREE1.PROG(I+1)-MLREE1.PROG(I) 81 : TRAV=TRAV+FORC*VPAS 82 : 3 CONTINUE 83 : ENDIF 84 : C 85 : PROG(JG)=TRAV 86 : C 87 : SEGDES MLREE1,MLREE2 88 : C 89 : ENDIF 90 : C 91 : SEGDES KEVOLL 92 : C 93 : C FIN DE LA BOUCLE 94 : C 95 : 1 CONTINUE 96 : C 97 : MLREEL=ITRAV 98 : SEGDES MLREEL 99 : SEGDES MEVOLL 100 : C 100 : CALL ECROBJ('LISTREEL',ITRAV) 101 : C 102 : 100 CONTINUE 103 : C 104 : RETURN 105 : END 106 : 107 :
© Cast3M 2003 - All rights reserved.
Disclaimer