1 : C BASEMD SOURCE AM 08/02/14 21:15:38 6050 2 : SUBROUTINE BASEMD 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C ================================================================== 7 : C C 8 : C C CREATION D UNE BASE MODALE 9 : C C SYNTAXE : B = BASE S L M U V ; 10 : C C B : OBJET DE TYPE BASE MODALE 11 : C C S : OBJET DE TYPE STRUCTURE 12 : C C L : OBJET DE TYPE MATTAC 13 : C C M : OBJET DE TYPE SOLUTION (SOUS TYPE : MODES) 14 : C C U : OBJET DE TYPE SOLUTION (SOUS TYPE : SOLUTIONS STATIQUES) 15 : C C V : OBJET DE TYPE SOLUTION (SOUS TYPE : PSEUMODE) 16 : C C 17 : C C ECRIT PAR FARVACQUE. 18 : C C APPELLE LES SUBROUTINES SUIVANTS: 19 : C C LIRE,ECRIRE,SOLS1,ERREUR(61,130,131,133,134,135,173,226,227) 20 : C ================================================================== 21 : C 22 : -INC SMSOLUT 23 : -INC SMBASEM 24 : -INC SMSTRUC 25 : -INC SMATTAC 26 : -INC CCOPTIO 27 : -INC CCHAMP 28 : -INC CCREEL 29 : -INC SMCOORD 30 : -INC SMELEME 31 : SEGMENT ITRAV(NJONC) 32 : SEGMENT ITRABB(0) 33 : * 34 : PARAMETER ( LNOM1 = 2 ) 35 : CHARACTER*4 NOMOP1(LNOM1) 36 : CHARACTER*8 CTYP 37 : DATA NOMOP1/'PLUS','ROTA'/ 38 : * 39 : * Nouvelle version avec les TABLEs 40 : * 40 : CALL LIRMOT(NOMOP1,LNOM1,IMOT1,0) 41 : IF(IERR.NE.0) RETURN 41 : CALL QUETYP(CTYP,1,IRETOU) 42 : IF (CTYP(1:8).EQ.'TABLE ') THEN 42 : CALL LIRTAB('BASE_MODALE',ITBAS,1,IRETOU) 43 : IF(IERR.NE.0) RETURN 43 : CALL LIRTAB('POINT',ITPTS,1,IRETOU) 44 : IF(IERR.NE.0) RETURN 45 : IPO1 = 0 46 : IPO2 = 0 47 : XANG = XZERO 47 : CALL LIROBJ('POINT ',IPO1,1,IRETOU) 48 : IF(IERR.NE.0) RETURN 49 : IF (IMOT1.EQ.2) THEN 50 : IF (IDIM.EQ.3) THEN 50 : CALL LIROBJ('POINT ',IPO2,1,IRETOU) 51 : IF(IERR.NE.0) RETURN 52 : ENDIF 52 : CALL LIRREE(XANG,1,IRETOU) 53 : IF(IERR.NE.0) RETURN 54 : ENDIF 55 : IF (IMOT1.EQ.0) THEN 55 : CALL ERREUR(498) 56 : RETURN 57 : ELSE 57 : CALL COPBAS(ITBAS,ITPTS,NOMOP1(IMOT1),IPO1,IPO2,XANG) 58 : RETURN 59 : ENDIF 60 : ENDIF 61 : C 62 : NIBST=5 63 : C 64 : C **** LECTURE DE LA STRUCTURE 65 : C 65 : CALL LIROBJ('STRUCTUR',ISTRU0,1,IRETOU) 66 : IF(IERR.NE.0) GO TO 5000 67 : MSTRUC=ISTRU0 68 : SEGACT MSTRUC 69 : NSTRU=LISTRU(/1) 70 : IF(NSTRU.NE.1) THEN 71 : C ON VERIFIE QUE LA STRUCTURE EST IDENTIQUE 72 : MSOSTU=LISTRU(1) 73 : SEGACT MSOSTU 74 : I1=ISRAID 75 : I2=ISMASS 76 : I3=ITYSOU 77 : SEGDES MSOSTU 78 : DO 5 I=2,NSTRU 79 : MSOSTU=LISTRU(I) 80 : SEGACT MSOSTU 81 : IF(ISRAID.NE.I1) GOTO 6 82 : IF(ISMASS.NE.I2) GOTO 6 83 : IF(ITYSOU.NE.I3) GOTO 6 84 : SEGDES MSOSTU 85 : GOTO 5 86 : 6 CONTINUE 87 : SEGDES MSOSTU 87 : CALL ERREUR(226) 88 : C LES SOUS STRUCTURES NE SONT PAS IDENTIQUES 89 : GOTO 5000 90 : 5 CONTINUE 91 : ENDIF 92 : SEGDES MSTRUC 93 : C 94 : C **** LECTURE DU MATTAC 95 : C 95 : CALL LIROBJ('ATTACHE ',IRET,0,IRETOU) 96 : MATTAC=IRET 97 : IF(IRETOU.EQ.0) MATTAC=0 98 : C 99 : C **** LECTURE DES OBJETS SOLUTION 100 : C 101 : IMODE=0 102 : ISOLS=0 103 : IPSMO = 0 103 : 1 CALL LIROBJ('SOLUTION',IRET,0,IRETOU) 104 : IF(IRETOU.EQ.0) GO TO 53 105 : MSOLUT=IRET 106 : SEGACT MSOLUT 107 : C 108 : C **** EST CE UN MODE ? 109 : C 110 : IF(ITYSOL.NE.'MODE ') GO TO 51 111 : IF(IMODE.EQ.0) GO TO 52 112 : MOTERR(1:8)='SOLUTION' 113 : MOTERR(9:15)='MODE' 113 : CALL ERREUR(130) 114 : C MODES DEJA DONNES 115 : SEGDES MSOLUT 116 : GO TO 5000 117 : 52 CONTINUE 118 : IMODE=MSOLUT 119 : SEGACT MSOLUT 120 : MSOLEN=MSOLIS(5) 121 : SEGDES MSOLUT 122 : IF(MSOLEN.NE.0) GO TO 304 123 : MOTERR(1:8)='MODE' 123 : CALL ERREUR(61) 124 : GOTO 5000 125 : 304 CONTINUE 126 : IF(ISOLS.EQ.0) GO TO 1 127 : GO TO 53 128 : 51 CONTINUE 129 : C 130 : C **** EST CE UN SOLSTA ? 131 : C 132 : IF(ITYSOL.NE.'SOLUSTAT') GO TO 54 133 : IF(ISOLS.EQ.0) GO TO 55 134 : MOTERR(1:8)='SOLUTION' 135 : MOTERR(9:16)='SOLUSTAT' 135 : CALL ERREUR(130) 136 : C SOLUTIONS STATIQUES DEJA DONNEES 137 : SEGDES MSOLUT 138 : GO TO 5000 139 : 55 CONTINUE 140 : ISOLS=MSOLUT 141 : SEGDES MSOLUT 142 : IF(IMODE.EQ.0) GO TO 1 143 : GO TO 53 144 : C 145 : C **** EST CE UN PSEUMOD? 146 : C 147 : 54 CONTINUE 148 : IF(ITYSOL.NE.'PSEUMODE') GO TO 954 149 : IF(IPSMO.EQ.0) GO TO 955 150 : MOTERR(1:8)='SOLUTION' 151 : MOTERR(9:16)='PSEUMODE' 151 : CALL ERREUR(130) 152 : C SOLUTIONS STATIQUES DEJA DONNEES 153 : SEGDES MSOLUT 154 : GO TO 5000 155 : 955 CONTINUE 156 : IPSMO=MSOLUT 157 : SEGDES MSOLUT 158 : IF(IMODE.EQ.0) GO TO 1 159 : GO TO 53 160 : 954 CONTINUE 161 : MOTERR(1:8)='SOLUTION' 162 : MOTERR(9:16)=ITYSOL 162 : CALL ERREUR(131) 163 : C ON N ATTEND PAS CE SOUSTYPE DE SOLUTION 164 : SEGDES MSOLUT 165 : GO TO 5000 166 : C 167 : C **** VERIFICATIONS DIVERSES 168 : C 169 : 53 CONTINUE 170 : IF(IMODE.NE.0 . OR . MATTAC.NE.0) GO TO 60 170 : CALL ERREUR(133) 171 : C NI MODE NI LIAISON DANS CETTE BASE MODALE 172 : GO TO 5000 173 : 60 CONTINUE 174 : C 175 : SEGACT MSTRUC 176 : C BOUCLE SUR LES SOUS-BASES 177 : SEGINI ITRABB 178 : DO 66 IBAS=1,NSTRU 179 : SEGINI MSOBAS 180 : ITRABB(**)=MSOBAS 181 : IBSTRM(1)=LISTRU(IBAS) 182 : IBSTRM(2)=0 183 : IBSTRM(3)=0 184 : IBSTRM(4)=MATTAC 185 : IBSTRM(5)=IPSMO 186 : IF(IBAS.EQ.1) THEN 187 : IBSTRM(2)=IMODE 188 : ELSE IF(IMODE.NE.0) THEN 189 : C 190 : C **** DANS LE CAS IDEN, DUPLICATION DES MODES 191 : C 192 : SEGACT MCOORD 193 : MSOLUT=IMODE 194 : SEGACT MSOLUT 195 : MELEME=MSOLIS(3) 196 : SEGACT MELEME 197 : NBELEM=NUM(/2) 198 : NBREF=0 199 : NBNN=1 200 : NBSOUS=0 201 : SEGINI IPT1 202 : ITYPEL=1 203 : MSOSTU=LISTRU(IBAS) 204 : IPOIN=XCOOR(/1)/(IDIM+1) 205 : NBPTS=IPOIN+NBELEM 206 : SEGADJ MCOORD 207 : DO 403 I=1,NBELEM 208 : XCOOR(IPOIN*(IDIM+1)+1)=0. 209 : XCOOR(IPOIN*(IDIM+1)+2)=0. 210 : IF(IDIM.EQ.3) XCOOR(IPOIN*(IDIM+1)+3)=0. 211 : XCOOR(IPOIN*(IDIM+1)+(IDIM+1))=0. 212 : IPOIN=IPOIN+1 213 : IPT1.NUM(1,I)=IPOIN 214 : 403 CONTINUE 215 : NIPO=MSOLIS(/1) 216 : SEGINI MSO1 217 : MSO1.ITYSOL=ITYSOL 218 : DO 404 I=1,NIPO 219 : MSO1.MSOLIS(I)=MSOLIS(I) 220 : MSO1.MSOLIT(I)=MSOLIT(I) 221 : 404 CONTINUE 222 : MSO1.MSOLIS(3)=IPT1 223 : SEGDES MSO1,MSOLUT,MELEME,IPT1 224 : IBSTRM(2)=MSO1 225 : ENDIF 226 : C 227 : C **** BOUCLE SUR LES LIAISONS : ON CHERCHE LES LIAISONS QUI AGISSENT 228 : C **** SUR MSOSTU. MECA, FLUIDE ET DEPI :MJONCT MIS DANS MSOLE1 229 : C **** AUTRES :RIEN 230 : C 231 : IF(MATTAC.EQ.0) GO TO 61 232 : N=0 233 : SEGACT MATTAC 234 : MSOSTU=LISTRU(IBAS) 235 : NSOUMA=LISATT(/1) 236 : DO 70 IA=1,NSOUMA 237 : MSOUMA=LISATT(IA) 238 : SEGACT MSOUMA 239 : NL=IATREL(/1) 240 : DO 72 IB=1,NL 241 : MJONCT=IATREL(IB) 242 : SEGACT MJONCT 243 : NC=ISTRJO(/1) 244 : DO 73 IC=1,NC 245 : IF(ISTRJO(IC).NE.MSOSTU) GO TO 73 246 : IF(ITYATT.NE.'MECA'.AND.ITYATT.NE.'FLUI'.AND.ITYATT.NE.'DEPI') 247 : & GOTO 73 248 : N=N+1 249 : IF(N.EQ.1)SEGINI MSOLE1 250 : IF(N.NE.1)SEGADJ MSOLE1 251 : MSOLE1.ISOLEN(N)=MJONCT 252 : C WRITE(6,4446)MJONCT 253 : C4446 FORMAT(' ********MJONCT=',I6) 254 : 73 CONTINUE 255 : SEGDES MJONCT 256 : 72 CONTINUE 257 : SEGDES MSOUMA 258 : 70 CONTINUE 259 : NJONC=N 260 : C 261 : IF(ISOLS.NE.0) THEN 262 : C 263 : C **** COMPATIBILITE ENTRE LES MJONCT ET LES SOLUTIONS STATIQUES? 264 : C 265 : IF(NJONC.EQ.0) GOTO 900 266 : C INCOMPATIBILITE ENTRE LES SOLSTA ET LES LIAISONS 267 : MSOLUT=ISOLS 268 : SEGACT MSOLUT 269 : MSOLEN=MSOLIS(10) 270 : SEGACT MSOLEN 271 : LTAB=ISOLEN(/1) 272 : IF(LTAB.LT.NJONC) THEN 273 : C INCOMPATIBILITE ENTRE LES SOLSTA ET LES LIAISONS 274 : SEGDES MSOLEN,MSOLUT 275 : GO TO 900 276 : ENDIF 277 : IF(NJONC.LT.LTAB) SEGINI ITRAV 278 : DO 81 J=1,NJONC 279 : MJONCT=MSOLE1.ISOLEN(J) 280 : DO 80 I=1,LTAB 281 : IF(MJONCT.NE.ISOLEN(I)) GO TO 80 282 : IF(NJONC.LT.LTAB) ITRAV(J)=I 283 : GOTO 81 284 : 80 CONTINUE 285 : C INCOMPATIBILITE ENTRE LES SOLSTA ET LES LIAISONS 286 : SEGDES MSOLEN,MSOLUT 287 : IF(NJONC.LT.LTAB) SEGSUP ITRAV 288 : GO TO 900 289 : 81 CONTINUE 290 : SEGDES MSOLEN,MSOLUT 291 : IF(NJONC.LT.LTAB) THEN 292 : C 293 : C CREATION DE L'OBJET SOLUTION STATIQUE REDUIT AUX LIAISONS DU MATTAC 294 : C 295 : MSO1=ISOLS 296 : SEGACT MSO1 297 : MSOLE2=MSO1.MSOLIS(5) 298 : SEGACT MSOLE2 299 : N=NJONC 300 : SEGINI MSOLEN 301 : NBELEM=NJONC 302 : NBNN=1 303 : NBSOUS=0 304 : NBREF=0 305 : SEGINI MELEME 306 : ITYPEL=1 307 : DO 82 IB=1,NJONC 308 : MJONCT=MSOLE1.ISOLEN(IB) 309 : SEGACT MJONCT 310 : IPT1=MJOPOI 311 : SEGACT IPT1 312 : NUM(1,IB)=IPT1.NUM(1,ITRAV(IB)) 313 : ISOLEN(IB)=MSOLE2.ISOLEN(ITRAV(IB)) 314 : SEGDES IPT1,MJONCT 315 : 82 CONTINUE 316 : SEGDES MELEME,MSOLE2,MSOLEN,MSOLE1 317 : SEGSUP ITRAV 318 : NIPO=10 319 : SEGINI MSOLUT 320 : ITYSOL='SOLUSTAT' 321 : DO 83 I=1,NIPO 322 : MSOLIS(I)=0 323 : MSOLIT(I)=0 324 : 83 CONTINUE 325 : MSOLIS(3)=MELEME 326 : MSOLIS(5)=MSOLEN 327 : MSOLIT(5)=2 328 : MSOLIT(10)=14 329 : MSOLIS(10)=MSOLE1 330 : SEGDES MSOLUT 331 : IBSTRM(3)=MSOLUT 332 : ELSE 333 : IBSTRM(3)=ISOLS 334 : SEGSUP MSOLE1 335 : ENDIF 336 : ELSE 337 : C 338 : C *** IL N'Y A PAS DE SOLUTION STATIQUES. S'IL EN FAUT ON VA LES 339 : C *** CALCULER EN APPELANT LE SOUS-PROGRAMME SOLS1 DE L'OPERATEUR SOLS 340 : C 341 : IF(NJONC.NE.0) THEN 342 : KSOSTU=MSOSTU 343 : KSOLE1=MSOLE1 343 : CALL SOLS1(KSOSTU,KSOLE1,KSOLUT) 344 : IF(IERR.NE.0) THEN 345 : SEGSUP MSOLE1 346 : GOTO 900 347 : ENDIF 348 : IBSTRM(3)=KSOLUT 349 : ENDIF 350 : ENDIF 351 : C 352 : C **** SI IL Y A D'AUTRES TYPES DE LIAISONS, ON CREE DES MODES ET DES 353 : C **** SOLUTIONS STATIQUES REDUITS AUX POINTS DE CES DERNIERES LIAISONS 354 : C 355 : IF(IMODE.EQ.0) THEN 356 : C *** OUBLI DES MODES 356 : CALL ERREUR(227) 357 : ENDIF 358 : GOTO 62 359 : C 360 : 900 CONTINUE 361 : MOTERR(1:8)='SOLUSTAT' 362 : MOTERR(9:15)='ATTACHE' 362 : CALL ERREUR(135) 363 : 62 CONTINUE 364 : SEGDES MATTAC 365 : 61 CONTINUE 366 : SEGDES MSOBAS 367 : 66 CONTINUE 368 : SEGDES MSTRUC 369 : N=ITRABB(/1) 370 : IF(N.NE.0) THEN 371 : SEGINI MBASEM 372 : DO 800 NN=1,N 373 : LISBAS(NN)=ITRABB(NN) 374 : 800 CONTINUE 375 : SEGDES MBASEM 375 : CALL ECROBJ('BASEMODA',MBASEM) 376 : ENDIF 377 : SEGSUP ITRABB 378 : 5000 CONTINUE 379 : RETURN 380 : END 381 : 382 : 383 : 384 : 385 :
© Cast3M 2003 - All rights reserved.
Disclaimer