C CVOL SOURCE CHAT 05/01/12 22:33:27 5004 *$$$$ CVOL C CVOL SOURCE ISPRA 90/07/25 SUBROUTINE CVOL IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) LOGICAL LSYM,LRSYM,LOK C C======================================================================= C = CALCUL DE CONVOLUTION = C = = C = SYNTAXE : = C = = C = SRLIST = CVOL SLIST RLIST (('NPNE' MM) TYPE) ; = C = = C = = C = SLIST : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL A TRAITER= C = RLIST : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL REPONSE = C = SRLIST : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL RESULTAT = C = = C = MM : OBJET DE TYPE ENTIER DONNANT LA LONGUEUR DE LA = C = PARTIE NEGATIVE DU SIGNAL DE REPONSE SI NON SYMETRIE= C = TYPE : 'SYME' OU 'PADD' (DEFAUT 'SYME') = C = = C = = C = CREATION : 90/08/02 = C = PROGRAMMEUR : PEG = C======================================================================= C -INC PPARAM -INC CCOPTIO -INC SMEVOLL -INC SMLREEL -INC CCREEL C POINTEUR IPSIG.MLREEL,IPREP.MLREEL POINTEUR IPRESU.MLREEL SEGMENT MTRAV IMPLIED SIG(KNPM),REP(KM),RESU(KN) ENDSEGMENT C PARAMETER (NMOCLE=3) CHARACTER*4 MOTCLE(NMOCLE) DATA MOTCLE/'SYME','PADD','NPNE'/ LOK=.TRUE. C C DEFAUT (REPONSE SYMETRIQUE,SIGNAL SYMETRIQUE) C LRSYM=.TRUE. LSYM=.TRUE. C C LECTURE DE L'OBJET LISTREEL CONTENANT LE SIGNAL C CALL LIROBJ('LISTREEL',IPSIG,1,IRET1) IF(IRET1.EQ.0) RETURN C C LECTURE DE L'OBJET LISTREEL CONTENANT LA REPONSE C CALL LIROBJ('LISTREEL',IPREP,1,IRET1) IF(IRET1.EQ.0) RETURN C C LECTURE DES OPTIONS C 1 CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0) IF(IVAL.EQ.0)GOTO 9 GOTO(2,3,4),IVAL C ---> "TYPE" 2 LSYM=.TRUE. GOTO 1 3 LSYM=.FALSE. GOTO 1 C ---> "NPNE" 4 LRSYM=.FALSE. CALL LIRENT(MM,1,IRET1) IF(IRET1.EQ.0) RETURN GOTO 1 9 CONTINUE C IF(IERR.NE.0) RETURN C C DIMENSION DES TABLEAUX DE TRAVAIL ET TESTS C SEGACT IPSIG KN=IPSIG.PROG(/1) C SEGACT IPREP KKM=IPREP.PROG(/1) IF (LRSYM)THEN MM=KKM-1 KM=2*KKM-1 ELSE KM=KKM ENDIF C IF(KM.EQ.MM)THEN MP=0 ELSE MP=KM-MM-1 ENDIF C IF(MM.GT.KM)THEN LOK=.FALSE. CALL ERREUR(569) ENDIF C IF(LSYM)THEN IF(MM+1.GT.KN)THEN LOK=.FALSE. MOTERR='gauche' CALL ERREUR(570) ENDIF IF(MP+1.GT.KN)THEN LOK=.FALSE. MOTERR='droite' CALL ERREUR(570) ENDIF ENDIF C IF(.NOT.LOK)THEN SEGDES IPSIG,IPREP RETURN C LSYM=.FALSE. C WRITE(IOIMP,*)'CVOL:-----> ZERO PADDING' ENDIF C KNPM=KN+MM+MP C SEGINI MTRAV C C REMPLISSAGE DES TABLEAUX DE TRAVAIL C IF(LRSYM)THEN DO 10 IE1=1,KKM XXXX =IPREP.PROG(IE1) REP(MM+IE1) =XXXX REP(MM+2-IE1)=XXXX 10 CONTINUE ELSE DO 11 IE1=1,KKM XXXX =IPREP.PROG(IE1) REP(IE1) =XXXX 11 CONTINUE ENDIF SEGDES IPREP C DO 15 IE1=1,KN SIG(MM+IE1)=IPSIG.PROG(IE1) 15 CONTINUE C SEGDES IPSIG C IF(MM.NE.0)THEN IF (LSYM)THEN DO 16 IE1=1,MM SIG(IE1)=SIG(2*MM+2-IE1) 16 CONTINUE ELSE DO 18 IE1=1,MM SIG(IE1)=0.D0 18 CONTINUE ENDIF ENDIF IF(MP.NE.0)THEN IF (LSYM)THEN DO 17 IE1=1,MP SIG(MM+KN+IE1)=SIG(MM+KN-IE1) 17 CONTINUE ELSE DO 19 IE1=1,MP SIG(MM+KN+IE1)=0.D0 19 CONTINUE ENDIF ENDIF C CALL CNVOLU(SIG,REP,RESU,KN,KM) C C CREATION DE L'OBJET RESULTAT C JG=KN SEGINI IPRESU C DO 25 IE1=1,KN IPRESU.PROG(IE1)=RESU(IE1) 25 CONTINUE C SEGDES IPRESU SEGSUP MTRAV C CALL ECROBJ('LISTREEL',IPRESU) RETURN END