1 : C DEVTR1 SOURCE CHAT 05/01/12 22:47:45 5004 2 : SUBROUTINE DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES, 3 : & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA, 4 : & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA, 5 : & ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB, 6 : & WEXT,WINT,XCHPFB,NPLB) 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : *--------------------------------------------------------------------* 10 : * * 11 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 12 : * ________________________________________________ * 13 : * * 14 : * Transfert des quantités calculées durant le pas dans le * 15 : * tableau de sauvegarde, si l'on souhaite les garder ... * 16 : * * 17 : * Paramètres: * 18 : * * 19 : * e Q1(.,.) Vecteur de déplacements généralisés * 20 : * e Q2(.,.) Vecteur de vitesses généralisés * 21 : * e Q3(.,.) Vecteur de accélérations généralisés * 22 : * e NA1 Nombre total d'inconnues en base A * 23 : * e IINS2 Numéro du pas de sortie * 24 : * e NINS On veut une sortie tous les NINS pas de calcul * 25 : * e FTOTA Forces extérieures totalisées en base A * 26 : * es XRES Valeurs des variables sauvegardées * 27 : * e ICHRES Indique quelles variables seront sauvegardées * 28 : * e NRES Nombre de variables ( principales et auxilliaires ) * 29 : * e NCRES Nombre de valeurs prises par les variables * 30 : * e NPRES Nombre de pas de sortie * 31 : * es XREP Valeurs des variables de reprise de calcul * 32 : * e NREP Nombre de variables de reprise * 33 : * e XMREP Paramètres de liaison nécessaire @ une reprise * 34 : * e IMREP Paramètres de liaison nécessaire @ une reprise * 35 : * e XPALB Paramètres de liaison * 36 : * e IPALB Paramètres de liaison * 37 : * e XVALA Tableau contenant les variables internes de liaison A * 38 : * e INULA Tableau contenant les repères des liaisons * 39 : * e NLIAA Nombre de liaisons sur la base A * 40 : * e NLSA Nombre de liaisons en sortie base A * 41 : * es XRESLA Valeurs de variables de liaisons sauvegardées base A * 42 : * e XVALB Tableau contenant les variables internes de liaison B * 43 : * e INULB Tableau contenant les repères des liaisons * 44 : * e NLIAB Nombre de liaisons sur la base B * 45 : * e NLSB Nombre de liaisons en sortie base B * 46 : * es XRESLB Valeurs de variables de liaisons sauvegardées base B * 47 : * e,s WEXT travail des forces exterieures 48 : * e,s WINT travail des forces interieures (rigidite et 49 : * amortissement et forces de liaison ) 50 : * * 51 : * Auteur, date de création: * 52 : * * 53 : * Denis ROBERT-MOUGIN, le 31 mai 1989. * 54 : * * 55 : *--------------------------------------------------------------------* 56 : REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*) 57 : REAL*8 XVALA(NLIAA,4,*),XRESLA(NLSA,NPRES,*) 58 : REAL*8 XVALB(NLIAB,4,*),XRESLB(NLSB,NPRES,*) 59 : REAL*8 FTOTA(NA1,*),XRES(NRES,NCRES,*),XREP(NREP,*) 60 : REAL*8 XPALB(NLIAB,*),XMREP(NLIAB,4,*) 61 : INTEGER ICHRES(*),INULA(*),INULB(*) 62 : INTEGER ILIREA(NLSA,*),ILIREB(NLSB,*) 63 : INTEGER IPALB(NLIAB,*),IMREP(NLIAB,*) 64 : REAL*8 WEXT(NA1,2),WINT(NA1,2),XCHPFB(2,NLIAB,4,*) 65 : * 66 : * Sauvegarde pour un pas courant : 67 : * 68 : IF (NRES.NE.0) THEN 69 : KRES = 0 70 : IF (ICHRES(1).EQ.1) THEN 71 : KRES = KRES + 1 72 : DO 10 I=1,NA1 73 : XRES(KRES,I,IINS2) = Q1(I,1) 74 : 10 CONTINUE 75 : ENDIF 76 : * end do 77 : IF (ICHRES(2).EQ.1) THEN 78 : KRES = KRES + 1 79 : DO 12 I=1,NA1 80 : XRES(KRES,I,IINS2) = Q2(I,1) 81 : 12 CONTINUE 82 : * end do 83 : ENDIF 84 : IF (ICHRES(3).EQ.1) THEN 85 : KRES = KRES + 1 86 : DO 14 I=1,NA1 87 : XRES(KRES,I,IINS2) = Q1(I,2) 88 : 14 CONTINUE 89 : * end do 90 : ENDIF 91 : IF (ICHRES(4).EQ.1) THEN 92 : KRES = KRES + 1 93 : DO 16 I=1,NA1 94 : XRES(KRES,I,IINS2) = Q2(I,2) 95 : 16 CONTINUE 96 : * end do 97 : ENDIF 98 : IF (ICHRES(5).EQ.1) THEN 99 : KRES = KRES + 1 100 : DO 18 I=1,NA1 101 : XRES(KRES,I,IINS2) = Q3(I,1) 102 : 18 CONTINUE 103 : * end do 104 : ENDIF 105 : IF (ICHRES(6).EQ.1) THEN 106 : KRES = KRES + 1 107 : DO 20 I=1,NA1 108 : XRES(KRES,I,IINS2) = Q3(I,2) 109 : 20 CONTINUE 110 : * end do 111 : ENDIF 112 : ENDIF 113 : 114 : c ianis 115 : cc travaux 116 : IF (ICHRES(7).EQ.1) THEN 117 : KRES = KRES + 1 118 : DO 60 I=1,NA1 119 : XRES(KRES,I,IINS2) = WEXT(I,1) 120 : 60 CONTINUE 121 : ENDIF 122 : IF (ICHRES(7).EQ.1) THEN 123 : KRES = KRES + 1 124 : DO 70 I=1,NA1 125 : XRES(KRES,I,IINS2) = WINT(I,1) 126 : 70 CONTINUE 127 : ENDIF 128 : 129 : 130 : IF (ICHRES(9).EQ.1) THEN 131 : DO 30 IL = 1,NLSA 132 : IIL = INULA(IL) 133 : II = 0 134 : DO 32 IV = 1,NTVAR 135 : IF (ILIREA(IL,IV).EQ.1) THEN 136 : II = II + 1 137 : XRESLA(IL,IINS2,II) = XVALA(IIL,1,IV) 138 : ENDIF 139 : 32 CONTINUE 140 : * end do 141 : 30 CONTINUE 142 : * end do 143 : ENDIF 144 : IF (ICHRES(10).EQ.1) THEN 145 : DO 40 IL = 1,NLSB 146 : IIL = INULB(IL) 147 : II = 0 148 : DO 42 IV = 1,NTVAR 149 : IF (ILIREB(IL,IV).EQ.1) THEN 150 : II = II + 1 151 : XRESLB(IL,IINS2,II) = XVALB(IIL,1,IV) 152 : ELSE 153 : IF (ILIREB(IL,IV).EQ.2) THEN 154 : DO 43 IP=1,NPLB 155 : DO 44 ID=1,2 156 : II = II + 1 157 : XRESLB(IL,IINS2,II) = XCHPFB(ID,IIL,1,IP) 158 : 44 CONTINUE 159 : 43 CONTINUE 160 : ENDIF 161 : * 162 : ENDIF 163 : 42 CONTINUE 164 : * end do 165 : 40 CONTINUE 166 : * end do 167 : ENDIF 168 : * 169 : * Sauvegarde pour une reprise 170 : * 171 : IF (IINS2.EQ.NPRES) THEN 172 : DO 50 I=1,NA1 173 : XREP(1,I) = Q1(I,1) 174 : XREP(2,I) = Q2(I,1) 175 : XREP(3,I) = Q1(I,2) 176 : XREP(4,I) = Q2(I,2) 177 : XREP(5,I) = Q3(I,1) 178 : XREP(6,I) = Q3(I,2) 179 : XREP(7,I) = FTOTA(I,1) 180 : XREP(8,I) = FTOTA(I,2) 181 : XREP(9,I) = WEXT(I,1) 182 : XREP(10,I)= WINT(I,1) 183 : 50 CONTINUE 184 : * end do 185 : IF (NLIAB.NE.0) THEN 186 : DO 51 I = 1,NLIAB 187 : ITYP = IPALB(I,1) 188 : IMREP(I,1) = ITYP 189 : IMREP(I,2) = IPALB(I,2) 190 : * 191 : * ------ choc élémentaire POINT_CERCLE_FROTTEMENT sans amortissement 192 : * 193 : IF (ITYP.EQ.23) THEN 194 : IDIM = IPALB(I,3) 195 : ID0 = 6 + 6*IDIM 196 : ID1 = 6 + 7*IDIM 197 : ID2 = 6 + 8*IDIM 198 : * 199 : * ------ choc élémentaire POINT_CERCLE_FROTTEMENT avec amortissement 200 : * 201 : ELSE IF (ITYP.EQ.24) THEN 202 : IDIM = IPALB(I,3) 203 : ID0 = 7 + 6*IDIM 204 : ID1 = 7 + 7*IDIM 205 : ID2 = 7 + 8*IDIM 206 : * 207 : * ------ choc élémentaire POINT_PLAN_FROTTEMENT 208 : * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT avec amortissement 209 : * ------ choc élémentaire POINT_POINT_FROTTEMENT 210 : * 211 : ELSE IF (ITYP.EQ.3 .or. ityp.eq.13 212 : & .or. ityp.eq.113 .or. ityp.eq.-13. or.ityp.eq.6) THEN 213 : IDIM = IPALB(I,3) 214 : ID0 = 7 + 4*IDIM 215 : ID1 = 7 + 5*IDIM 216 : ID2 = 7 + 6*IDIM 217 : 218 : * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT sans amortissement 219 : ELSE IF (ITYP.EQ.5 ) THEN 220 : IDIM = IPALB(I,3) 221 : ID0 = 6 + 4*IDIM 222 : ID1 = 6 + 5*IDIM 223 : ID2 = 6 + 6*IDIM 224 : 225 : * 226 : * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT 227 : * 228 : * ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN 229 : * 230 : * Ne sert pas pour l 'instant car modele d'ODEN de frottement 231 : 232 : 233 : * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT 234 : 235 : ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN 236 : IDIM = IPALB(I,3) 237 : IF (ITYP.EQ.25) THEN 238 : IDD = 6 239 : ELSE 240 : IDD = 7 241 : ENDIF 242 : ID0 = IDD + 6*IDIM 243 : ID1 = IDD + 7*IDIM 244 : ID2 = IDD + 8*IDIM 245 : ID3 = IDD + 2*IDIM 246 : DO 82 ID = 1,IDIMB 247 : XMREP(I,1,ID) = XPALB(I,ID0+ID) 248 : XMREP(I,2,ID) = XPALB(I,ID1+ID) 249 : XMREP(I,3,ID) = XPALB(I,ID2+ID) 250 : XMREP(I,4,ID) = XPALB(I,ID3+ID) 251 : 82 CONTINUE 252 : * end do 253 : GOTO 51 254 : 255 : 256 : * ------ choc élémentaire POINT_PLAN_FLUIDE 257 : * 258 : ELSE IF (ITYP.EQ.7) THEN 259 : IDIM = IPALB(I,3) 260 : ID1 = 6 + IDIM 261 : XMREP(I,1,1) = XPALB(I,ID1+1) 262 : XMREP(I,2,1) = XPALB(I,ID1+2) 263 : XMREP(I,3,1) = XPALB(I,ID1+3) 264 : GOTO 51 265 : C si ityp = 100, on sauvegarde le depl. plastique 266 : C directement dans devso4 267 : C NW idem si ITYP = 50/51 ou 16/17 --> dans devso4 268 : C 269 : * 270 : * 271 : * ------ choc .... 272 : * 273 : * ELSE IF (ITYP.EQ. ) THEN 274 : * ... 275 : * 276 : ELSE 277 : GOTO 51 278 : ENDIF 279 : C NW on boucle sur ID = 1,IDIMB 280 : * 281 : DO 52 ID = 1,IDIMB 282 : XMREP(I,1,ID) = XPALB(I,ID0+ID) 283 : XMREP(I,2,ID) = XPALB(I,ID1+ID) 284 : XMREP(I,3,ID) = XPALB(I,ID2+ID) 285 : 52 CONTINUE 286 : * end do 287 : 51 CONTINUE 288 : * end do 289 : ENDIF 290 : ENDIF 291 : * 292 : END 293 : 294 : 295 : 296 : 297 : 298 :
© Cast3M 2003 - All rights reserved.
Disclaimer