1 : C RICROI SOURCE CHAT 11/03/16 21:30:41 6902 2 : SUBROUTINE RICROI(modsta,ir2,irig) 3 : *--calcul termes croisés 'STATIQUE' et/ou 'MODAL' 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : -INC CCOPTIO 7 : -INC CCREEL 8 : -INC SMRIGID 9 : -INC SMCHAML 10 : -INC SMELEME 11 : -INC SMLMOTS 12 : -INC SMMODEL 13 : c 14 : segment modsta 15 : integer pimoda(nmoda),pistat(nstat) 16 : integer ivmoda(nmoda),ivstat(nstat) 17 : endsegment 18 : CHARACTER*4 lesinc(7),lesdua(7),mot2 19 : DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/ 20 : DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/ 21 : 22 : ir2 = 0 23 : nstat = pistat(/1) 24 : nmoda = pimoda(/1) 25 : 26 : jgn = 4 27 : jgm = 6 28 : segini mlmots 29 : iinc = mlmots 30 : do igm = 1,jgm 31 : mots(igm) = lesinc(igm) 32 : enddo 33 : segini mlmots 34 : idua = mlmots 35 : do igm= 1,jgm 36 : mots(igm) = lesdua(igm) 37 : enddo 38 : 39 : nelrig = 100 40 : * 'STATIQUE'/'STATIQUE' : 1 * 'STATIQUE'/'MODAL' : 2 41 : nelri1 = nelrig 42 : nelri2 = nelrig 43 : kelri1 = 0 44 : kelri2 = 0 45 : nligrd = 2 46 : nligrp = 2 47 : segini xmatr1,xmatr2 48 : NBELEM = nelrig 49 : NBNN = 2 50 : NBSOUS = 0 51 : NBREF = 0 52 : SEGINI IPT1,IPT2 53 : IPT1.ITYPEL=27 54 : IPT2.ITYPEL=27 55 : NBELE1 = NELRI1 56 : NBELE2 = NELRI2 57 : * 58 : * 59 : DO is = 1,nstat 60 : 61 : imodel = pistat(is) 62 : segact imodel 63 : ipt4 = imamod 64 : segact ipt4 64 : if (ipt4.num(/1).ne.1) call erreur(5) 65 : nbelem = ipt4.num(/2) 66 : * en principe on ne devrait pas trop boucler 67 : do ib = 1,nbelem 68 : if (nbelem.gt.1) then 69 : do ib1 = ib+1 , nbelem 70 : iv1 = ivstat(is) 71 : iv2 = ivstat(is) 71 : call ricro1(iv1,iv2,ib,ib1,'STAT',irig,iinc,idua,xr1) 72 : if (dabs(xr1).lt.xspeti) goto 21 73 : kelri1 = kelri1 + 1 74 : * segini xmatri 75 : xmatr1.re(2,1,kelri1) = xr1 76 : xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1) 77 : * imatr1.imattt(kelri1) = xmatri 78 : * cree segment ib- ib1 79 : ipt1.num(1,kelri1) = ipt4.num(1,ib) 80 : ipt1.num(2,kelri1) = ipt4.num(1,ib1) 81 : if (kelri1.eq.nelri1) then 82 : nelrig = nelri1 + 100 83 : nelri1 = nelrig 84 : segadj xmatr1 85 : nbelem = nelrig 86 : segadj ipt1 87 : NBELE1 = NELRI1 88 : endif 89 : 21 continue 90 : enddo 91 : endif 92 : 93 : 94 : IF (IS.LT.NSTAT) THEN 95 : DO is2 = is + 1 ,nstat 96 : imode2 = pistat(is2) 97 : segact imode2 98 : ipt5 = imode2.imamod 99 : segact ipt5 99 : if (ipt5.num(/1).ne.1) call erreur(6) 100 : nbele2 = ipt5.num(/2) 101 : do ib2 = 1,nbele2 102 : iv1 = ivstat(is) 103 : iv2 = ivstat(is2) 103 : call ricro1(iv1,iv2,ib,ib2,'STAT',irig,iinc,idua,xr1) 104 : if (dabs(xr1).lt.xspeti) goto 22 105 : kelri1 = kelri1 + 1 106 : * segini xmatri 107 : xmatr1.re(2,1,kelri1) = xr1 108 : xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1) 109 : * imatr1.imattt(kelri1) = xmatri 110 : * cree segment ib- ib2 111 : ipt1.num(1,kelri1) = ipt4.num(1,ib) 112 : ipt1.num(2,kelri1) = ipt5.num(1,ib2) 113 : if (kelri1.eq.nelri1) then 114 : nelrig = nelri1 + 100 115 : nelri1 = nelrig 116 : segadj xmatr1 117 : nbelem = nelrig 118 : segadj ipt1 119 : NBELE1 = NELRI1 120 : endif 121 : 22 continue 122 : enddo 123 : segdes ipt5,imode2 124 : ENDDO 125 : ENDIF 126 : 127 : * 128 : 129 : DO im = 1, nmoda 130 : imode1 = pimoda(im) 131 : segact imode1 132 : ipt3 = imode1.imamod 133 : segact ipt3 133 : if (ipt3.num(/1).ne.1) call erreur(7) 134 : nbele3 = ipt3.num(/2) 135 : do ib3 = 1,nbele3 136 : iv1 = ivstat(is) 137 : iv2 = ivmoda(im) 137 : call ricro1(iv1,iv2,ib,ib3,'MODA',irig,iinc,idua,xr1) 138 : if (dabs(xr1).lt.xspeti) goto 23 139 : kelri2 = kelri2 + 1 140 : * segini xmatri 141 : xmatr2.re(2,1,kelri2) = xr1 142 : xmatr2.re(1,2,kelri2) = xmatr2.re(2,1,kelri2) 143 : * imatr2.imattt(kelri2) = xmatri 144 : * cree segment ib- ib3 145 : ipt2.num(1,kelri2) = ipt3.num(1,ib3) 146 : ipt2.num(2,kelri2) = ipt4.num(1,ib) 147 : if (kelri2.eq.nelri2) then 148 : nelrig = nelri2 + 100 149 : nelri2 = nelrig 150 : segadj xmatr2 151 : nbelem = nelrig 152 : segadj ipt2 153 : NBELE2 = NELRI2 154 : endif 155 : 23 continue 156 : enddo 157 : segdes ipt3,imode1 158 : 159 : ENDDO 160 : enddo 161 : 162 : segdes ipt4,imodel 163 : ENDDO 164 : 165 : 100 continue 166 : NRIGE = 8 167 : NRIGEL = 1 168 : irstat = 0 169 : irmoda = 0 170 : if (nstat.gt.1) then 171 : nbelem = kelri1 172 : SEGADJ IPT1 173 : NELRIG=NBELEM 174 : SEGADJ xMATR1 175 : SEGINI DESCR 176 : NOELEP(1)=1 177 : NOELEP(2)=2 178 : NOELED(1)=1 179 : NOELED(2)=2 180 : LISINC(1)='BETA' 181 : LISINC(2)='BETA' 182 : LISDUA(1)='FBET' 183 : LISDUA(2)='FBET' 184 : SEGDES DESCR 185 : segini mrigid 186 : irstat = mrigid 187 : irigel(1,1) = ipt1 188 : irigel(3,1) = descr 189 : IRIGEL(4,1) = xMATR1 190 : IFORIG = IFOMOD 191 : COERIG(1) = 1.D0 192 : IMGEO1 = 0 193 : IMGEO2 = 0 194 : ICHOLE = 0 195 : ISUPEQ = 0 196 : if (irig.eq.1) then 197 : MTYMAT = 'MASSE ' 198 : elseif (irig.eq.2) then 199 : MTYMAT = 'RIGIDITE' 200 : endif 201 : * 202 : IRIGEL(2,1) = 0 203 : IRIGEL(5,1) = NIFOUR 204 : IRIGEL(6,1) = 0 205 : endif 206 : 207 : if (nmoda.gt.0) then 208 : nbelem = kelri2 209 : SEGADJ IPT2 210 : NELRIG=NBELEM 211 : SEGADJ xMATR2 212 : SEGINI DESCR 213 : NOELEP(1)=1 214 : NOELEP(2)=2 215 : NOELED(1)=1 216 : NOELED(2)=2 217 : LISINC(1)='ALFA' 218 : LISINC(2)='BETA' 219 : LISDUA(1)='FALF' 220 : LISDUA(2)='FBET' 221 : SEGDES DESCR 222 : segini mrigid 223 : irmoda = mrigid 224 : irigel(1,1) = ipt2 225 : irigel(3,1) = descr 226 : IRIGEL(4,1) = xMATR2 227 : IFORIG = IFOMOD 228 : COERIG(1) = 1.D0 229 : IMGEO1 = 0 230 : IMGEO2 = 0 231 : ICHOLE = 0 232 : ISUPEQ = 0 233 : if (irig.eq.1) then 234 : MTYMAT = 'MASSE ' 235 : elseif (irig.eq.2) then 236 : MTYMAT = 'RIGIDITE' 237 : endif 238 : * 239 : IRIGEL(2,1) = 0 240 : IRIGEL(5,1) = NIFOUR 241 : IRIGEL(6,1) = 0 242 : endif 243 : 244 : if (irmoda.eq.0) then 245 : ir2 = irstat 246 : else if (irstat.eq.0) then 247 : ir2 = irmoda 248 : else 248 : call fusrig(irstat,irmoda, ir2) 249 : endif 250 : 251 : mlmots = iinc 252 : segsup mlmots 253 : mlmots = idua 254 : segsup mlmots 255 : 256 : RETURN 257 : END 258 : 259 : 260 :
© Cast3M 2003 - All rights reserved.
Disclaimer