1 : C TOTEMP SOURCE PV 11/03/07 21:18:36 6885 2 : SUBROUTINE TOTEMP 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C======================================================================= 7 : C = CALCUL DU TEMPS TOTAL OU LES ORDONNEES D'UNE COURBE SONT = 8 : C = SUPERIEURES A UN SEUIL DONNE; LE SEUIL EST DEFINI PAR UN % DU = 9 : C = NIVEAU MAXIMA DES CHOC. = 10 : C = LA COURBE EST DANS UN OBJET DE TYPE EVOLUTIO; CET OBJET PEUT = 11 : C = AVOIR PLUSIEURS EVOLUTIO ELEMENTAIRES = 12 : C = = 13 : C = = 14 : C = SYNTAXE : TEMP = TOTE EVOL DECL ; = 15 : C = = 16 : C = LES ABSCISSES SONT CLASSEES DANS UN ORDRE STRICTEMENT CROISSANT = 17 : C = LE RESULTAT EST UN FLOTTANT. = 18 : C = = 19 : C = = 20 : C = TEMP : OBJET DE TYPE LISTREEL RESULTAT = 21 : C = EVOL : OBJET DE TYPE EVOLUTIO CONTENANT LES ENREGISTREMENTS= 22 : C = DECL : OBJET DE TYPE FLOTTANT % DU NIVEAU MAXIMA = 23 : C======================================================================= 24 : C 25 : -INC CCOPTIO 26 : -INC SMEVOLL 27 : -INC SMLREEL 28 : C 29 : REAL*8 NIVMAX 30 : C 30 : CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET) 31 : IF(IERR.NE.0) GOTO 100 32 : C 32 : CALL LIRREE(DECLE,0,IDECL) 33 : IF(IERR.NE.0) GOTO 100 34 : IF((DECLE.LT.0.D0).OR.(DECLE.GT.100.D0))THEN 35 : MOTERR(1:8)='DECLENCH' 36 : REAERR(1)=DECLE 37 : REAERR(2)=0.D0 38 : REAERR(3)=100.D0 38 : CALL ERREUR(42) 39 : GOTO 100 40 : ENDIF 41 : C 42 : MEVOLL=IPEVO 43 : SEGACT MEVOLL 44 : NC=IEVOLL(/1) 45 : JG = NC 46 : SEGINI MLREEL 47 : IPORE=MLREEL 48 : C 49 : C BOUCLE SUR LES COURBES 50 : C 51 : DO 1 IC=1,NC 52 : KEVOLL=IEVOLL(IC) 53 : SEGACT KEVOLL 54 : MLREE1=IPROGX 55 : SEGACT MLREE1 56 : MLREE2=IPROGY 57 : SEGACT MLREE2 58 : L1=MLREE1.PROG(/1) 59 : TEMP=0.D0 60 : NP=0 61 : NIVMAX=0.D0 62 : C 63 : C CALCUL LE SEUIL DE DECLENCHEMENT 64 : C 65 : DO 10 I=1,L1 66 : FORC=MLREE2.PROG(I) 67 : IF(ABS(FORC).GT.NIVMAX) NIVMAX=ABS(FORC) 68 : 10 CONTINUE 69 : SEUIL=NIVMAX*DECLE/100.D0 70 : IF(IDECL.EQ.0) SEUIL=1.D-10 71 : IF(IIMPI.EQ.1) WRITE(IOIMP,1000)SEUIL 72 : 1000 FORMAT(' SEUIL D''ACQUISITION : ',1PE12.5) 73 : C 74 : C ELIMINE LE CHOC A CHEVAL SUR LE DEBUT DE L'ENREGISTREMENT 75 : C 76 : MIN=1 77 : MAX=L1 78 : FORC=MLREE2.PROG(1) 79 : IF(ABS(FORC).GT.1.D-20) THEN 80 : IF(IIMPI.EQ.1) WRITE(IOIMP,1001) 81 : 1001 FORMAT(' CHOC A CHEVAL DEBUT BLOC') 82 : DO 11 I=2,L1 83 : FORC=MLREE2.PROG(I) 84 : IF(ABS(FORC).LE.1.D-20) THEN 85 : MIN=I 86 : GOTO 12 87 : ENDIF 88 : 11 CONTINUE 89 : C 90 : C MAIS GARDE UN SIGNAL JAMAIS NUL 91 : C 92 : TEMP=MLREE1.PROG(L1)-MLREE1.PROG(1) 93 : GOTO 21 94 : ENDIF 95 : 12 CONTINUE 96 : C 97 : C ELIMINE LE CHOC A CHEVAL SUR LA FIN DE L'ENREGISTREMENT 98 : C 99 : FORC=MLREE2.PROG(L1) 100 : IF(ABS(FORC).GT.1.D-20) THEN 101 : IF(IIMPI.EQ.1) WRITE(IOIMP,1002) 102 : 1002 FORMAT(' CHOC A CHEVAL SUR FIN BLOC') 103 : DO 13 I=1,L1 104 : FORC=MLREE2.PROG(L1-I) 105 : IF(ABS(FORC).LE.1.D-20) THEN 106 : MAX=L1-I 107 : GOTO 14 108 : ENDIF 109 : 13 CONTINUE 110 : ENDIF 111 : 14 CONTINUE 112 : C 113 : C CALCUL LA DUREE OU LE SIGNAL EST SUPERIEUR AU SEUIL 114 : C 115 : DO 20 I=MIN,MAX 116 : FORC=MLREE2.PROG(I) 117 : IF(ABS(FORC).GT.SEUIL) THEN 118 : IF(IIMPI.EQ.1) WRITE(IOIMP,1003) FORC,I 119 : 1003 FORMAT(' VALEUR = ',1PE12.5,' > SEUIL AU PT ',I5) 120 : NP=1 121 : PAS=MLREE1.PROG(I)-MLREE1.PROG(I-1) 122 : TEMP=TEMP+PAS 123 : ELSE IF(NP.EQ.1) THEN 124 : PAS=MLREE1.PROG(I)-MLREE1.PROG(I-1) 125 : TEMP=TEMP+PAS 126 : NP=0 127 : ENDIF 128 : C 129 : 20 CONTINUE 130 : 21 CONTINUE 131 : C 132 : C DESACTIVE TOUT 133 : C 134 : SEGDES MLREE1,MLREE2 135 : SEGDES KEVOLL 136 : C 137 : MLREEL=IPORE 138 : PROG(IC)=TEMP 139 : C 140 : 1 CONTINUE 141 : SEGDES MEVOLL 142 : SEGDES MLREEL 143 : C 143 : CALL ECROBJ('LISTREEL',IPORE) 144 : C 145 : 100 CONTINUE 146 : RETURN 147 : END 148 : 149 :
© Cast3M 2003 - All rights reserved.
Disclaimer