1 : C SIMUL7 SOURCE BP208322 12/01/10 21:15:10 7244 2 : SUBROUTINE SIMUL7(IPSOLU,IPMASS,IPKW2M,W2,IPLMOX,IPLMOY,IFLU) 3 : C 4 : C*********************************************************************** 5 : C 6 : C SBR APPELE PAR SIMUL1 7 : C 8 : C VERSION 11/06/86 AUTEUR D. BROCHARD 9 : C modifs BP 06/01/2012 : ajout cas M non definie positive 10 : C 11 : C CALCUL MASSE GENERALISEE ET DEPL. GEN. DANS LE CAS OU L ON FAIT 12 : C UN CALCUL DE MODES (VIBRATION) OPTION SIMULTANEE 13 : C 14 : C IPSOLU : POINTEUR SUR L OBJET SOLUTION 15 : C IPMASS : POINTEUR SUR L OBJET RIGIDITE DE TYPE MASSE 16 : C PROPRE : VOIR ITINV 17 : C 18 : C SOUS-PROGRAMMES APPELES : XTMX,MASGEN,DEPGEN 19 : C 20 : C*********************************************************************** 21 : C 22 : C 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : REAL*8 PROPRE(5) 26 : -INC CCREEL 27 : -INC SMSOLUT 28 : -INC SMCHPOI 29 : -INC CCOPTIO 30 : * 31 : SEGMENT TRAV 32 : REAL*8 TT(NM),TT1(NM) 33 : INTEGER IORD(NM),IPOS(NM) 34 : ENDSEGMENT 35 : * 36 : MSOLUT=IPSOLU 37 : SEGACT MSOLUT 38 : MSOLEN=MSOLIS(4) 39 : SEGACT MSOLEN 40 : NBMOD=ISOLEN(/1) 41 : * 42 : NM=NBMOD 43 : SEGINI TRAV 44 : * 45 : MSOLE1=MSOLIS(5) 46 : SEGACT MSOLE1 47 : C 48 : C 49 : DO 10 NMOD=1,NBMOD 50 : IPX=MSOLE1.ISOLEN(NMOD) 51 : C 52 : C CALCUL DE XTMX (MASSE GENERALISEE SANS COEFF.) 53 : C 53 : ** CALL XTMX(MCHPOI,IPMASS,X1TMX1) 54 : ** PROPRE(2)=X1TMX1 55 : * 55 : CALL MUCPRI(IPX,IPMASS,IPBX) 55 : C IF(NMOD.EQ.1) CALL CORRSP(IPX,IPBX,IPLMOX,IPLMOY) 55 : CALL XTY1(IPX,IPBX,IPLMOX,IPLMOY,XMG) 56 : PROPRE(2)=XMG 57 : * 58 : C 59 : C CALCUL MASSE GEN. AVEC COEF. 60 : C 60 : CALL MASGEN(IPX,PROPRE) 61 : C 62 : C CALCUL DEPL. GEN. 63 : C 63 : CALL DEPGEN(IPMASS,IPX,PROPRE,IPBX,IPLMOX,IPLMOY) 64 : C 65 : C MODIFICATION DE L OBJET SOLUTION 66 : C 67 : MMODE=ISOLEN(NMOD) 68 : SEGACT MMODE*MOD 69 : TT(NMOD)=FMMODD(1) 70 : DO 20 I=2,5 71 : FMMODD(I)=PROPRE(I) 72 : 20 CONTINUE 73 : SEGDES MMODE 74 : 10 CONTINUE 75 : C 76 : C RANGER DANS TT1 LES FREQUENCES PAR ORDRE CROISSANT 77 : C IPOS(I) POSITION DANS TT DE LA IEME FREQ. 78 : C 79 : DO 400 I=1,NBMOD 80 : 400 TT1(I)=0.E0 81 : C 82 : TT1(1)=TT(1) 83 : DO 410 N1=2,NBMOD 84 : IF(TT(N1).LT.TT1(N1-1)) GOTO 420 85 : TT1(N1)=TT(N1) 86 : GOTO 410 87 : 420 CONTINUE 88 : DO 430 N2=1,(N1-1) 89 : N1M2=N1-N2-1 90 : IF(N1M2.EQ.0) GOTO 500 91 : IF(TT(N1).GT.TT1(N1M2)) GOTO 500 92 : 430 CONTINUE 93 : C 94 : C 95 : 500 CONTINUE 96 : N1M21=N1M2+1 97 : J=0 98 : DO 510 I=N1M21,(N1-1) 99 : TT1(N1-J)=TT1(N1-J-1) 100 : J=J+1 101 : 510 CONTINUE 102 : TT1(N1M21)=TT(N1) 103 : 410 CONTINUE 104 : C 105 : C CALCUL DE LA POSITION DE LA IEME FREQUENCE 106 : C 107 : DO 600 I=1,NBMOD 108 : FR=TT1(I) 109 : DO 605 J=1,NBMOD 110 : IF(FR.EQ.TT(J)) GOTO 610 111 : 605 CONTINUE 112 : 610 CONTINUE 113 : TT(J)=-1. 114 : IPOS(I)=J 115 : 600 CONTINUE 116 : C 117 : C 118 : C CALCUL DU NUMERO DU MODE 119 : C 119 : CALL DIAGN1(IPKW2M,IND0) 120 : *ajout bp 06/01/2012: 120 : CALL DIAGN1(IPMASS,nvp0M) 121 : * correction pour elements fluides (inconnue PI mise à 0 via INITFL) 122 : c nvp0M = nvp0M - IFLU 123 : * bp 10/01/2012: nvp0M et NEMSM ne semblent pas bien calculés ... 124 : * (resultats dependant machine -> cf. dyna7.dgibi) 125 : * on propose la solution qui suppose que nvp0M si M est LIQUIDE 126 : if(IFLU.gt.0) nvp0M=0 127 : if(nvp0M.ne.0) then 128 : if (W2.gt.0.D0) then 129 : IND0=nvp0M+IND0 130 : elseif (W2.lt.0.D0) then 131 : IND0=nvp0M-IND0 132 : else 133 : IND0=nvp0M 134 : endif 135 : endif 136 : *rem : le cas ou ni K ni M ne sont defini positifs n est pas prevu pour 137 : * l instant car le théroème de Sylvester ne s'applique pas. 138 : * on va donc utiliser la formule ci dessus et planter dans strate 139 : * (ou au mieux fournir un numero faux) 140 : 141 : FIN=SQRT(W2)/(2.0*XPI) 142 : IF(FIN.LT.TT1(1)) GOTO 120 143 : IF(FIN.GT.TT1(NBMOD)) GOTO 130 144 : DO 100 IN=2,NBMOD 145 : IF(FIN.GE.TT1(IN-1).AND.FIN.LE.TT1(IN)) GOTO 110 146 : 100 CONTINUE 147 : C 148 : 120 CONTINUE 149 : C 150 : C FIN INF. A TT1(1) ON ASSOCIE IND0 A TT1(1) 151 : C 152 : IREP=1 153 : IND0=IND0+1 154 : GOTO 140 155 : 130 CONTINUE 156 : C 157 : C FIN SUP TT1(NMOD) ON ASSOCIE IND0 A TT1(NMOD) 158 : C 159 : IREP=NBMOD 160 : GOTO 140 161 : 110 CONTINUE 162 : C 163 : C CAS GENERAL ON ASSOCIE IND0 AU MODE JUSTE EN DESSOUS 164 : C 165 : C IREP=IN 166 : C IF((TT1(IN)-FIN).LE.(FIN-TT1(IN-1))) GOTO 140 167 : IREP=IN-1 168 : 140 CONTINUE 169 : DO 220 I=1,NBMOD 170 : IORD(IPOS(I))=IND0-IREP+I 171 : 220 CONTINUE 172 : C 173 : C 174 : IF(IIMPI.NE.30) GOTO 1500 175 : WRITE(IOIMP,*) (TT(I),I=1,NBMOD) 176 : WRITE(IOIMP,*) (TT1(I),I=1,NBMOD) 177 : WRITE(IOIMP,*) (IPOS(I),I=1,NBMOD) 178 : WRITE(IOIMP,*) (IORD(I),I=1,NBMOD) 179 : C 180 : C 181 : C MODIFICATION DE L OBJET SOLUTION 182 : C 183 : 1500 CONTINUE 184 : DO 310 NMOD=1,NBMOD 185 : MMODE=ISOLEN(NMOD) 186 : SEGACT MMODE*MOD 187 : IMMODD(1)=IORD(NMOD) 188 : SEGDES MMODE 189 : 310 CONTINUE 190 : SEGDES MSOLE1,MSOLEN,MSOLUT 191 : SEGSUP TRAV 192 : IPMODE=MSOLUT 193 : C 194 : C MESSAGE D AVERTISSEMENT 195 : C 196 : IF (IIMPI.EQ.2) THEN 197 : WRITE(IOIMP,1000) 198 : 1000 FORMAT(/40X,'ATTENTION OPERATEUR VIBRA OPTION SIMUL', 199 : C /40X,'--------------------------------------', 200 : C/10X,'LE NUMERO DU MODE EST CALCULE A PARTIR DU NOMBRE MODES', 201 : C/10X,' PROPRES INFERIEURS A LA FREQUENCE FOURNIE PAR L UTILI', 202 : C 'SATEUR') 203 : C 204 : * IMPRESSION DU MODE CALCULE: 205 : WRITE (IOIMP,2000) 206 : 2000 FORMAT ('1MODE PROPRE CALCULE:'/' --------------------'//) 206 : CALL ECMODE (IPMODE) 207 : ENDIF 208 : * 209 : C 210 : RETURN 211 : END 212 : 213 : 214 : 215 : 216 :
© Cast3M 2003 - All rights reserved.
Disclaimer