Télécharger la plaquette Cast3M


fr en

Télécharger misl.eso

Retour à la liste

Numérotation des lignes : 

misl

  1. C MISL      SOURCE    CB215821  20/11/25    13:34:28     10792          
  2. C MISL      SOURCE
  3.       SUBROUTINE MISL
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. C=======================================================================
  7. C OPERATEUR MISL :
  8. C           LECTURE  DES FICHIERS RESULTATS DU CALCUL MISS
  9. C
  10. C SYNTAXE :
  11. C       *   MISL TAB1;
  12. C
  13. C         TAB1     TABLE FABRIQUEE PAR LA PROCEDURE PREPMISS
  14. c                  PUIS COMPLETEE PAR LA PROCEDURE POSTMISS
  15. C                  APRES AVOIR EXECUTE MISS3D
  16. C
  17. C=======================================================================
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMCHPOI
  22. -INC SMELEME
  23. -INC SMEVOLL
  24. -INC SMLREEL
  25. -INC CCREEL
  26.       external long
  27.       CHARACTER*72 lemot
  28.       LOGICAL OK1
  29.       CHARACTER*20 NOMETU
  30.       CHARACTER*80 REPER
  31.       CHARACTER*105 FICMISS
  32.       PARAMETER(NMVFD=50,NIMPDC=51)
  33.       LOGICAL DIRX,DIRY,DIRZ,SAUVD,SAUVV,SAUVA,CALDYN,OK
  34.       INTEGER IFOU(3)
  35.       COMPLEX*16 ZOZO(14,10)
  36.       INTEGER NM,NF,NC,I
  37. C
  38.       SEGMENT MATCOMP
  39.         COMPLEX*16 CM(NLI,NF,NC)
  40.       ENDSEGMENT
  41.       POINTEUR MATC1.MATCOMP,MATC2.MATCOMP
  42.       SEGMENT MDDL
  43.         INTEGER KCO(4,NKCO),KCO1(4,NKCO1),KLIA(NKCO)
  44.         CHARACTER*2 NOCO(NKCO)
  45.       ENDSEGMENT
  46.       SEGMENT MCTRAV
  47.         COMPLEX*16 Z(NN,NC),X(NPT),Y(NPT),W(NEXP)
  48.       ENDSEGMENT
  49.       SEGMENT MRTRAV
  50.         REAL*8 UR(NN),UI(NN)
  51.       ENDSEGMENT
  52.       SEGMENT MATIMPD
  53.         COMPLEX*16 IMPD(6,6,NFR)
  54.       ENDSEGMENT
  55. c      SEGMENT ALBSSG
  56. c        REAL*8 LFRA(NF,NLI),LREA(NF,NLI),LIMA(NF,NLI)
  57. c      ENDSEGMENT
  58. C
  59. C  lecture table
  60.       CALL LIROBJ('TABLE   ',MTAB1,1,IRETOU)
  61.       IF (IERR.NE.0) RETURN
  62. C
  63. C  Niveau d'impression
  64.       CALL ACCTAB(MTAB1,'MOT',0,XZERO,'NIVE_IMPR',.TRUE.,0,
  65.      &        'ENTIER',IIMPM,RR,lemot,OK1,IZ)
  66. C
  67. C On regarde deja si calcul dynamique ou impedances seulement
  68.       CALL ACCTAB(MTAB1,'MOT',0,XZERO,'TYPE_CALCUL',.TRUE.,0,
  69.      &        'MOT',IP,RR,lemot,OK1,IO)
  70.       CALDYN=.FALSE.
  71.       IF(lemot(1:9).EQ.'DYNAMIQUE')CALDYN=.TRUE.
  72. C
  73. C lecture nom etude et ouverture des fichiers
  74.       CALL ACCTAB(MTAB1,'MOT',0,XZERO,'NOM_ETUDE',.TRUE.,0,
  75.      &        'MOT',IP,RR,NOMETU,OK1,IZ)
  76.       LE=long(NOMETU)
  77.       CALL ACCTAB(MTAB1,'MOT',0,XZERO,'REPERTOIRE_MISS',.TRUE.,0,
  78.      &        'MOT',IP,RR,REPER,OK1,IZ)
  79.       LR=long(REPER)
  80. C
  81. CCC----------- version 32 bit
  82. C***********************************************************
  83. C*******  ce module est fait seulement pour la version *****
  84. C*******  originale de MISS3D 32 bit. Pour la version ******
  85. c*******  64 bit compilé par ifort les resultats ne seront**
  86. C*******  pas bons !!!!!   *********************************
  87. C***********************************************************
  88. c      IF (SIZEOF(NF).EQ.4) THEN
  89.       IF (1.eq.1) THEN
  90. C
  91.       WRITE(IOIMP,*) ' '
  92.       WRITE(IOIMP,*) 'WARNING only MISS3D 32bit version'
  93.       WRITE(IOIMP,*) '            not 64bit version'
  94.       WRITE(IOIMP,*)' '
  95. C
  96. C  Calcul dynamique ou impedances
  97.       IF(CALDYN)THEN
  98. CCC----------- Debut calcul dynamique
  99. C
  100.         FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.MVFD'
  101. C
  102. C Lecture des dimensions dans MVFD
  103. c        LENR=40
  104.         LENR=256
  105.         OPEN(FILE=FICMISS,UNIT=NMVFD,FORM='UNFORMATTED',
  106.      &  ACCESS='DIRECT',RECL=LENR,STATUS='OLD')
  107.         READ(UNIT=NMVFD,REC=1)NM,I,NC,I,I,I,NF
  108. C
  109. C Lecture des complexes MVFD
  110.         IF(IIMPM.GE.1)WRITE(IOIMP,*)'Lecture des reponses modales ',
  111.      &                            'issues de MISS3D'
  112.         LENR=NM*2*8
  113.         IF(NM.LT.16)LENR=16*2*8
  114.         CLOSE(NMVFD)
  115.         FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.MVFD'
  116.         OPEN(FILE=FICMISS,UNIT=NMVFD,FORM='UNFORMATTED',
  117.      &  ACCESS='DIRECT',RECL=LENR,STATUS='OLD')
  118.  
  119.         NLI=NM
  120.         SEGINI MATC1
  121.         IMATC1=MATC1
  122.         DO JF=1,NF
  123.           DO JC=1,NC
  124.            J=(JF-1)*NC+JC+1
  125.            READ(UNIT=NMVFD,REC=J)(MATC1.CM(K,JF,JC),K=1,NM)
  126.          ENDDO
  127.         ENDDO
  128.         CLOSE(NMVFD)
  129.         SEGDES MATC1
  130. C
  131.         CALL ACCTAB(MTAB1,'MOT',0,XZERO,'FREQ_SOL_MIN',.TRUE.,0,
  132.      &        'FLOTTANT',IP,FSINI,NOMETU,OK1,IZ)
  133.         CALL ACCTAB(MTAB1,'MOT',0,XZERO,'FREQ_SOL_MAX',.TRUE.,0,
  134.      &        'FLOTTANT',IP,FSMAX,NOMETU,OK1,IZ)
  135.         CALL ACCTAB(MTAB1,'MOT',0,XZERO,'FREQ_SOL_PAS',.TRUE.,0,
  136.      &        'FLOTTANT',IP,FSPAS,NOMETU,OK1,IZ)
  137. C
  138.         MATC1=IMATC1
  139.         SEGACT MATC1
  140. C
  141. C Sauvegarde des fonctions transfert de coef de partecipation des modes
  142.         CALL ACCTAB(MTAB1,'MOT',0,XZERO,'COEF_PART',.TRUE.,0,
  143.      &        'TABLE',IP,RR,NOMETU,OK1,MTAB3)
  144. C
  145.         DO JC=1,NC
  146.           CALL ACCTAB(MTAB3,'ENTIER',JC,XZERO,' ',.TRUE.,0,
  147.      &       'TABLE',IP,RR,NOMETU,OK1,MTAB4)
  148.           DO 720 INM=1,NM
  149.             CALL ACCTAB(MTAB4,'ENTIER',INM,XZERO,' ',.TRUE.,0,
  150.      &          'EVOLUTIO',IP,RR,NOMETU,OK1,IEV1)
  151.             MEVOLL=IEV1
  152.              SEGACT MEVOLL*MOD
  153.              IEVTEX='Coef_Part'
  154.              KEVOL1=IEVOLL(1)
  155.              KEVOL2=IEVOLL(2)
  156.              SEGACT KEVOL1*MOD,KEVOL2*MOD
  157.              MLREE1=KEVOL1.IPROGY
  158.              MLREE2=KEVOL2.IPROGY
  159.              SEGACT MLREE1*MOD,MLREE2*MOD
  160.              KEVOL1.NUMEVX=2
  161.              KEVOL2.NUMEVX=4
  162.              KEVOL1.KEVTEX='Partie reelle'
  163.              KEVOL2.KEVTEX='Partie imaginaire'
  164.                DO JF=1, NF
  165.                  MLREE1.PROG(JF)=REAL(MATC1.CM(INM,JF,JC))
  166.                  MLREE2.PROG(JF)=AIMAG(MATC1.CM(INM,JF,JC))
  167.                ENDDO
  168.              SEGDES MLREE1,MLREE2
  169.              SEGDES KEVOL1,KEVOL2
  170.              SEGDES MEVOLL
  171.  720      CONTINUE
  172.         ENDDO
  173. C
  174.         SEGDES MATC1
  175. C
  176. CCC------------ Fin calcul dynamique
  177.       ELSE
  178. C
  179. C------------ Impression impedances
  180. c
  181.         FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.01.IMPDC'
  182.         LENR=16*16
  183.         OPEN(FILE=FICMISS,UNIT=NIMPDC,FORM='UNFORMATTED',
  184.      &  ACCESS='DIRECT',RECL=LENR,STATUS='OLD')
  185.         READ(UNIT=NIMPDC,REC=1)NM,I,NC,I,I,I,NF
  186. C
  187.         IF(IIMPM.GE.1)WRITE(IOIMP,*)'Lecture des impedances ',
  188.      &                            'issues de MISS3D'
  189. C
  190.         WRITE(6,*) '    Nombres Frequences        ',NF
  191.         WRITE(6,*) '    Nombres champs interface',NM
  192. C
  193.         NFR=NF
  194.         SEGINI MATIMPD
  195.         DO JF=1,NF
  196.           I=6*(JF-1)
  197.           DO K=1,6
  198.             READ(UNIT=NIMPDC,REC=I+K+1)(IMPD(J,K,JF),J=1,6)
  199.           ENDDO
  200.         ENDDO
  201.         CLOSE(NIMPDC)
  202. c
  203.         CALL ACCTAB(MTAB1,'MOT',0,XZERO,'IMPEDANCES',.TRUE.,0,
  204.      &        'TABLE',IP,RR,lemot,OK1,MTABI)
  205. C
  206.         JIMPD=MATIMPD
  207.         CALL MISIMP(MTABI,JIMPD,NF,'KXX ',1,1)
  208.         CALL MISIMP(MTABI,JIMPD,NF,'KYY ',2,2)
  209.         CALL MISIMP(MTABI,JIMPD,NF,'KZZ ',3,3)
  210.         CALL MISIMP(MTABI,JIMPD,NF,'KRX ',4,4)
  211.         CALL MISIMP(MTABI,JIMPD,NF,'KRY ',5,5)
  212.         CALL MISIMP(MTABI,JIMPD,NF,'KRZ ',6,6)
  213.         CALL MISIMP(MTABI,JIMPD,NF,'KXRY',1,5)
  214.         CALL MISIMP(MTABI,JIMPD,NF,'KYRX',2,4)
  215. C
  216.         SEGSUP MATIMPD
  217. CCC------------ Fin Impression impedances
  218.       ENDIF
  219.       ENDIF
  220.       END
  221.  
  222.  
  223.  
  224.  

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