Télécharger misimp.eso

Retour à la liste

Numérotation des lignes :

  1. C MISIMP SOURCE AF221230 13/08/01 21:15:05 7808
  2. C MISIMP SOURCE
  3. SUBROUTINE MISIMP(MTABI,JIMPD,NF,TITR,IL,IC)
  4. C
  5. C=======================================================================
  6. C ECRITURE DES IMPEDANCES MISS3D DANS UNE EVOLUTION COMPLEXE
  7. C
  8. C Appelle par la routine MISL
  9. C=======================================================================
  10. C
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13. CHARACTER*4 TITR
  14. CHARACTER*72 lemot
  15. LOGICAL OK1
  16. PARAMETER(DEUX=2.0D0)
  17.  
  18. -INC SMEVOLL
  19. -INC SMLREEL
  20. SEGMENT MATIMPD
  21. COMPLEX*16 IMPD(6,6,NFR)
  22. ENDSEGMENT
  23. MATIMPD=JIMPD
  24. SEGACT MATIMPD
  25.  
  26. CALL ACCTAB(MTABI,'MOT',0,0.0D0,TITR,.TRUE.,0,
  27. & 'EVOLUTIO',IP,RR,lemot,OK1,ICO)
  28. MEVOLL=ICO
  29. SEGACT MEVOLL*MOD
  30. IEVTEX='Impedance '//TITR//' Rouge : partie reelle -- '//
  31. & 'Vert : partie imaginaire'
  32. KEVOL1=IEVOLL(1)
  33. KEVOL2=IEVOLL(2)
  34. SEGACT KEVOL1*MOD,KEVOL2*MOD
  35. MLREE1=KEVOL1.IPROGY
  36. MLREE2=KEVOL2.IPROGY
  37. SEGACT MLREE1*MOD,MLREE2*MOD
  38. KEVOL1.NUMEVX=2
  39. KEVOL2.NUMEVX=4
  40. KEVOL1.KEVTEX='Partie reelle'
  41. KEVOL2.KEVTEX='Partie imaginaire'
  42.  
  43. IF(IL.EQ.IC)THEN
  44. DO JF=1, NF
  45. MLREE1.PROG(JF)=DREAL(IMPD(IL,IC,JF))
  46. MLREE2.PROG(JF)=-DIMAG(IMPD(IL,IC,JF))
  47. ENDDO
  48. ELSE
  49. DO JF=1, NF
  50. MLREE1.PROG(JF)=(DREAL(IMPD(IL,IC,JF))+
  51. & DREAL(IMPD(IC,IL,JF)))/DEUX
  52. MLREE2.PROG(JF)=-(DIMAG(IMPD(IL,IC,JF))+
  53. & DIMAG(IMPD(IC,IL,JF)))/DEUX
  54. ENDDO
  55. ENDIF
  56. SEGDES MLREE1,MLREE2
  57. SEGDES KEVOL1,KEVOL2
  58. SEGDES MEVOLL
  59.  
  60. SEGDES MATIMPD
  61.  
  62. END
  63.  
  64.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales