1 : C COMCHO SOURCE CHAT 05/01/12 22:14:23 5004 2 : SUBROUTINE COMCHO 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C======================================================================= 7 : C = CALCUL DU NOMBRE DE CHOCS DANS CHAQUE COURBE D'UN OBJET DE TYPE = 8 : C = EVOLUTION. LE RESULTAT EST UNE LISTENTI. = 9 : C = = 10 : C = SYNTAXE : NCHO = COMT EVOL DECL ; = 11 : C = = 12 : C = = 13 : C = NCHO : OBJET DE TYPE LISTENTI RESULTAT = 14 : C = EVOL : OBJET DE TYPE EVOLUTIO CONTENANT LES SIGNAUX A TRAITER = 15 : C = DECL : OBJET DE TYPE FLOTTANT % NIVEAU MAXI DES CHOCS = 16 : C = DEFINISSANT LE SEUIL D'ACQUISITION = 17 : C======================================================================= 18 : C 19 : -INC CCOPTIO 20 : -INC SMEVOLL 21 : -INC SMLREEL 22 : -INC SMLENTI 23 : C 24 : C 24 : CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET) 25 : IF(IERR.NE.0) GOTO 100 26 : C 26 : CALL LIRREE(DECLEN,0,IDECL) 27 : IF(IERR.NE.0) GOTO 100 28 : IF((DECLEN.LT.0.D0).OR.(DECLEN.GT.100.D0))THEN 29 : MOTERR(1:8)='DECLENCH' 30 : REAERR(1)=DECLEN 31 : REAERR(2)=0.D0 32 : REAERR(3)=100.D0 32 : CALL ERREUR(42) 33 : GOTO 100 34 : ENDIF 35 : C 36 : MEVOLL=IPEVO 37 : SEGACT MEVOLL 38 : C 39 : C BOUCLE SUR LES COURBES 40 : C 41 : NC=IEVOLL(/1) 42 : JG=NC 43 : SEGINI MLENTI 44 : IPORE=MLENTI 45 : DO 1 IC=1,NC 46 : KEVOLL=IEVOLL(IC) 47 : SEGACT KEVOLL 48 : MLREE1=IPROGX 49 : SEGACT MLREE1 50 : MLREE2=IPROGY 51 : SEGACT MLREE2 52 : L1=MLREE1.PROG(/1) 53 : NCHO=0 54 : NP=0 55 : VMAX=0.D0 56 : MIN=1 57 : MAX=L1 58 : C 59 : C CALCUL LE NIVEAU DE DECLENCHEMENT 60 : C 61 : DO 21 I=1,L1 62 : FORC=ABS(MLREE2.PROG(I)) 63 : IF(FORC.GT.VMAX)VMAX=FORC 64 : 21 CONTINUE 65 : SEUIL=VMAX*DECLEN/100.D0 66 : IF(IDECL.EQ.0)SEUIL=1.D-10 67 : IF(IIMPI.EQ.1)WRITE(IOIMP,1000)SEUIL 68 : 1000 FORMAT(' SEUIL D''ACQUISITION : ',1PE12.5) 69 : C 70 : C ELIMINE LE CHOC A CHEVAL SUR LE DEBUT DE L'ENREGISTREMENT 71 : C 72 : FORC=MLREE2.PROG(1) 73 : IF(ABS(FORC).GT.1.D-20) THEN 74 : IF(IIMPI.EQ.1)WRITE(IOIMP,1001) 75 : 1001 FORMAT(' CHOC A CHEVAL DEBUT DE BLOC ') 76 : DO 11 I=2,L1 77 : FORC=MLREE2.PROG(I) 78 : IF(ABS(FORC).LE.1.D-20) THEN 79 : MIN=I 80 : GOTO 12 81 : ENDIF 82 : 11 CONTINUE 83 : ENDIF 84 : 12 CONTINUE 85 : C 86 : C ELIMINE LE CHOC A CHEVAL SUR LA FIN DE L'ENREGISTREMENT 87 : C 88 : FORC=MLREE2.PROG(L1) 89 : IF(ABS(FORC).GT.1.D-20) THEN 90 : IF(IIMPI.EQ.1)WRITE(IOIMP,1002) 91 : 1002 FORMAT(' CHOC A CHEVAL FIN DE BLOC ') 92 : DO 13 I=1,L1 93 : FORC=MLREE2.PROG(L1-I) 94 : IF(ABS(FORC).LE.1.D-20) THEN 95 : MAX=L1-I 96 : GOTO 14 97 : ENDIF 98 : 13 CONTINUE 99 : ENDIF 100 : 14 CONTINUE 101 : C 102 : C COMPTE LE NOMBRE DE CHOCS 103 : C 104 : DO 20 I=MIN,MAX 105 : FORC=ABS(MLREE2.PROG(I)) 106 : IF(FORC.GT.SEUIL) THEN 107 : IF(IIMPI.EQ.1)WRITE(IOIMP,1003)FORC,I 108 : 1003 FORMAT(' VALEUR = ',1PE12.5,' > SEUIL AU PT ',I5) 109 : IF(NP.EQ.0) NCHO=NCHO+1 110 : NP=1 111 : ELSE 112 : NP=0 113 : ENDIF 114 : 20 CONTINUE 115 : C 116 : C DESACTIVE TOUT 117 : C 118 : SEGDES MLREE1,MLREE2 119 : SEGDES KEVOLL 120 : C 121 : LECT(IC)=NCHO 122 : C 123 : 1 CONTINUE 124 : SEGDES MEVOLL 125 : SEGDES MLENTI 126 : C 126 : CALL ECROBJ('LISTENTI',IPORE) 127 : C 128 : 100 CONTINUE 129 : RETURN 130 : END 131 :
© Cast3M 2003 - All rights reserved.
Disclaimer