Sources Esope | Cast3M

misimp
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