1 : C DIAD SOURCE CHAT 05/01/12 22:49:37 5004 2 : *$$$$ DIAD 3 : C DIAD SOURCE ISPRA 90/08/02 4 : SUBROUTINE DIAD 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : LOGICAL LDIRE,LINTE 8 : C 9 : C======================================================================= 10 : C = CALCUL DIADIQUE = 11 : C = = 12 : C = SYNTAXE : = 13 : C = = 14 : C = LIST1 = DIAD LIST2 (TYPE) ; = 15 : C = = 16 : C = = 17 : C = LIST2 : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL A TRAITER= 18 : C = LIST1 : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL REPONSE = 19 : C = = 20 : C = TYPE : 'DIRE' OU 'INVE' OU 'IVIN' (DEFAUT 'DIRE') = 21 : C = = 22 : C = = 23 : C = CREATION : 90/08/02 = 24 : C = MODIFICATION: 90/09/14 = 25 : C = PROGRAMMEUR : PEG = 26 : C======================================================================= 27 : C 28 : -INC CCOPTIO 29 : -INC SMEVOLL 30 : -INC SMLREEL 31 : C 32 : POINTEUR IPSIG.MLREEL,IPRES.MLREEL 33 : C 34 : PARAMETER (NMOCLE=3) 35 : CHARACTER*4 MOTCLE(NMOCLE) 36 : DATA MOTCLE/'DIRE','INVE','IVIN'/ 37 : C 38 : C DEFAUT TRANSFORMATION DIRECTE 39 : C 40 : LDIRE=.TRUE. 41 : LINTE=.FALSE. 42 : C 43 : C LECTURE DE L'OBJET LISTREEL CONTENANT LE SIGNAL 44 : C 44 : CALL LIROBJ('LISTREEL',IPSIG,1,IRET1) 45 : IF(IRET1.EQ.0) RETURN 46 : C 47 : C LECTURE DES OPTIONS 48 : C 48 : CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0) 49 : IF(IVAL.EQ.0)GOTO 9 50 : GOTO(2,3,4),IVAL 51 : C ---> "TYPE" 52 : 2 LDIRE=.TRUE. 53 : GOTO 9 54 : 3 LDIRE=.FALSE. 55 : LINTE=.FALSE. 56 : GOTO 9 57 : 4 LDIRE=.FALSE. 58 : LINTE=.TRUE. 59 : GOTO 9 60 : 9 CONTINUE 61 : C 62 : IF(IERR.NE.0) RETURN 63 : C 64 : C DIMENSION DES TABLEAUX 65 : C 66 : SEGACT IPSIG 67 : JG=IPSIG.PROG(/1) 68 : C 69 : IF(LDIRE)THEN 70 : JG=(JG+1)/2 71 : ELSE 72 : JG=JG*2-MOD(JG,2) 73 : ENDIF 74 : C 75 : C CREATION DE L'OBJET RESULTAT 76 : C 77 : SEGINI IPRES 78 : C 79 : IF(LDIRE)THEN 80 : DO 15 IE1=1,JG 81 : IPRES.PROG(IE1)=IPSIG.PROG(2*(IE1-1)+1) 82 : 15 CONTINUE 83 : ELSE 84 : IF(LINTE)THEN 85 : XNEXT=IPSIG.PROG(1) 86 : DO 20 IE1=1,JG/2-1+MOD(JG,2) 87 : X =XNEXT 88 : XNEXT=IPSIG.PROG(IE1+1) 89 : IPRES.PROG(2*(IE1-1)+1)= X 90 : IPRES.PROG(2*(IE1-1)+2)=(X+XNEXT)/2 91 : 20 CONTINUE 92 : IF (MOD(JG,2).EQ.0)THEN 93 : IPRES.PROG(JG-1)= XNEXT 94 : IPRES.PROG(JG) =(3*XNEXT-X)/2 95 : ELSE 96 : IPRES.PROG(JG) = XNEXT 97 : ENDIF 98 : ELSE 99 : DO 25 IE1=1,JG/2 100 : IPRES.PROG(2*(IE1-1)+1)=IPSIG.PROG(IE1) 101 : IPRES.PROG(2*(IE1-1)+2)=0.D0 102 : 25 CONTINUE 103 : IF (MOD(JG,2).NE.0)THEN 104 : IPRES.PROG(JG) = IPSIG.PROG((JG+1)/2) 105 : ENDIF 106 : ENDIF 107 : ENDIF 108 : C 109 : SEGDES IPSIG 110 : SEGDES IPRES 111 : C 111 : CALL ECROBJ('LISTREEL',IPRES) 112 : RETURN 113 : END 114 : 115 : 116 : 117 :
© Cast3M 2003 - All rights reserved.
Disclaimer