C MISIMP SOURCE CB215821 17/07/21 21:15:21 9513 C MISIMP SOURCE SUBROUTINE MISIMP(MTABI,JIMPD,NF,TITR,IL,IC) C C======================================================================= C ECRITURE DES IMPEDANCES MISS3D DANS UNE EVOLUTION COMPLEXE C C Appelle par la routine MISL C======================================================================= C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*4 TITR CHARACTER*72 lemot LOGICAL OK1 PARAMETER(DEUX=2.0D0) -INC SMEVOLL -INC SMLREEL SEGMENT MATIMPD COMPLEX*16 IMPD(6,6,NFR) ENDSEGMENT MATIMPD=JIMPD SEGACT MATIMPD CALL ACCTAB(MTABI,'MOT',0,0.0D0,TITR,.TRUE.,0, & 'EVOLUTIO',IP,RR,lemot,OK1,ICO) MEVOLL=ICO SEGACT MEVOLL*MOD IEVTEX='Impedance '//TITR//' Rouge : partie reelle -- '// & 'Vert : partie imaginaire' KEVOL1=IEVOLL(1) KEVOL2=IEVOLL(2) SEGACT KEVOL1*MOD,KEVOL2*MOD MLREE1=KEVOL1.IPROGY MLREE2=KEVOL2.IPROGY SEGACT MLREE1*MOD,MLREE2*MOD KEVOL1.NUMEVX=2 KEVOL2.NUMEVX=4 KEVOL1.KEVTEX='Partie reelle' KEVOL2.KEVTEX='Partie imaginaire' IF(IL.EQ.IC)THEN DO JF=1, NF MLREE1.PROG(JF)= REAL(IMPD(IL,IC,JF)) MLREE2.PROG(JF)=-AIMAG(IMPD(IL,IC,JF)) ENDDO ELSE DO JF=1, NF MLREE1.PROG(JF)=(REAL(IMPD(IL,IC,JF))+ & REAL(IMPD(IC,IL,JF)))/DEUX MLREE2.PROG(JF)=-(AIMAG(IMPD(IL,IC,JF))+ & AIMAG(IMPD(IC,IL,JF)))/DEUX ENDDO ENDIF SEGDES MLREE1,MLREE2 SEGDES KEVOL1,KEVOL2 SEGDES MEVOLL SEGDES MATIMPD END