1 : C CHOMOY SOURCE CHAT 05/01/12 22:01:28 5004 2 : SUBROUTINE CHOMOY 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : CHARACTER *72 TI 6 : CHARACTER *8 IACQ,IDCL,ITMOT 7 : CHARACTER *4 MOLU,ICHO 8 : C 9 : C======================================================================= 10 : C = CALCUL D'UN CHOC MOYEN A PARTIR D'UNE COURBE CONTENANT N CHOCS = 11 : C = = 12 : C = SYNTAXE : EVO2 = CMOY EVO1 (NCHO) (DECL V1) ACQU V2 ; = 13 : C = = 14 : C = IL PEUT Y AVOIR PLUSIEURS COURBES A TRAITER DANS EVO1; A CHACUNE = 15 : C = D'ELLES CORRESPOND UNE COURBE CHOC MOYEN DANS EVO2. = 16 : C = NCHO EST L'ENTIER NOMBRE DE CHOCS A MOYENNER = 17 : C = V1 EST LE SEUIL (EN % DE LA VALEUR MAXIE) DE DECLENCHEMENT = 18 : C = DE L'ACQUISITION D'UN IMPACT DANS EVO1; (OBJET DE TYPE FLOTTANT )= 19 : C = V2 EST LE TEMPS D'ACQUISITION DU CHOC A CHAQUE DECLENCHEMENT = 20 : C = (OBJET DE TYPE FLOTTANT) = 21 : C = = 22 : C = = 23 : C======================================================================= 24 : C 25 : -INC CCOPTIO 26 : -INC SMEVOLL 27 : -INC SMLREEL 28 : C 29 : DATA IDCL,IACQ,ITMOT/'DECLENCH','ACQUISIT','MOT '/ 30 : DATA ICHO/'NCHO'/ 31 : C 31 : CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET) 32 : IF(IERR.NE.0) GOTO 100 33 : C 34 : C LECTURE D'UN MOT-CLE ET DE SA DONNEE CORRESPONDANTE 35 : C 36 : DECLEN=0.D0 37 : ACQUI=0.D0 38 : DO 1 J=1,3 39 : MOLU=' ' 39 : CALL LIRCHA(MOLU,0,IRETOU) 40 : IF(IIMPI.EQ.1)WRITE(IOIMP,9999)MOLU 41 : 9999 FORMAT(' MOT LU :',A4) 42 : IF(IERR.NE.0) GOTO 100 43 : IF((IRETOU.EQ.0).AND.(ACQUI.EQ.0.D0)) THEN 44 : C *** LE TEMPS D'ACQUISITION EST OBLIGATOIRE 45 : MOTERR(1:4)=IACQ(1:4) 45 : CALL ERREUR(396) 46 : GOTO 100 47 : ELSEIF(IRETOU.EQ.0) THEN 48 : GOTO 1 49 : ENDIF 50 : C 51 : IF(MOLU.EQ.IACQ(:4)) THEN 52 : C ENTREE DU TEMPS D'ACQUISITION (OBLIGATOIRE) 52 : CALL LIRREE(ACQUI,0,IRET) 53 : IF(IERR.NE.0) GOTO 100 54 : IF(IRET.EQ.0) THEN 55 : MOTERR(1:4)=IACQ(1:4) 55 : CALL ERREUR(166) 56 : GOTO 100 57 : ENDIF 58 : IF(ACQUI.LE.0.D0)THEN 59 : C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE 60 : MOTERR(1:8)=IACQ(1:8) 61 : REAERR(1)=ACQUI 62 : REAERR(2)=0.D0 62 : CALL ERREUR(41) 63 : GOTO 100 64 : ENDIF 65 : ENDIF 66 : C 67 : IF(MOLU.EQ.IDCL(:4)) THEN 68 : C ENTREE DU NIVEAU DE DECLENCHEMENT (FACULTATIF) 68 : CALL LIRREE(DECLEN,0,IDECL) 69 : IF(IERR.NE.0) GOTO 100 70 : IF((DECLEN.LT.0.D0).OR.(DECLEN.GT.100.D0)) THEN 71 : C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE 72 : MOTERR(1:8)=IDCL(1:8) 73 : REAERR(1)=DECLEN 74 : REAERR(2)=0.D0 75 : REAERR(3)=100.D0 75 : CALL ERREUR(42) 76 : GOTO 100 77 : ENDIF 78 : ENDIF 79 : C 80 : NCHO=0 81 : IF(MOLU.EQ.ICHO) THEN 82 : C ENTREE DU NOMBRE DE CHOCS A TRAITER (FACULTATIF) 82 : CALL LIRENT(NCHO,0,IRET) 83 : IF(IERR.NE.0) GOTO 100 84 : IF(IRET.EQ.0) THEN 85 : MOTERR(1:4)=ICHO(1:4) 85 : CALL ERREUR(166) 86 : GOTO 100 87 : ENDIF 88 : IF(NCHO.LT.0) THEN 89 : C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE 90 : INTERR(1)=0 91 : INTERR(2)=NCHO 91 : CALL ERREUR(190) 92 : ENDIF 93 : ENDIF 94 : C 95 : 1 CONTINUE 96 : C 97 : C 98 : MEVOL1=IPEVO 99 : SEGACT MEVOL1 100 : NC=MEVOL1.IEVOLL(/1) 101 : N=NC 102 : SEGINI MEVOLL 103 : ISOLU=MEVOLL 104 : TI(1:72)=TITREE 105 : IEVTEX=TI 106 : ITYEVO=MEVOL1.ITYEVO 107 : C 108 : C BOUCLE SUR LES COURBES 109 : C 110 : DO 10 IC=1,NC 111 : KEVOL1=MEVOL1.IEVOLL(IC) 112 : SEGACT KEVOL1 113 : MLREE1=KEVOL1.IPROGX 114 : SEGACT MLREE1 115 : MLREE2=KEVOL1.IPROGY 116 : SEGACT MLREE2 117 : L1=MLREE1.PROG(/1) 118 : DL=MLREE1.PROG(2)-MLREE1.PROG(1) 119 : C 120 : SEGINI KEVOLL 121 : IEVOLL(IC)=KEVOLL 122 : NOMEVX=KEVOL1.NOMEVX 123 : NOMEVY=KEVOL1.NOMEVY 124 : NUMEVX=KEVOL1.NUMEVX 125 : NUMEVY=KEVOL1.NUMEVY 126 : TYPX=KEVOL1.TYPX 127 : TYPY=KEVOL1.TYPY 128 : KEVTEX=TI 129 : JG=0 130 : SEGINI MLREEL 131 : IPROGY=MLREEL 132 : SEGINI MLREE3 133 : IPROGX=MLREE3 134 : C 135 : VMAX=0.D0 136 : MCHO=0 137 : C 138 : C CHERCHE LE NIVEAU DE DECLENCHEMENT 139 : C 140 : DO 20 I=1,L1 141 : FORC=ABS(MLREE2.PROG(I)) 142 : IF(FORC.GT.VMAX)VMAX=FORC 143 : 20 CONTINUE 144 : SEUIL=DECLEN*VMAX/100.D0 145 : IF(IDECL.EQ.0) SEUIL=1.D-10 146 : IF(IIMPI.EQ.1) THEN 147 : WRITE(IOIMP,1000)SEUIL 148 : WRITE(IOIMP,1006)ACQUI 149 : 1000 FORMAT(' NIVEAU DE DECLENCHEMENT = ',1PE12.5) 150 : 1006 FORMAT(' TEMPS D''ACQUISITION = ',1PE12.5) 151 : ENDIF 152 : C 153 : C CHERCHE LE NOMBRE DE PAS D'ACQUISITION 154 : C 155 : NACQ=INT(ACQUI/DL) 156 : NRECU=INT(DBLE(NACQ)*0.201D0) 157 : NAVAN=NACQ-NRECU 158 : IF(IIMPI.EQ.1)THEN 159 : WRITE(IOIMP,1001)NACQ 160 : WRITE(IOIMP,1002)NRECU 161 : WRITE(IOIMP,1003)NAVAN 162 : WRITE(IOIMP,1009)L1 163 : 1001 FORMAT(' NOMBRE DE PAS D''ACQUISITION = ',I4) 164 : 1002 FORMAT(' NOMBRE DE PAS DE RECUL = ',I4) 165 : 1003 FORMAT(' NOMBRE DE PAS D''AVANCE = ',I4) 166 : 1009 FORMAT(' NOMBRE DE PTS A TRAITER = ',I4) 167 : ENDIF 168 : C 169 : C ACCUMULE LES CHOCS 170 : C 171 : IJ=0 172 : DO 21 I=1,L1 173 : IJ=IJ+1 174 : FORC=ABS(MLREE2.PROG(IJ)) 175 : IF(FORC.GT.SEUIL) THEN 176 : ID=IJ-NRECU 177 : C 178 : C ON OUBLIE LE PREMIER CHOC SI IL EST A CHEVAL SUR LE DEBUT DE LA 179 : C PROGRESSION 180 : IF(ID.LE.0)THEN 181 : IF(IIMPI.EQ.1)WRITE(IOIMP,1007) 182 : 1007 FORMAT(' CHOC A CHEVAL SUR DEBUT BLOC : NEGLIGE ') 183 : DO 211 II=(IJ+1),L1 184 : FORC=ABS(MLREE2.PROG(II)) 185 : IF(FORC.LE.1.D-10) THEN 186 : IJ=II 187 : GOTO 24 188 : ENDIF 189 : 211 CONTINUE 190 : ENDIF 191 : C 192 : C ON OUBLIE LE DERNIER CHOC SI IL EST A CHEVAL SUR LA FIN DE LA 193 : C PROGRESSION 194 : IF((ID+NACQ).GT.L1) THEN 195 : IF(IIMPI.EQ.1)WRITE(IOIMP,1008) 196 : 1008 FORMAT(' CHOC A CHEVAL SUR FIN BLOC : NEGLIGE ') 197 : GOTO 11 198 : ENDIF 199 : C 200 : C 201 : IF(IIMPI.EQ.1)WRITE(IOIMP,1004)IJ,MLREE2.PROG(IJ) 202 : 1004 FORMAT(' DEBUT DE CHOC AU PT ',I4,' AMPLITUDE A CE PAS = ', 203 : & 1PE12.5) 204 : MCHO=MCHO+1 205 : IF(IIMPI.EQ.1)WRITE(IOIMP,1005)MCHO 206 : 1005 FORMAT(' CHOC NUMERO ',I3) 207 : IF(MCHO.EQ.1) THEN 208 : JG=1+NACQ 209 : SEGADJ MLREEL 210 : DO 22 JJ=ID,(ID+NACQ) 211 : FORC=ABS(MLREE2.PROG(JJ)) 212 : PROG(1+JJ-ID)=FORC 213 : 22 CONTINUE 214 : ELSE 215 : IND=0 216 : DO 23 JJ=ID,(ID+NACQ) 217 : IND=IND+1 218 : FORC=ABS(MLREE2.PROG(JJ)) 219 : PROG(IND)=PROG(IND)+FORC 220 : 23 CONTINUE 221 : ENDIF 222 : IF(MCHO.EQ.NCHO)GOTO 11 223 : IJ=IJ+NAVAN 224 : ENDIF 225 : 24 IF(IJ.GE.L1)GOTO 11 226 : 21 CONTINUE 227 : C 228 : C DESACTIVE TOUT 229 : C 230 : 11 CONTINUE 231 : IF(MCHO.EQ.0) THEN 232 : C 233 : C PAS DE CHOCS RENCONTRES 234 : C 235 : JG0=PROG(/1) 236 : JG=JG0+NACQ+1 237 : SEGADJ MLREEL 238 : JG1=MLREE3.PROG(/1) 239 : JG=JG1+NACQ+1 240 : SEGADJ MLREE3 241 : DO 13 IK=1,NACQ+1 242 : PROG(JG0+IK)=0.D0 243 : MLREE3.PROG(JG1+IK)=(IK-1)*DL 244 : 13 CONTINUE 245 : ELSE 246 : C 247 : C DIVISE LES VALEURS OBTENUS PAR LE NOMBRE DE CHOCS 248 : C 249 : JG1=MLREE3.PROG(/1) 250 : JG=JG1+NACQ+1 251 : SEGADJ MLREE3 252 : FMCHO=DBLE(MCHO) 253 : DO 12 IJ=1,NACQ+1 254 : PROG(IJ)=PROG(IJ)/FMCHO 255 : MLREE3.PROG(JG1+IJ)=(IJ-1)*DL 256 : 12 CONTINUE 257 : ENDIF 258 : SEGDES MLREE1,MLREE2 259 : SEGDES KEVOLL 260 : C 261 : SEGDES MLREEL,MLREE3 262 : SEGDES KEVOLL 263 : C 264 : 10 CONTINUE 265 : SEGDES MEVOL1 266 : SEGDES MEVOLL 267 : C 267 : CALL ECROBJ('EVOLUTIO',ISOLU) 268 : C 269 : 100 CONTINUE 270 : RETURN 271 : END 272 :
© Cast3M 2003 - All rights reserved.
Disclaimer