Télécharger misl.eso

Retour à la liste

Numérotation des lignes :

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

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