1 : C PSRECO SOURCE FANDEUR 10/12/14 21:19:05 6812 2 : SUBROUTINE PSRECO(IMODE,IPSMO,TYPE,ICHAR,ICHLIA,TEMPS,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,Q-Z) 5 : ************************************************************************ 6 : * 7 : * P S R E C O 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * AJOUTE LA CONTRIBUTIONN DUE AUX MODES NEGLIGES. 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : -INC CCHAMP 19 : -INC CCOPTIO 20 : -INC CCREEL 21 : *- 22 : -INC SMATTAC 23 : -INC SMCHARG 24 : -INC SMCHPOI 25 : -INC SMELEME 26 : -INC SMLREEL 27 : -INC SMSOLUT 28 : * 29 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 30 : * ----------- 31 : * 32 : * IMODE (E) OBJET SOLUTION DE SOUS-TYPE MODE. 33 : * IPSMO (E) OBJET SOLUTION DE SOUS-TYPE PSEUMODE. 34 : * TYPE (E) DEPL OU CONT. 35 : * ICHAR (E) POINTEUR SUR LE CHARGEMENT. 36 : * ICHLIA (E) CHPOINT DES FORCES DE LIAISON. 37 : * TEMPS (E) TEMPS DE LA RECOMBINAISON. 38 : * IRET (E) POINTEUR SUR LE CHPOINT DE RECOMBINAISON. 39 : * (S) POINTEUR SUR LE CHPOINT DE RECOMBINAISON. 40 : * 41 : CHARACTER*4 TYPE 42 : * 43 : * VARIABLES: 44 : * ---------- 45 : * 46 : CHARACTER*4 COMP,CC,MONTYP,DIRECT 47 : PARAMETER (TOLER = 1.D-6) 48 : * 49 : * 50 : * AUTEUR, DATE DE CREATION: 51 : * ------------------------- 52 : * 53 : * LIONEL VIVAN SEPTEMBRE 1988 54 : * 55 : * LANGAGE: 56 : * -------- 57 : * 58 : * ESOPE + FORTRAN77 59 : * 60 : * PASSAGE AUX NOUVEAUX MCHAMLS PAR JM CAMPENON LE 02/91 61 : * 62 : ************************************************************************ 63 : * 64 : IF (IPSMO.EQ.0) THEN 64 : CALL ERREUR(429) 65 : RETURN 66 : ENDIF 67 : * 68 : IF (ICHAR.EQ.0 .AND. ICHLIA.EQ.0) THEN 68 : CALL ERREUR(430) 69 : RETURN 70 : ENDIF 71 : * 72 : IF (TEMPS.LT.XPETIT) THEN 72 : CALL ERREUR(431) 73 : RETURN 74 : ENDIF 75 : * 76 : MSOLUT = IPSMO 77 : SEGACT MSOLUT 78 : * 79 : MSOLEN = MSOLIS(10) 80 : SEGACT MSOLEN 81 : NPS = ISOLEN(/1) 82 : * 83 : IF (TYPE.EQ.'DEPL') THEN 84 : MSOLE1 = MSOLIS(5) 85 : ELSE IF (TYPE.EQ.'CONT') THEN 86 : MSOLE1 = MSOLIS(6) 87 : ELSE 88 : GOTO 9000 89 : ENDIF 90 : * 91 : IF (MSOLE1.EQ.0) THEN 92 : * MANQUE LES DEPLACEMENTS OU LES CONTRAINTES 93 : IF (TYPE.EQ.'DEPL') THEN 94 : MOTERR(1:12) = 'DEPLACEMENTS' 95 : ELSE 96 : MOTERR(1:12) = 'CONTRAINTES ' 97 : ENDIF 97 : CALL ERREUR(427) 98 : GOTO 9000 99 : ENDIF 100 : SEGACT MSOLE1 101 : * 102 : IF (ICHAR.NE.0) THEN 103 : MCHARG = ICHAR 104 : SEGACT MCHARG 105 : NCH = KCHARG(/1) 106 : ENDIF 107 : * 108 : DO 10 IP = 1,NPS 109 : MJONCT = ISOLEN(IP) 110 : SEGACT MJONCT 111 : MONTYP = MJOTYP 112 : * 113 : * PSEUDO-MODE D'UNE STRUCTURE MULTISUPPORTEE 114 : * 115 : IF (MONTYP.EQ.'DEPL') THEN 116 : IF (ICHAR.EQ.0) THEN 117 : SEGDES MJONCT 118 : GOTO 10 119 : ENDIF 120 : ICHM = IPCHJO(1) 121 : * RECHERCHE DU CHARGEMENT 122 : DO 12 IC = 1,NCH 123 : ICHARG = KCHARG(IC) 124 : SEGACT ICHARG 125 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT' 126 : & .OR.CHALIE(IC).NE.'LIE ') THEN 127 : SEGDES ICHARG 128 : GOTO 12 129 : ENDIF 130 : ICHC = ICHPO1 131 : IF (ICHC.EQ.ICHM) THEN 132 : * ON A TROUVE LE CHARGEMENT 133 : GOTO 100 134 : ENDIF 135 : SEGDES ICHARG 136 : 12 CONTINUE 137 : * 138 : * IL N'Y A PAS DE CHARGEMENT POUR CE PSEUDO-MODE 139 : * 140 : INTERR(1) = IP 140 : CALL ERREUR(428) 141 : SEGDES MJONCT 142 : GOTO 10 143 : * 144 : * PSEUDO-MODE D'UNE FORCE CONCENTREE 145 : * 146 : ELSE IF (MONTYP.EQ.'FORC') THEN 147 : IF (ICHAR.EQ.0) THEN 148 : SEGDES MJONCT 149 : GOTO 10 150 : ENDIF 151 : ICHM = IPCHJO(1) 152 : * RECHERCHE DU CHARGEMENT 153 : DO 22 IC = 1,NCH 154 : ICHARG = KCHARG(IC) 155 : SEGACT ICHARG 156 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT' 157 : & .OR.CHALIE(IC).NE.'LIE ') THEN 158 : SEGDES ICHARG 159 : GOTO 22 160 : ENDIF 161 : ICHC = ICHPO1 162 : IF (ICHC.EQ.ICHM) THEN 163 : * ON A TROUVE LE CHARGEMENT 164 : GOTO 100 165 : ENDIF 166 : SEGDES ICHARG 167 : 22 CONTINUE 168 : * 169 : * IL N'Y A PAS DE CHARGEMENT POUR CE PSEUDO-MODE 170 : * 171 : INTERR(1) = IP 171 : CALL ERREUR(428) 172 : SEGDES MJONCT 173 : GOTO 10 174 : * 175 : * PSEUDO-MODE D'UNE EXCITATION SISMIQUE D'ENSEMBLE 176 : * 177 : ELSE IF (MONTYP.EQ.'SEIS') THEN 178 : IF (ICHAR.EQ.0) THEN 179 : SEGDES MJONCT 180 : GOTO 10 181 : ENDIF 182 : DIRECT = MJODDL 183 : IF (DIRECT.EQ.'UX ') THEN 184 : IPLAC = 3 185 : ELSE IF (DIRECT.EQ.'UY ') THEN 186 : IPLAC = 4 187 : ELSE 188 : IPLAC = 5 189 : ENDIF 190 : MSO1 = IMODE 191 : SEGACT MSO1 192 : MSOLE2 = MSO1.MSOLIS(4) 193 : SEGDES MSO1 194 : SEGACT MSOLE2 195 : MMODE = MSOLE2.ISOLEN(1) 196 : SEGDES MSOLE2 197 : SEGACT MMODE 198 : QPS = FMMODD(IPLAC) 199 : QPS = -1.D0 * QPS 200 : SEGDES MMODE 201 : * RECHERCHE DU CHARGEMENT 202 : DO 32 IC = 1,NCH 203 : ICHARG = KCHARG(IC) 204 : SEGACT ICHARG 205 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT' 206 : & .OR.CHALIE(IC).NE.'LIE ') THEN 207 : SEGDES ICHARG 208 : GOTO 32 209 : ENDIF 210 : MCHPOI = ICHPO1 211 : SEGACT MCHPOI 212 : MSOUPO = IPCHP(1) 213 : SEGDES MCHPOI 214 : SEGACT MSOUPO 215 : MPOVAL = IPOVAL 216 : SEGDES MSOUPO 217 : SEGACT MPOVAL 218 : QXYZ = VPOCHA(1,1) 219 : SEGDES MPOVAL 220 : EPS = ABS(QPS - QXYZ) 221 : IF (EPS.LT.TOLER) THEN 222 : * ON A TROUVE LE CHARGEMENT 223 : GOTO 100 224 : ENDIF 225 : SEGDES ICHARG 226 : 32 CONTINUE 227 : * 228 : * IL N'Y A PAS DE CHARGEMENT POUR CE PSEUDO-MODE 229 : * 230 : INTERR(1) = IP 230 : CALL ERREUR(428) 231 : SEGDES MJONCT 232 : GOTO 10 233 : * 234 : * PSEUDO-MODE D'UNE FORCE DE CHOC 235 : * 236 : ELSE IF (MONTYP.EQ.'CHOC') THEN 237 : IF (ICHLIA.EQ.0) THEN 238 : SEGDES MJONCT 239 : GOTO 10 240 : ENDIF 241 : GOTO 100 242 : ENDIF 243 : * 244 : 100 CONTINUE 245 : ICHP = MSOLE1.ISOLEN(IP) 246 : * 247 : IF (MONTYP.EQ.'CHOC') THEN 248 : IPOINP = MJOPOI 249 : COMP = MJODDL 249 : CALL ECROBJ('POINT ',IPOINP) 249 : CALL ECRCHA(COMP) 249 : CALL ECROBJ('CHPOINT ',ICHLIA) 249 : CALL EXTRAI 249 : CALL LIRREE(FTEMPS,1,IRETOU) 250 : IF (IERR.NE.0) RETURN 251 : ELSE 252 : FTEMPS = 0.D0 253 : MLREE1 = ICHPO2 254 : SEGACT MLREE1 255 : NF = MLREE1.PROG(/1) 256 : MLREE2 = ICHPO3 257 : SEGACT MLREE2 258 : N1 = 1 259 : N2 = 2 259 : CALL INTLIN(TEMPS,ICHPO2,ICHPO3,NF,N1,N2,FT0,IRETOU) 260 : IF (IRETOU.EQ.0) THEN 261 : INTERR(1) = IP 261 : CALL ERREUR(428) 262 : GOTO 10 263 : ENDIF 264 : FTEMPS = FT0 265 : SEGDES MLREE1 266 : SEGDES MLREE2 267 : SEGDES ICHARG 268 : ENDIF 269 : * 270 : IF (IIMPI.EQ.1804) THEN 271 : PRINT*,'-- prise en compte des pseudo-modes -- FTEMPS :',FTEMPS 272 : ENDIF 273 : * 274 : N1 = 1 275 : IF (TYPE.EQ.'DEPL') THEN 275 : CALL ADCHPO(IRET,ICHP,IRET,1D0,FTEMPS) 276 : ELSE 277 : IPCHE1 = ICHP 278 : IF (IP.EQ.1) IPRET = IRET 279 : * 279 : CALL MUCHEL(IPCHE1,FTEMPS,ICHP1,N1) 279 : CALL ADCHEL(IPRET,ICHP1,IPRET,N1) 279 : CALL DTCHAM(ICHP1) 280 : ENDIF 281 : SEGDES MJONCT 282 : * 283 : 10 CONTINUE 284 : * 285 : SEGDES MSOLE1 286 : IF (ICHAR.NE.0) THEN 287 : SEGDES MCHARG 288 : ENDIF 289 : * 290 : 9000 CONTINUE 291 : SEGDES MSOLEN 292 : SEGDES MSOLUT 293 : 294 : RETURN 295 : END 296 : 297 :
© Cast3M 2003 - All rights reserved.
Disclaimer