C CHOMOY SOURCE OF166741 25/02/20 21:15:30 12165 SUBROUTINE CHOMOY IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) CHARACTER *72 TI CHARACTER *8 IACQ,IDCL,ITMOT CHARACTER *4 MOLU,ICHO C C======================================================================= C = CALCUL D'UN CHOC MOYEN A PARTIR D'UNE COURBE CONTENANT N CHOCS = C = = C = SYNTAXE : EVO2 = CMOY EVO1 (NCHO) (DECL V1) ACQU V2 ; = C = = C = IL PEUT Y AVOIR PLUSIEURS COURBES A TRAITER DANS EVO1; A CHACUNE = C = D'ELLES CORRESPOND UNE COURBE CHOC MOYEN DANS EVO2. = C = NCHO EST L'ENTIER NOMBRE DE CHOCS A MOYENNER = C = V1 EST LE SEUIL (EN % DE LA VALEUR MAXIE) DE DECLENCHEMENT = C = DE L'ACQUISITION D'UN IMPACT DANS EVO1; (OBJET DE TYPE FLOTTANT )= C = V2 EST LE TEMPS D'ACQUISITION DU CHOC A CHAQUE DECLENCHEMENT = C = (OBJET DE TYPE FLOTTANT) = C = = C = = C======================================================================= C -INC PPARAM -INC CCOPTIO -INC SMEVOLL -INC SMLREEL C DATA IDCL,IACQ,ITMOT/'DECLENCH','ACQUISIT','MOT '/ DATA ICHO/'NCHO'/ C CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET) IF(IERR.NE.0) GOTO 100 C C LECTURE D'UN MOT-CLE ET DE SA DONNEE CORRESPONDANTE C DECLEN=0.D0 ACQUI=0.D0 DO 1 J=1,3 MOLU=' ' CALL LIRCHA(MOLU,0,IRETOU) IF(IIMPI.EQ.1)WRITE(IOIMP,9999)MOLU 9999 FORMAT(' MOT LU :',A4) IF(IERR.NE.0) GOTO 100 IF((IRETOU.EQ.0).AND.(ACQUI.EQ.0.D0)) THEN C *** LE TEMPS D'ACQUISITION EST OBLIGATOIRE MOTERR(1:4)=IACQ(1:4) CALL ERREUR(396) GOTO 100 ELSEIF(IRETOU.EQ.0) THEN GOTO 1 ENDIF C IF(MOLU.EQ.IACQ(:4)) THEN C ENTREE DU TEMPS D'ACQUISITION (OBLIGATOIRE) CALL LIRREE(ACQUI,0,IRET) IF(IERR.NE.0) GOTO 100 IF(IRET.EQ.0) THEN MOTERR(1:4)=IACQ(1:4) CALL ERREUR(166) GOTO 100 ENDIF IF(ACQUI.LE.0.D0)THEN C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE MOTERR(1:8)=IACQ(1:8) REAERR(1)=ACQUI REAERR(2)=0.D0 CALL ERREUR(41) GOTO 100 ENDIF ENDIF C IF(MOLU.EQ.IDCL(:4)) THEN C ENTREE DU NIVEAU DE DECLENCHEMENT (FACULTATIF) CALL LIRREE(DECLEN,0,IDECL) IF(IERR.NE.0) GOTO 100 IF((DECLEN.LT.0.D0).OR.(DECLEN.GT.100.D0)) THEN C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE MOTERR(1:8)=IDCL(1:8) REAERR(1)=DECLEN REAERR(2)=0.D0 REAERR(3)=100.D0 CALL ERREUR(42) GOTO 100 ENDIF ENDIF C NCHO=0 IF(MOLU.EQ.ICHO) THEN C ENTREE DU NOMBRE DE CHOCS A TRAITER (FACULTATIF) CALL LIRENT(NCHO,0,IRET) IF(IERR.NE.0) GOTO 100 IF(IRET.EQ.0) THEN MOTERR(1:4)=ICHO(1:4) CALL ERREUR(166) GOTO 100 ENDIF IF(NCHO.LT.0) THEN C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE INTERR(1)=0 INTERR(2)=NCHO CALL ERREUR(190) ENDIF ENDIF C 1 CONTINUE C C MEVOL1=IPEVO SEGACT MEVOL1 NC=MEVOL1.IEVOLL(/1) N=NC SEGINI MEVOLL ISOLU=MEVOLL TI(1:72)=TITREE IEVTEX=TI ITYEVO=MEVOL1.ITYEVO C C BOUCLE SUR LES COURBES C DO 10 IC=1,NC KEVOL1=MEVOL1.IEVOLL(IC) SEGACT KEVOL1 MLREE1=KEVOL1.IPROGX SEGACT MLREE1 MLREE2=KEVOL1.IPROGY SEGACT MLREE2 L1=MLREE1.PROG(/1) DL=MLREE1.PROG(2)-MLREE1.PROG(1) C SEGINI KEVOLL IEVOLL(IC)=KEVOLL NOMEVX=KEVOL1.NOMEVX NOMEVY=KEVOL1.NOMEVY NUMEVX=KEVOL1.NUMEVX NUMEVY=KEVOL1.NUMEVY TYPX=KEVOL1.TYPX TYPY=KEVOL1.TYPY KEVTEX=TI JG=0 SEGINI MLREEL IPROGY=MLREEL SEGINI MLREE3 IPROGX=MLREE3 C VMAX=0.D0 MCHO=0 C C CHERCHE LE NIVEAU DE DECLENCHEMENT C DO 20 I=1,L1 FORC=ABS(MLREE2.PROG(I)) IF(FORC.GT.VMAX)VMAX=FORC 20 CONTINUE SEUIL=DECLEN*VMAX/100.D0 IF(IDECL.EQ.0) SEUIL=1.D-10 IF(IIMPI.EQ.1) THEN WRITE(IOIMP,1000)SEUIL WRITE(IOIMP,1006)ACQUI 1000 FORMAT(' NIVEAU DE DECLENCHEMENT = ',1PE12.5) 1006 FORMAT(' TEMPS D''ACQUISITION = ',1PE12.5) ENDIF C C CHERCHE LE NOMBRE DE PAS D'ACQUISITION C NACQ=INT(ACQUI/DL) NRECU=INT(DBLE(NACQ)*0.201D0) NAVAN=NACQ-NRECU IF(IIMPI.EQ.1)THEN WRITE(IOIMP,1001)NACQ WRITE(IOIMP,1002)NRECU WRITE(IOIMP,1003)NAVAN WRITE(IOIMP,1009)L1 1001 FORMAT(' NOMBRE DE PAS D''ACQUISITION = ',I4) 1002 FORMAT(' NOMBRE DE PAS DE RECUL = ',I4) 1003 FORMAT(' NOMBRE DE PAS D''AVANCE = ',I4) 1009 FORMAT(' NOMBRE DE PTS A TRAITER = ',I4) ENDIF C C ACCUMULE LES CHOCS C IJ=0 DO 21 I=1,L1 IJ=IJ+1 FORC=ABS(MLREE2.PROG(IJ)) IF(FORC.GT.SEUIL) THEN ID=IJ-NRECU C C ON OUBLIE LE PREMIER CHOC SI IL EST A CHEVAL SUR LE DEBUT DE LA C PROGRESSION IF(ID.LE.0)THEN IF(IIMPI.EQ.1)WRITE(IOIMP,1007) 1007 FORMAT(' CHOC A CHEVAL SUR DEBUT BLOC : NEGLIGE ') DO 211 II=(IJ+1),L1 FORC=ABS(MLREE2.PROG(II)) IF(FORC.LE.1.D-10) THEN IJ=II GOTO 24 ENDIF 211 CONTINUE ENDIF C C ON OUBLIE LE DERNIER CHOC SI IL EST A CHEVAL SUR LA FIN DE LA C PROGRESSION IF((ID+NACQ).GT.L1) THEN IF(IIMPI.EQ.1)WRITE(IOIMP,1008) 1008 FORMAT(' CHOC A CHEVAL SUR FIN BLOC : NEGLIGE ') GOTO 11 ENDIF C C IF(IIMPI.EQ.1)WRITE(IOIMP,1004)IJ,MLREE2.PROG(IJ) 1004 FORMAT(' DEBUT DE CHOC AU PT ',I4,' AMPLITUDE A CE PAS = ', & 1PE12.5) MCHO=MCHO+1 IF(IIMPI.EQ.1)WRITE(IOIMP,1005)MCHO 1005 FORMAT(' CHOC NUMERO ',I3) IF(MCHO.EQ.1) THEN JG=1+NACQ SEGADJ MLREEL DO 22 JJ=ID,(ID+NACQ) FORC=ABS(MLREE2.PROG(JJ)) PROG(1+JJ-ID)=FORC 22 CONTINUE ELSE IND=0 DO 23 JJ=ID,(ID+NACQ) IND=IND+1 FORC=ABS(MLREE2.PROG(JJ)) PROG(IND)=PROG(IND)+FORC 23 CONTINUE ENDIF IF(MCHO.EQ.NCHO)GOTO 11 IJ=IJ+NAVAN ENDIF 24 IF(IJ.GE.L1)GOTO 11 21 CONTINUE C C DESACTIVE TOUT C 11 CONTINUE IF(MCHO.EQ.0) THEN C C PAS DE CHOCS RENCONTRES C JG0=PROG(/1) JG=JG0+NACQ+1 SEGADJ MLREEL JG1=MLREE3.PROG(/1) JG=JG1+NACQ+1 SEGADJ MLREE3 DO 13 IK=1,NACQ+1 PROG(JG0+IK)=0.D0 MLREE3.PROG(JG1+IK)=(IK-1)*DL 13 CONTINUE ELSE C C DIVISE LES VALEURS OBTENUS PAR LE NOMBRE DE CHOCS C JG1=MLREE3.PROG(/1) JG=JG1+NACQ+1 SEGADJ MLREE3 FMCHO=DBLE(MCHO) DO 12 IJ=1,NACQ+1 PROG(IJ)=PROG(IJ)/FMCHO MLREE3.PROG(JG1+IJ)=(IJ-1)*DL 12 CONTINUE ENDIF SEGDES MLREE1,MLREE2 SEGDES KEVOLL C SEGDES MLREEL,MLREE3 SEGDES KEVOLL C 10 CONTINUE SEGDES MEVOL1 SEGDES MEVOLL C CALL ECROBJ('EVOLUTIO',ISOLU) C 100 CONTINUE RETURN END