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