1 : C PSEVO1 SOURCE FANDEUR 10/12/14 21:18:57 6812 2 : 3 : SUBROUTINE PSEVO1(IMODE,IPSMO,IBOO,IPX,ILEX,ICHAR,ICONT) 4 : 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : 8 : ************************************************************************ 9 : * 10 : * P S E V O 1 11 : * ----------- 12 : * 13 : * FONCTION: 14 : * --------- 15 : * 16 : * AJOUTE LA CONTRIBUTION DES MODES NEGLIGES 17 : * POUR LES DEPLACEMENTS SI ICONT=0 18 : * POUR LES CONTRAINTES SI ICONT=1 19 : * 20 : * MODULES UTILISES: 21 : * ----------------- 22 : * 23 : -INC CCOPTIO 24 : -INC SMATTAC 25 : -INC SMCHARG 26 : -INC SMCHPOI 27 : -INC SMELEME 28 : -INC SMLREEL 29 : -INC SMSOLUT 30 : * 31 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 32 : * ----------- 33 : * 34 : * IMODE (E) OBJET SOLUTION DE SOUS-TYPE MODE. 35 : * IPSMO (E) OBJET SOLUTION DE SOUS-TYPE PSEUMODE. 36 : * IBOO (E) POINTEUR SUR LE SEGMENT NUMOO. 37 : * (S) POINTEUR SUR LE SEGMENT NUMOO. 38 : * IPX (E) POINTEUR SUR LE LISTREEL. 39 : * ILEX (E) CONTIENT LES FORCES DE LIAISON AUX TEMPS DEMANDES. 40 : * ICHAR (E) POINTEUR SUR LE CHARGEMENT. 41 : * 42 : SEGMENT NUMOO 43 : INTEGER NUMO(N),KLIST(N) 44 : CHARACTER*4 NUDDL(N) 45 : ENDSEGMENT 46 : * 47 : * VARIABLES: 48 : * ---------- 49 : * 50 : CHARACTER*4 COMP,COMP2,MONTYP,DIRECT 51 : PARAMETER (TOLER = 1.D-6) 52 : * 53 : * 54 : * AUTEUR, DATE DE CREATION: 55 : * ------------------------- 56 : * 57 : * LIONEL VIVAN SEPTEMBRE 1988 58 : * 59 : * LANGAGE: 60 : * -------- 61 : * 62 : * ESOPE + FORTRAN77 63 : * 64 : ************************************************************************ 65 : * 66 : IF (ICHAR.EQ.0 .AND. ILEX.EQ.0) THEN 66 : CALL ERREUR(430) 67 : RETURN 68 : ENDIF 69 : * 70 : NUMOO = IBOO 71 : SEGACT NUMOO 72 : NP = NUMO(/1) 73 : DO 2 I = 1,NP 74 : MLREE3 = KLIST(I) 75 : SEGACT MLREE3 76 : 2 CONTINUE 77 : * 78 : MLREEL= IPX 79 : SEGACT MLREEL 80 : LDIM = PROG(/1) 81 : * 82 : IF (ICHAR.NE.0) THEN 83 : MCHARG = ICHAR 84 : SEGACT MCHARG 85 : NCH = KCHARG(/1) 86 : ENDIF 87 : * 88 : MSOLUT = IPSMO 89 : SEGACT MSOLUT 90 : * 91 : MSOLEN = MSOLIS(10) 92 : SEGACT MSOLEN 93 : NPS = ISOLEN(/1) 94 : * 95 : IF (ICONT.EQ.0) MSOLE1 = MSOLIS(5) 96 : IF (ICONT.EQ.1) MSOLE1 = MSOLIS(6) 97 : SEGACT MSOLE1 98 : * 99 : IF (ILEX.NE.0) THEN 100 : MSOLE2 = ILEX 101 : SEGACT MSOLE2 102 : ENDIF 103 : * 104 : DO 10 IP = 1,NPS 105 : MJONCT = ISOLEN(IP) 106 : SEGACT MJONCT 107 : MONTYP = MJOTYP 108 : * 109 : * PSEUDO-MODE D'UNE STRUCTURE MULTISUPPORTEE 110 : * 111 : IF (MONTYP.EQ.'DEPL') THEN 112 : IF (ICHAR.EQ.0) THEN 113 : SEGDES MJONCT 114 : GOTO 10 115 : ENDIF 116 : ICHM = IPCHJO(1) 117 : * RECHERCHE DU CHARGEMENT 118 : DO 12 IC = 1,NCH 119 : ICHARG = KCHARG(IC) 120 : SEGACT ICHARG 121 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT' 122 : & .OR.CHALIE(IC).NE.'LIE ') THEN 123 : SEGDES ICHARG 124 : GOTO 12 125 : ENDIF 126 : ICHC = ICHPO1 127 : IF (ICHC.EQ.ICHM) THEN 128 : * ON A TROUVE LE CHARGEMENT 129 : GOTO 100 130 : ENDIF 131 : SEGDES ICHARG 132 : 12 CONTINUE 133 : * 134 : * MANQUE LE CHARGEMENT POUR LE PSEUDO-MODE 135 : * 136 : INTERR(1) = IP 136 : CALL ERREUR(428) 137 : SEGDES MJONCT 138 : GOTO 10 139 : * 140 : * PSEUDO-MODE D'UNE FORCE CONCENTREE 141 : * 142 : ELSE IF (MONTYP.EQ.'FORC') THEN 143 : IF (ICHAR.EQ.0) THEN 144 : SEGDES MJONCT 145 : GOTO 10 146 : ENDIF 147 : ICHM = IPCHJO(1) 148 : * RECHERCHE DU CHARGEMENT 149 : DO 22 IC = 1,NCH 150 : ICHARG = KCHARG(IC) 151 : SEGACT ICHARG 152 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT' 153 : & .OR.CHALIE(IC).NE.'LIE ') THEN 154 : SEGDES ICHARG 155 : GOTO 22 156 : ENDIF 157 : ICHC = ICHPO1 158 : IF (ICHC.EQ.ICHM) THEN 159 : * ON A TROUVE LE CHARGEMENT 160 : GOTO 100 161 : ENDIF 162 : SEGDES ICHARG 163 : 22 CONTINUE 164 : * 165 : * IL N'Y A PAS DE CHARGEMENT POUR CE TYPE DE PSEUDO-MODE 166 : * 167 : INTERR(1) = IP 167 : CALL ERREUR(428) 168 : SEGDES MJONCT 169 : GOTO 10 170 : * 171 : * PSEUDO-MODE D'UNE EXCITATION SISMIQUE D'ENSEMBLE 172 : * 173 : ELSE IF (MONTYP.EQ.'SEIS') THEN 174 : IF (ICHAR.EQ.0) THEN 175 : SEGDES MJONCT 176 : GOTO 10 177 : ENDIF 178 : DIRECT = MJODDL 179 : IF (DIRECT.EQ.'UX ') THEN 180 : IPLAC = 3 181 : ELSE IF (DIRECT.EQ.'UY ') THEN 182 : IPLAC = 4 183 : ELSE 184 : IPLAC = 5 185 : ENDIF 186 : MSO1 = IMODE 187 : SEGACT MSO1 188 : MSOLE2 = MSO1.MSOLIS(4) 189 : SEGDES MSO1 190 : SEGACT MSOLE2 191 : MMODE = MSOLE2.ISOLEN(1) 192 : SEGDES MSOLE2 193 : SEGACT MMODE 194 : QPS = -1.D0 * FMMODD(IPLAC) 195 : SEGDES MMODE 196 : * RECHERCHE DU CHARGEMENT 197 : DO 32 IC = 1,NCH 198 : ICHARG = KCHARG(IC) 199 : SEGACT ICHARG 200 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT' 201 : & .OR.CHALIE(IC).NE.'LIE ') THEN 202 : SEGDES ICHARG 203 : GOTO 32 204 : ENDIF 205 : MCHPOI = ICHPO1 206 : SEGACT MCHPOI 207 : MSOUPO = IPCHP(1) 208 : SEGDES MCHPOI 209 : SEGACT MSOUPO 210 : MPOVAL = IPOVAL 211 : SEGDES MSOUPO 212 : SEGACT MPOVAL 213 : QXYZ = VPOCHA(1,1) 214 : SEGDES MPOVAL 215 : EPS = ABS(QPS - QXYZ) 216 : IF (EPS.LT.TOLER) THEN 217 : * ON A TROUVE LE CHARGEMENT 218 : GOTO 100 219 : ENDIF 220 : SEGDES ICHARG 221 : 32 CONTINUE 222 : * 223 : * IL N'Y A PAS DE CHARGEMENT CORRESPONDANT AU PSEUDO-MODE 224 : * 225 : INTERR(1) = IP 225 : CALL ERREUR(428) 226 : SEGDES MJONCT 227 : GOTO 10 228 : * 229 : * PSEUDO-MODE D'UNE FORCE DE CHOC 230 : * 231 : ELSE IF (MONTYP.EQ.'CHOC') THEN 232 : IF (ILEX.EQ.0) THEN 233 : SEGDES MJONCT 234 : GOTO 10 235 : ENDIF 236 : GOTO 100 237 : ENDIF 238 : * 239 : 100 CONTINUE 240 : IF (ICONT.EQ.0) THEN 241 : ICHP = MSOLE1.ISOLEN(IP) 242 : ELSE 243 : ICCC = MSOLE1.ISOLEN(IP) 243 : CALL PELPO(ICCC,ICHP,IRETOU) 244 : IF (IRETOU.EQ.0) THEN 245 : INTERR(1) = IP 245 : CALL ERREUR(428) 246 : SEGDES MJONCT 247 : GOTO 10 248 : ENDIF 249 : ENDIF 250 : * 251 : IF (ICHAR.NE.0) THEN 252 : MLREE1 = ICHPO2 253 : SEGACT MLREE1 254 : NF = MLREE1.PROG(/1) 255 : MLREE2 = ICHPO3 256 : SEGACT MLREE2 257 : ENDIF 258 : * 259 : N1 = 1 260 : N2 = 2 261 : DO 110 IT = 1,LDIM 262 : TEM1 = PROG(IT) 263 : IF (MONTYP.EQ.'CHOC') THEN 264 : FTEM1 = 0.D0 265 : IPOINP = MJOPOI 266 : COMP = MJODDL 267 : * RECHERCHE DANS LE CHPOINT DES FORCES DE LIAISON 268 : ICHLIA = MSOLE2.ISOLEN(IT) 268 : CALL EXTRA9(ICHLIA,IPOINP,COMP,KERRE,FTEM1) 269 : IF (KERRE.NE.0) THEN 270 : INTERR(1) = IP 270 : CALL ERREUR(428) 271 : SEGDES MJONCT 272 : GOTO 10 273 : ENDIF 274 : ELSE 274 : CALL INTLIN(TEM1,ICHPO2,ICHPO3,NF,N1,N2,FTEM1,IRETOU) 275 : IF (IRETOU.EQ.0) THEN 276 : INTERR(1) = IP 276 : CALL ERREUR(428) 277 : SEGDES MLREE1 278 : SEGDES MLREE2 279 : SEGDES ICHARG 280 : SEGDES MJONCT 281 : GOTO 10 282 : ENDIF 283 : ENDIF 284 : * 285 : DO 120 I3 = 1,NP 286 : IPOIN = NUMO(I3) 287 : COMP = NUDDL(I3) 287 : CALL EXTRA9(ICHP,IPOIN,COMP,KERRE,XFLOT1) 288 : IF (KERRE.NE.0) THEN 289 : IF (ICHAR.NE.0) THEN 290 : SEGDES MLREE1 291 : SEGDES MLREE2 292 : SEGDES ICHARG 293 : ENDIF 294 : INTERR(1) = IP 294 : CALL ERREUR(428) 295 : SEGDES MJONCT 296 : GOTO 10 297 : ENDIF 298 : XVAL = XFLOT1 * FTEM1 299 : * 300 : IF (IIMPI.EQ.1804) THEN 301 : PRINT*,'-- PRISE EN COMPTE DES PSEUDO-MODES -- XVAL :',XVAL 302 : ENDIF 303 : * 304 : MLREE3 = KLIST(I3) 305 : MLREE3.PROG(IT) = MLREE3.PROG(IT) + XVAL 306 : 120 CONTINUE 307 : * 308 : 110 CONTINUE 309 : IF (ICONT.EQ.1) THEN 310 : MCHPO1=ICHP 311 : SEGSUP MCHPO1 312 : ENDIF 313 : IF (ICHAR.NE.0) THEN 314 : SEGDES MLREE1 315 : SEGDES MLREE2 316 : SEGDES ICHARG 317 : ENDIF 318 : SEGDES MJONCT 319 : * 320 : 10 CONTINUE 321 : * 322 : SEGDES MLREEL 323 : SEGDES MSOLE1 324 : SEGDES MSOLEN 325 : SEGDES MSOLUT 326 : IF (ILEX.NE.0) THEN 327 : SEGDES MSOLE2 328 : ENDIF 329 : IF (ICHAR.NE.0) THEN 330 : SEGDES MCHARG 331 : ENDIF 332 : DO 4 I = 1,NP 333 : MLREE3 = KLIST(I) 334 : SEGDES MLREE3 335 : 4 CONTINUE 336 : * 337 : * SEGDES NUMOO 338 : IBOO = NUMOO 339 : * 340 : RETURN 341 : END 342 : 343 :
© Cast3M 2003 - All rights reserved.
Disclaimer