1 : C RIMB SOURCE CHAT 09/10/09 21:24:04 6519 2 : C RIMA SOURCE ANNE 99/12/22 21:35:54 3744 3 : subroutine rimb(MYRIG) 4 : 5 : ******************************************** 6 : * traduction objet rigi en matrik 7 : * ou matrik en rigi 8 : * 9 : ******************************************* 10 : 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8 (A-H,O-Z) 13 : 14 : -INC CCOPTIO 15 : -INC SMELEME 16 : POINTEUR MYMEL.MELEME 17 : -INC SMRIGID 18 : POINTEUR MYRIG.MRIGID 19 : POINTEUR MDESCR.DESCR 20 : POINTEUR MIMAT.xMATRI 21 : * POINTEUR MXMAT.XMATRI 22 : -INC SMLENTI 23 : POINTEUR KRINCP.MLENTI 24 : POINTEUR KRINCD.MLENTI 25 : -INC SMLMOTS 26 : POINTEUR LIPTOT.MLMOTS 27 : POINTEUR LIDTOT.MLMOTS 28 : *INC SMMATRIK 29 : 30 : SEGMENT MATRIK 31 : REAL*8 COEMTK(NMATRI) 32 : INTEGER jRIGEL(NRIGE,NMATRI) 33 : INTEGER KSYM,KMINC,KMINCP,KMINCD,KIZM 34 : INTEGER KISPGT,KISPGP,KISPGD 35 : INTEGER KNTTT,KNTTP,KNTTD 36 : INTEGER KIDMAT(NKID) 37 : INTEGER KKMMT(NKMT) 38 : ENDSEGMENT 39 : POINTEUR MYMTK.MATRIK 40 : 41 : SEGMENT jMATRI 42 : CHARACTER*8 LISPRj(NBME),LISDUb(NBME) 43 : INTEGER LIZAFM(NBSOUS,NBME) 44 : INTEGER KSPGP,KSPGD 45 : ENDSEGMENT 46 : POINTEUR MJMAT.JMATRI 47 : C Stokage matrices elementaires non assemblees (valeurs) 48 : SEGMENT IZAFM 49 : REAL*8 AM(NBEL,NP,MP) 50 : ENDSEGMENT 51 : POINTEUR MIZAFM.IZAFM 52 : C 53 : SEGMENT GMEL 54 : POINTEUR MELS(NMEL).MELEME 55 : ENDSEGMENT 56 : POINTEUR LMLPRI.GMEL 57 : POINTEUR LMLDUA.GMEL 58 : POINTEUR LMELP.GMEL 59 : POINTEUR LMELD.GMEL 60 : POINTEUR MYMELP.MELEME 61 : POINTEUR MYMELD.MELEME 62 : 63 : SEGMENT GJMAT 64 : POINTEUR JMATS(NJMAT).JMATRI 65 : ENDSEGMENT 66 : POINTEUR LJMAT.GJMAT 67 : SEGMENT GIZA 68 : POINTEUR IZAS(NIZA).IZAFM 69 : ENDSEGMENT 70 : POINTEUR LIZA.GIZA 71 : POINTEUR MIZA.IZAFM 72 : C 73 : SEGMENT GLENT 74 : POINTEUR LENTS(NLENT).MLENTI 75 : ENDSEGMENT 76 : POINTEUR LLEPRI.GLENT 77 : POINTEUR LLEDUA.GLENT 78 : POINTEUR LKRPRI.GLENT 79 : POINTEUR LKRDUA.GLENT 80 : POINTEUR MYLNTP.MLENTI 81 : POINTEUR MYLNTD.MLENTI 82 : POINTEUR MYKRP.MLENTI 83 : POINTEUR MYKRD.MLENTI 84 : 85 : 86 : 87 : * 88 : * Déclaration des variables 89 : * 90 : INTEGER NRIG,NRIGEL,NBME,NNOEL,NP,MP 91 : INTEGER KRIGEL,IBME, IP,ID,IP2,ID2 92 : INTEGER NLIGRP,NLIGRD 93 : INTEGER ILIGRP,ILIGRD 94 : INTEGER NPUNIQ,NDUNIQ,NBEL,NBNN 95 : INTEGER IPUNIQ,IDUNIQ,IBEL,IBNN,IEL,IELRIG 96 : INTEGER NPOPQ,NPODQ 97 : REAL*8 COEF,VAL 98 : 99 : CHARACTER*8 TYPE,TYPP 100 : 101 : * 102 : * Passage Rigidité en MATRIK 103 : * 104 : * write(6,*) ' entree dans rimb nrig',nrig 105 : IMPR=0 106 : SEGACT MYRIG 107 : NRIG =MYRIG.IRIGEL(/1) 108 : NRIGEL=MYRIG.IRIGEL(/2) 109 : * Un tests pour voir si on peut faire la conversion 110 : IF (NRIG.EQ.6) THEN 111 : * WRITE(IOIMP,*) 'NRIGE.EQ.6, check the output matrix' 112 : ENDIF 113 : NMATRI=0 114 : NRIGE = 7 115 : NKID=9 116 : NKMT=7 117 : SEGINI MYMTK 118 : * 119 : DO 1 KRIGEL=1,NRIGEL 120 : * D'autres tests pour voir si on peut faire la conversion 121 : IF(MYRIG.IRIGEL(5,KRIGEL).NE.0) THEN 122 : WRITE(IOIMP,*) 'Harmonique de fourier non nulle' 123 : * 19 2 124 : *Option indisponible 124 : CALL ERREUR(19) 125 : ENDIF 126 : IF(MYRIG.IRIGEL(6,KRIGEL).NE.0) THEN 127 : WRITE(IOIMP,*) 'Matrice definie par une inegalite' 127 : CALL ERREUR(19) 128 : ENDIF 129 : COEF =MYRIG.COERIG(KRIGEL) 130 : MYMEL =MYRIG.IRIGEL(1,KRIGEL) 131 : SEGACT MYMEL 132 : NNOEL = MYMEL.NUM(/1) 133 : NEL = MYMEL.NUM(/2) 134 : *** MYMTK.JRIGEL(1,KRIGEL)=MYMEL 135 : *** MYMTK.JRIGEL(2,KRIGEL)=MYMEL 136 : * Analyse du segment descripteur 137 : MDESCR=MYRIG.IRIGEL(3,KRIGEL) 138 : SEGACT MDESCR 139 : NLIGRP=MDESCR.NOELEP(/1) 140 : NLIGRD=MDESCR.NOELED(/1) 141 : * Construction de la liste d'inconnues primales sans doublons 142 : * et du segment de repérage dans cette liste 143 : JGN=4 144 : JGM=NLIGRP 145 : SEGINI LIPTOT 145 : CALL CUNIQ(MDESCR.LISINC,4,NLIGRP, 146 : $ LIPTOT.MOTS,NPUNIQ, 147 : $ IMPR,IRET) 148 : IF (IRET.NE.0) GOTO 9999 149 : JGN=4 150 : JGM=NPUNIQ 151 : SEGADJ,LIPTOT 152 : JG=NLIGRP 153 : SEGINI KRINCP 153 : CALL CREPER(4,NLIGRP,NPUNIQ,MDESCR.LISINC,LIPTOT.MOTS, 154 : $ KRINCP.LECT, 155 : $ IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 157 : * Construction de la liste d'inconnues duales sans doublons 158 : * et du segment de repérage dans cette liste 159 : JGN=4 160 : JGM=NLIGRD 161 : SEGINI LIDTOT 161 : CALL CUNIQ(MDESCR.LISDUA,4,NLIGRD, 162 : $ LIDTOT.MOTS,NDUNIQ, 163 : $ IMPR,IRET) 164 : IF (IRET.NE.0) GOTO 9999 165 : JGN=4 166 : JGM=NDUNIQ 167 : SEGADJ,LIDTOT 168 : JG=NLIGRD 169 : SEGINI KRINCD 169 : CALL CREPER(4,NLIGRD,NDUNIQ,MDESCR.LISDUA,LIDTOT.MOTS, 170 : $ KRINCD.LECT, 171 : $ IMPR,IRET) 172 : IF (IRET.NE.0) GOTO 9999 173 : * Pour chaque inconnue PRIMALE, construction de la liste des noeuds 174 : * (locaux par élément) sur lequel il porte 175 : NLENT=NPUNIQ 176 : SEGINI,LLEPRI 177 : JG=0 178 : SEGINI,LLEPRI.LENTS(*) 179 : DO ILIGRP=1,NLIGRP 180 : IPUNIQ=KRINCP.LECT(ILIGRP) 181 : MYLNTP=LLEPRI.LENTS(IPUNIQ) 182 : MYLNTP.LECT(**)=MDESCR.NOELEP(ILIGRP) 183 : ENDDO 184 : * Suppression des doublons éventuels 185 : DO IPUNIQ=1,NPUNIQ 185 : CALL IUNIQ(LLEPRI.LENTS(IPUNIQ).LECT, 186 : $ LLEPRI.LENTS(IPUNIQ).LECT(/1), 187 : $ LLEPRI.LENTS(IPUNIQ).LECT,NPOPQ, 188 : $ IMPR,IRET) 189 : IF (IRET.NE.0) GOTO 9999 190 : JG=NPOPQ 191 : SEGADJ,LLEPRI.LENTS(IPUNIQ) 192 : ENDDO 193 : * segment de repérage dans cette liste 194 : NLENT=NPUNIQ 195 : SEGINI,LKRPRI 196 : JG=NNOEL 197 : SEGINI,LKRPRI.LENTS(*) 198 : DO IPUNIQ=1,NPUNIQ 198 : CALL RSETXI(LKRPRI.LENTS(IPUNIQ).LECT, 199 : $ LLEPRI.LENTS(IPUNIQ).LECT, 200 : $ LLEPRI.LENTS(IPUNIQ).LECT(/1)) 201 : ENDDO 202 : * Pour chaque inconnue DUALE, construction de la liste des noeuds 203 : * (locaux par élément) sur lequel il porte 204 : NLENT=NDUNIQ 205 : SEGINI,LLEDUA 206 : JG=0 207 : SEGINI,LLEDUA.LENTS(*) 208 : DO ILIGRD=1,NLIGRD 209 : IDUNIQ=KRINCD.LECT(ILIGRD) 210 : MYLNTD=LLEDUA.LENTS(IDUNIQ) 211 : MYLNTD.LECT(**)=MDESCR.NOELED(ILIGRD) 212 : ENDDO 213 : * Suppression des doublons éventuels 214 : DO IDUNIQ=1,NDUNIQ 214 : CALL IUNIQ(LLEDUA.LENTS(IDUNIQ).LECT, 215 : $ LLEDUA.LENTS(IDUNIQ).LECT(/1), 216 : $ LLEDUA.LENTS(IDUNIQ).LECT,NPODQ, 217 : $ IMPR,IRET) 218 : IF (IRET.NE.0) GOTO 9999 219 : JG=NPODQ 220 : SEGADJ,LLEDUA.LENTS(IDUNIQ) 221 : ENDDO 222 : * segment de repérage dans cette liste 223 : NLENT=NDUNIQ 224 : SEGINI,LKRDUA 225 : JG=NNOEL 226 : SEGINI,LKRDUA.LENTS(*) 227 : DO IDUNIQ=1,NDUNIQ 227 : CALL RSETXI(LKRDUA.LENTS(IDUNIQ).LECT, 228 : $ LLEDUA.LENTS(IDUNIQ).LECT, 229 : $ LLEDUA.LENTS(IDUNIQ).LECT(/1)) 230 : ENDDO 231 : * Pour chaque inconnue PRIMALE, construction de l'objet géométrie 232 : NMEL=NPUNIQ 233 : SEGINI,LMLPRI 234 : DO IPUNIQ=1,NPUNIQ 235 : NBNN=LLEPRI.LENTS(IPUNIQ).LECT(/1) 236 : NBELEM=NEL 237 : NBSOUS=0 238 : NBREF=0 239 : SEGINI,LMLPRI.MELS(IPUNIQ) 240 : DO IEL=1,NEL 241 : DO IBNN=1,NBNN 242 : MYMELP=LMLPRI.MELS(IPUNIQ) 243 : MYLNTP=LLEPRI.LENTS(IPUNIQ) 244 : MYMELP.NUM(IBNN,IEL)= 245 : $ MYMEL.NUM(MYLNTP.LECT(IBNN),IEL) 246 : ENDDO 247 : ENDDO 248 : SEGDES,LMLPRI.MELS(IPUNIQ) 249 : ENDDO 250 : * Pour chaque inconnue DUALE, construction de l'objet géométrie 251 : NMEL=NDUNIQ 252 : SEGINI,LMLDUA 253 : DO IDUNIQ=1,NDUNIQ 254 : NBNN=LLEDUA.LENTS(IDUNIQ).LECT(/1) 255 : NBELEM=NEL 256 : NBSOUS=0 257 : NBREF=0 258 : SEGINI,LMLDUA.MELS(IDUNIQ) 259 : DO IEL=1,NEL 260 : DO IBNN=1,NBNN 261 : MYMELD=LMLDUA.MELS(IDUNIQ) 262 : MYLNTD=LLEDUA.LENTS(IDUNIQ) 263 : MYMELD.NUM(IBNN,IEL)= 264 : $ MYMEL.NUM(MYLNTD.LECT(IBNN),IEL) 265 : ENDDO 266 : ENDDO 267 : SEGDES,LMLDUA.MELS(IDUNIQ) 268 : ENDDO 269 : * 270 : * Initialisation des objets que l'on concatènera dans MATRIK 271 : * 272 : NMAT=NPUNIQ*NDUNIQ 273 : NMEL=NMAT 274 : SEGINI,LMELP 275 : SEGINI,LMELD 276 : NJMAT=NMAT 277 : SEGINI,LJMAT 278 : NBME=1 279 : NBSOUS=1 280 : SEGINI,LJMAT.JMATS(*) 281 : NIZA=NMAT 282 : SEGINI,LIZA 283 : DO IPUNIQ=1,NPUNIQ 284 : DO IDUNIQ=1,NDUNIQ 285 : * Initialisation de LIZA 286 : IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ 287 : NBEL=NEL 288 : NP=LLEPRI.LENTS(IPUNIQ).LECT(/1) 289 : MP=LLEDUA.LENTS(IDUNIQ).LECT(/1) 290 : SEGINI,LIZA.IZAS(IMAT) 291 : * Initialisation de LJMAT 292 : MJMAT=LJMAT.JMATS(IMAT) 293 : MJMAT.LISPRJ(1)=LIPTOT.MOTS(IPUNIQ)//' ' 294 : MJMAT.LISDUB(1)=LIDTOT.MOTS(IDUNIQ)//' ' 295 : MJMAT.LIZAFM(1,1)=LIZA.IZAS(IMAT) 296 : * Initialisation de LMELP et LMELD 297 : LMELP.MELS(IMAT)=LMLPRI.MELS(IPUNIQ) 298 : LMELD.MELS(IMAT)=LMLDUA.MELS(IDUNIQ) 299 : ENDDO 300 : ENDDO 301 : * 302 : * Boucle sur les matrices élémentaires de MYRIG 303 : * et recopie des valeurs dans les IZAS de LIZA 304 : * 305 : MIMAT=MYRIG.IRIGEL(4,KRIGEL) 306 : SEGACT MIMAT 307 : NELRIG=MIMAT.re(/3) 308 : DO IELRIG=1,NELRIG 309 : * MXMAT=MIMAT.IMATTT(IELRIG) 310 : * SEGACT MXMAT 311 : DO ILIGRP=1,NLIGRP 312 : IPUNIQ=KRINCP.LECT(ILIGRP) 313 : IP=MDESCR.NOELEP(ILIGRP) 314 : MYKRP=LKRPRI.LENTS(IPUNIQ) 315 : DO ILIGRD=1,NLIGRD 316 : IDUNIQ=KRINCD.LECT(ILIGRD) 317 : ID=MDESCR.NOELED(ILIGRD) 318 : MYKRD=LKRDUA.LENTS(IDUNIQ) 319 : IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ 320 : MIZA=LIZA.IZAS(IMAT) 321 : IBEL=IELRIG 322 : IP2=MYKRP.LECT(IP) 323 : ID2=MYKRD.LECT(ID) 324 : VAL=MIMAT.RE(ILIGRD,ILIGRP,ielrig) 325 : MIZA.AM(IBEL,IP2,ID2)=VAL*COEF 326 : ENDDO 327 : ENDDO 328 : * SEGDES MXMAT 329 : ENDDO 330 : SEGDES MIMAT 331 : SEGDES,LIZA.IZAS(*) 332 : SEGSUP,LIZA 333 : SEGDES,LJMAT.JMATS(*) 334 : * 335 : * Concaténation des valeurs dans l'objet MATRIK 336 : * 337 : NMATAV=MYMTK.JRIGEL(/2) 338 : NMATAP=NMATAV+NMAT 339 : NMATRI=NMATAP 340 : NRIGE = 7 341 : NKID=9 342 : NKMT=7 343 : SEGADJ,MYMTK 344 : DO IMAT=1,NMAT 345 : MYMTK.JRIGEL(1,NMATAV+IMAT)=LMELP.MELS(IMAT) 346 : MYMTK.JRIGEL(2,NMATAV+IMAT)=LMELD.MELS(IMAT) 347 : MYMTK.JRIGEL(4,NMATAV+IMAT)=LJMAT.JMATS(IMAT) 348 : MYMTK.JRIGEL(7,NMATAV+IMAT)=3 349 : ENDDO 350 : SEGSUP,LJMAT 351 : SEGSUP,LMELD 352 : SEGSUP,LMELP 353 : SEGSUP,LMLDUA 354 : SEGSUP,LMLPRI 355 : SEGSUP,LKRDUA.LENTS(*) 356 : SEGSUP,LKRDUA 357 : SEGSUP,LLEDUA.LENTS(*) 358 : SEGSUP,LLEDUA 359 : SEGSUP,LKRPRI.LENTS(*) 360 : SEGSUP,LKRPRI 361 : SEGSUP,LLEPRI.LENTS(*) 362 : SEGSUP,LLEPRI 363 : SEGSUP KRINCP 364 : SEGSUP LIDTOT 365 : SEGSUP KRINCD 366 : SEGSUP LIPTOT 367 : SEGDES MDESCR 368 : SEGDES MYMEL 369 : 1 CONTINUE 370 : SEGDES MYMTK 371 : SEGDES MYRIG 371 : CALL ECROBJ('MATRIK',MYMTK) 372 : RETURN 373 : * 374 : * Error handling 375 : * 376 : 9999 CONTINUE 377 : WRITE(IOIMP,*) 'An error was detected in subroutine rima' 378 : RETURN 379 : END 380 : 381 : 382 : 383 : 384 : 385 : 386 : 387 :
© Cast3M 2003 - All rights reserved.
Disclaimer