Télécharger misl.eso

Retour à la liste

Numérotation des lignes :

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

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