1 : C COML11 SOURCE KICH 12/08/06 21:15:11 7460 2 : 3 : SUBROUTINE COML11(iqmod,wrk52,wrk53,ib,igau, itruli,iretou) 4 : 5 : IMPLICIT REAL*8(a-h,o-z) 6 : IMPLICIT INTEGER(I-N) 7 : 8 : -INC CCOPTIO 9 : -INC CCREEL 10 : * segment deroulant le mcheml 11 : -INC DECHE 12 : -INC SMCHPOI 13 : -INC SMELEME 14 : -INC SMLENTI 15 : -INC SMLREEL 16 : -INC SMMODEL 17 : *------------------------------------------------------------- 18 : * MODELES DE LIAISONS autres que DYNE 19 : *------------------------------------------------------------- 20 : ** segment sous-structures dynamiques 21 : segment struli 22 : integer itlia,itbmod,momoda, mostat,itmail,molia 23 : integer ldefo(np1),lcgra(np1),lsstru(np1) 24 : integer nsstru,nndefo,nliab,nsb,na2,idimb 25 : integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas 26 : INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib 27 : * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0) 28 : INTEGER ICHAIN 29 : endsegment 30 : 31 : SEGMENT,MTQ 32 : REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) 33 : REAL*8 WEXT(NA1,2),WINT(NA1,2) 34 : ENDSEGMENT 35 : 36 : SEGMENT,MPREF 37 : INTEGER IPOREF(NPREF) 38 : ENDSEGMENT 39 : POINTEUR MPRE1.MPREF 40 : * 41 : CHARACTER*4 mmcc 42 : 43 : imodel = iqmod 44 : struli = itruli 45 : 46 : IF (CMATEE.eq.'NEWMOD') THEN 47 : 48 : xjeu = valmat(1) 49 : xexce = 0.d0 50 : if (valmat(/1).gt.1) then 51 : xexce = valmat(2) 52 : xmu = valmat(3) 53 : mmode2 = int(valmat(4)) 54 : endif 55 : 56 : xdelt = tempf - temp0 57 : if (xdelt.eq.0.) then 58 : * write(6,*) 'utilisation inappropriée' 58 : call erreur(21) 59 : return 60 : endif 61 : nexo = exova0(/1) 62 : do ix = 1,nexo 63 : if (nomexo(ix).eq.'MASS') then 64 : xmass0 = exova0(ix) 65 : endif 66 : if (nomexo(ix).eq.'FREQ') then 67 : omeg0 = exova0(ix)*2.*xpi 68 : endif 69 : if (nomexo(ix).eq.'VALF') then 70 : alpoin0 = exova0(ix) 71 : endif 72 : enddo 73 : * vitesse algo Newmark 74 : unsurh = 1./xdelt 75 : zdept = deplf(1) - depl0(1) 76 : yviti = (2.d0*unsurh*zdept) - alpoin0 77 : 78 : xk0 = omeg0 * omeg0 * xmass0 79 : * applique correction Newmark, voir Verpeaux Charras 80 : depchoc = 0.d0 81 : if (xjeu.gt.0) then 82 : if ((deplf(1) - xexce).ge.((1.d0 - xzprec)*xjeu)) then 83 : depchoc = xjeu + xexce 84 : endif 85 : else if (xjeu.lt.0) then 86 : if ((deplf(1) - xexce).le.((1.d0 - xzprec)*xjeu)) then 87 : depchoc = xjeu + xexce 88 : endif 89 : endif 90 : if (depchoc.ne.0.d0) then 91 : xreac = (xk0 + (xmass0*4.d0/xdelt/xdelt))* 92 : &(depchoc - depl0(1)) - forcf(1) - forc0(1) 93 : &+ (2.d0*xk0*depl0(1)) - (4.d0*xmass0*alpoin0/xdelt) 94 : 95 : deltaer = xreac * (depchoc - depl0(1)) / 2.d0 96 : 97 : upoint0 = (2.d0*(depchoc -depl0(1))/xdelt) - alpoin0 98 : xb = xreac * xdelt * upoint0 99 : xa = xdelt*xdelt*xreac*xreac/2.d0/xmass0 100 : xdelta = xb*xb - xa*deltaer*4.d0 101 : if (xdelta.lt.0.) then 101 : call erreur(21) 102 : return 103 : endif 104 : r_z = sqrt(xdelta) 105 : xlambc1 = (-xb + r_z)/(2.d0*xa) 106 : xlambc2 = (-xb - r_z)/(2.d0*xa) 107 : 108 : alpoinc1 = xlambc1*xdelt*xreac/xmass0 109 : alpoinc2 = xlambc2*xdelt*xreac/xmass0 110 : 111 : if(((upoint0+alpoinc1)*xreac).gt.0.) then 112 : xcvit = alpoinc1 113 : elseif(((upoint0+alpoinc2)*xreac).gt.0.) then 114 : xcvit = alpoinc2 115 : else 116 : xcvit = 0.d0 117 : endif 118 : 119 : NC = 2 120 : xreac = xreac * (-1.d0) 121 : else 122 : xreac = 0.d0 123 : xcvit = 0.d0 124 : varf(1) = 0.d0 125 : return 126 : endif 127 : 128 : 129 : meleme = itmail 130 : segact meleme 131 : if (lisous(/1).eq.0) then 132 : ipmmod = itmail 133 : ipmsta = 0 134 : else 135 : ipmmod = lisous(1) 136 : ipmsta = lisous(2) 137 : endif 138 : segdes meleme 139 : meleme = ipmail 140 : segact meleme 141 : ipt1 = ipmmod 142 : segact ipt1 143 : mmcc = ' ' 144 : do ijn =1,ipt1.num(/2) 145 : if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FALF' 146 : enddo 147 : if (mmcc.ne.'FALF') then 148 : ipt1 = ipmsta 149 : segact ipt1 150 : do ijn =1,ipt1.num(/2) 151 : if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FBET' 152 : enddo 153 : endif 154 : 155 : NSOUPO = 1 156 : NAT=1 157 : SEGINI,MCHPOI 158 : IPCHPO = MCHPOI 159 : MTYPOI = 'FLIAISONS' 160 : IFOPOI = IFOUR 161 : * nature diffuse 162 : JATTRI(1) = 1 163 : nmost0 = 0 164 : KIPCHP = 0 165 : SEGINI,MSOUPO 166 : KIPCHP = KIPCHP + 1 167 : IPCHP(KIPCHP) = MSOUPO 168 : NOCOMP(1) = mmcc 169 : NOHARM(1) = NIFOUR 170 : NBNN = 1 171 : NBELEM = 1 172 : NBSOUS = 0 173 : NBREF = 0 174 : SEGINI IPT2 175 : IPT2.ITYPEL = 1 176 : IPT2.NUM(1,1) = num(igau,ib) 177 : segdes ipt2 178 : IGEOC = ipt2 179 : N = 1 180 : SEGINI,MPOVAL 181 : IPOVAL = MPOVAL 182 : vpocha(1,1) = xreac 183 : 184 : if(NC.eq.2) then 185 : NOCOMP(2) = mmcc 186 : NOCOMP(2)(1:1) = 'V' 187 : NOHARM(2) = NIFOUR 188 : vpocha(1,2) = xcvit + yviti 189 : endif 190 : SEGDES,MPOVAL,MSOUPO 191 : 192 : varf(1) = IPCHPO 193 : 194 : * avec frottement 195 : 196 : if (xmu.gt.0. .and.mmode2.gt.0) then 197 : mpref = kpref 198 : npref = iporef(/1) 199 : segini mpre1 200 : mtq = ktq 201 : segact mmode2 202 : nsoupo = 1 + mmode2.kmodel(/1) 203 : segadj mchpoi 204 : do im2 = 1, mmode2.kmodel(/1) 205 : imode2 = mmode2.kmodel(im2) 206 : segact imode2 207 : nomid = lnomid(2) 208 : segact nomid 209 : NC = lesobl(/2) + lesfac(/2) 210 : iptu = imode2.imamod 210 : call change(iptu,1) 211 : ipt3 = iptu 212 : segact ipt3 213 : N = ipt3.num(/2) 214 : SEGINI,MPOVAL 215 : do 187 in = 1,N 216 : if (ipt3.num(1,in).eq.num(ib,igau)) then 217 : * write(6,*) 'données erronnées' 217 : call erreur(21) 218 : return 219 : endif 220 : do lf = 1,npref 221 : if (ipt3.num(1,in).eq.iporef(lf)) then 222 : mpre1.iporef(lf) = mpre1.iporef(lf) + 1 223 : if (mpre1.iporef(lf).gt.1) then 224 : * write(6,*) 'données erronnées' 224 : call erreur(21) 225 : return 226 : endif 227 : do jj = 1,NC 228 : if (q2(lf,2).ne.0.d0) then 229 : vpocha(in,jj) = (-1.d0)*q2(lf,2)/dabs(q2(lf,2)) 230 : else 231 : vpocha(in,jj) = 0.d0 232 : endif 233 : enddo 234 : goto 187 235 : endif 236 : enddo 237 : * write(6,*)' ne fait pas partie du modele' 237 : call erreur(21) 238 : return 239 : 187 continue 240 : * 241 : SEGINI,MSOUPO 242 : KIPCHP = KIPCHP + 1 243 : IPCHP(KIPCHP) = MSOUPO 244 : ncobl = lesobl(/2) 245 : do jj = 1,ncobl 246 : NOCOMP(jj) = lesobl(jj) 247 : NOHARM(jj) = NIFOUR 248 : enddo 249 : if (lesfac(/2).gt.0) then 250 : do jj = 1,lesfac(/2) 251 : NOCOMP(ncobl + jj) = lesfac(jj) 252 : NOHARM(ncobl + jj) = NIFOUR 253 : enddo 254 : endif 255 : IGEOC = ipt3 256 : IPOVAL = MPOVAL 257 : * 258 : do ii = 1,N 259 : do jj = 1, NC 260 : vpocha(ii,jj) = vpocha(ii,jj)*xmu * dabs(xreac) 261 : enddo 262 : enddo 263 : 264 : SEGDES,MPOVAL,MSOUPO,imode2 265 : enddo 266 : segdes mmode2 267 : endif 268 : 269 : segdes MCHPOI 270 : varf(1) = IPCHPO 271 : 272 : ENDIF 273 : 274 : RETURN 275 : END 276 : 277 : 278 :
© Cast3M 2003 - All rights reserved.
Disclaimer