1 : C DYNE15 SOURCE FANDEUR 11/04/12 21:16:02 6938 2 : SUBROUTINE DYNE15(ITSORT,KPREF,NVA,NP,NINS,ITLIA,KTRES,IPMAIL, 3 : & REPRIS,ICHAIN,NTVAR,NLIAA,NLIAB,NPLB, 4 : & IDIMB,MTRA,ITCARA,lmodyn,nmost0) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : *--------------------------------------------------------------------* 8 : * * 9 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 10 : * ________________________________________________ * 11 : * * 12 : * Gestion de la table definissant les resultats attendus, * 13 : * parmi la liste des variables principales et auxilliaires. * 14 : * * 15 : * Parametres: * 16 : * * 17 : * e ITSORT Table definissant les resultats attendus * 18 : * es KPREF Segment des points de reference * 19 : * e NVA Nombre de valeurs prises par les variables * 20 : * e NP Nombre de pas de calcul * 21 : * e NINS On veut une sortie tous les NINS pas de calcul * 22 : * e ITLIA Pointeur sur la table de liaisons * 23 : * s MTRES Segment de sauvegarde des resultats * 24 : * s IPMAIL Maillage de reference pour les CHPOINTs resultats * 25 : * e REPRIS Vrai si reprise de calcul, faux sinon * 26 : * s ICHAIN Segment MLENTI (ACTIF) contenant les adresses des * 27 : * chaines dans la pile des mots de CCNOYAU * 28 : * s NTVAR Nombre total de variables internes pour les liaisons * 29 : * e NLIAA Nombre de liaisons en base A * 30 : * s NLIAB Nombre de liaisons base B * 31 : * s IDIMB Nombre de directions base B * 32 : * e MTRA Segment de travail temporaire (indique si liaison POL) * 33 : * * 34 : * Auteur, date de creation: * 35 : * * 36 : * Denis ROBERT-MOUGIN, le 2 juin 1989. * 37 : * * 38 : *--------------------------------------------------------------------* 39 : * 40 : -INC CCOPTIO 41 : -INC SMELEME 42 : * 43 : * NRES : nombre de variables demand{es (d{placement, vitesse, 44 : * acc{l{ration) 45 : * NVES : nombre de variables possibles 46 : * NCRES : nombre de valeurs prises par les variables 47 : * NPRES : nombre de pas de sortie INT (NP / NINS) + 1 48 : * NREP : nombre de variables n{cessaires @ la reprise de calcul 49 : * ( pour l'instant NREP = 10 ) 50 : * NLSA : nombre de demandes de liaison base A en sortie 51 : * NLSB : nombre de demandes de liaison base B en sortie 52 : * NVALA : nombre de variables internes par liaison base A 53 : * NVALB : nombre de variables internes par liaison base B 54 : * 55 : * *** Liste des variables *** 56 : * 57 : * Les variables principales sont: 58 : * 59 : * 1- le d{placement au pas de calcul 60 : * 2- la vitesse au pas de calcul 61 : * 62 : * Les variables auxilliaires sont: 63 : * 64 : * 3- le d{placement au demi-pas pr{c{dant le pas de sortie 65 : * 4- la vitesse au demi-pas pr{c{dant le pas de sortie 66 : * 5- l'acc{l{ration au pas de sortie 67 : * 6- l'acc{l{ration au demi-pas pr{c{dant le pas de sortie 68 : * 7- le travail des forces exterieures au pas de sortie 69 : * 8- le travail des forces interieures (raideur et amortissement 70 : * et forces de liaison) au pas de sortie 71 : * 72 : * Indique si des liaisons ont {t{ demand{es en sortie 73 : * 74 : * 9- les liaisons base A 75 : * 10- les liaisons base B 76 : * 77 : SEGMENT,MTRES 78 : REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) 79 : REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) 80 : REAL*8 XMREP(NLIAB,4,IDIMB) 81 : INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP) 82 : INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) 83 : INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) 84 : INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) 85 : INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) 86 : INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) 87 : INTEGER ILPOLA(NLIAA,2) 88 : ENDSEGMENT 89 : SEGMENT,MPREF 90 : INTEGER IPOREF(NPREF) 91 : ENDSEGMENT 92 : SEGMENT,MTRAV 93 : INTEGER ICHRE2(NBLS),MPOLA(NBLS),MNULA(NBLS) 94 : INTEGER MPOLB(NBLS),MNULB(NBLS) 95 : INTEGER IVLIAA(NBLS,NTVAR),INLIAA(NBLS,NTVAR) 96 : INTEGER IVLIAB(NBLS,NTVAR),INLIAB(NBLS,NTVAR) 97 : ENDSEGMENT 98 : SEGMENT,MTRA 99 : INTEGER IPLA(NTRA) 100 : ENDSEGMENT 101 : * segment chapeau modeles liaisons 102 : SEGMENT MOLIAI 103 : integer modtla,modtlb 104 : ENDSEGMENT 105 : * 106 : * NBLS : nombre total de liaisons, limit{ @ 2000 107 : * 108 : PARAMETER ( NBLS = 2010 ) 109 : LOGICAL L0,L1,REPRIS,LDEP,LVIT,LACC,LWEXT,LWINT,lmodyn 110 : CHARACTER*8 TYPRET,CHARRE 111 : * 112 : * Ecriture des chaines utilisees comme indices dans les tables 113 : * 113 : CALL DYNE12(ICHAIN) 114 : * 115 : * Creation du maillage a partir de la liste de r{f{rence: 116 : * 117 : MPREF = KPREF 118 : N1 = IPOREF(/1) 119 : IF (lmodyn) THEN 120 : * creation des supports geometriques de CHAMPOINT 121 : NBNN = 1 122 : NBELEM = nmost0 123 : NBSOUS = 0 124 : NBREF = 0 125 : IPMMOD = 0 126 : if (nmost0.gt.0) then 127 : SEGINI IPT2 128 : IPMMOD = IPT2 129 : IPT2.ITYPEL = 1 130 : DO 61 I=1,NBELEM 131 : IPT2.NUM(1,I) = IPOREF(I) 132 : 61 CONTINUE 133 : endif 134 : segdes ipt2 135 : * 136 : IPMSTA = 0 137 : NBELEM = N1 - nmost0 138 : if (NBELEM.gt.0) then 139 : SEGINI IPT2 140 : IPMSTA = IPT2 141 : IPT2.ITYPEL = 1 142 : DO 62 I=1,NBELEM 143 : IPT2.NUM(1,I) = IPOREF(nmost0+I) 144 : 62 CONTINUE 145 : segdes ipt2 146 : nbnn = 0 147 : nbelem = 0 148 : nbsous = 2 149 : nbref = 0 150 : segini meleme 151 : lisous(1) = ipmmod 152 : lisous(2) = ipmsta 153 : ipmail = meleme 154 : else 155 : ipmail = ipmmod 156 : endif 157 : 158 : ELSE 159 : 160 : NBNN = 1 161 : NBELEM = N1 162 : NBSOUS = 0 163 : NBREF = 0 164 : SEGINI,MELEME 165 : IPMAIL = MELEME 166 : ITYPEL = 1 167 : DO 60 I=1,N1 168 : NUM(1,I) = IPOREF(I) 169 : 60 CONTINUE 170 : * end do 171 : SEGDES,MELEME 172 : ENDIF 173 : * 174 : IIRES = 2 175 : NVALA = 0 176 : NVALB = 0 177 : NLSA = 0 178 : NLSB = 0 179 : II = 10 180 : ILIAA = 0 181 : ILIAB = 0 182 : ITABV = 0 183 : ITLA = 0 184 : ITLB = 0 185 : SEGINI,MTRAV 186 : KTRAV = MTRAV 187 : * 188 : * Option de sortie par d{faut: 189 : * 190 : ICHRE2(1) = 1 191 : ICHRE2(2) = 1 192 : ICHRE2(3) = 0 193 : ICHRE2(4) = 0 194 : ICHRE2(5) = 0 195 : ICHRE2(6) = 0 196 : ICHRE2(7) = 0 197 : ICHRE2(8) = 0 198 : ICHRE2(9) = 0 199 : ICHRE2(10) = 0 200 : * 201 : IF (ITSORT.NE.0) THEN 202 : IF (LMODYN) THEN 202 : call ecrobj('TABLE',itsort) 202 : call indeta 202 : call lirobj('TABLE ',ITAC,1,IRETOU) 203 : moliai = itlia 204 : segact moliai 205 : ITABV = ITSORT 206 : typret='TABLE ' 207 : ELSE 208 : TYPRET=' ' 208 : CALL ACCTAB(ITSORT,'MOT',I0,X0,'VARIABLE',L0,IP0, 209 : & TYPRET,I1,X1,CHARRE,L1,ITABV) 210 : ENDIF 211 : IF (ITABV.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN 212 : TYPRET=' ' 212 : CALL ACCTAB(ITABV,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, 213 : & TYPRET,I1,X1,CHARRE,LDEP,IP1) 214 : IF (TYPRET.EQ.'LOGIQUE ' .AND. .NOT.LDEP) THEN 215 : ICHRE2(1) = 0 216 : IIRES = IIRES - 1 217 : ENDIF 218 : if (lmodyn) then 219 : TYPRET=' ' 219 : CALL ACCTAB(ITABV,'MOT',I0,X0,'DEPLACEMENTS',L0,IP0, 220 : & TYPRET,I1,X1,CHARRE,LDEP,IP1) 221 : IF (TYPRET.EQ.'LOGIQUE ' .AND. .NOT.LDEP) THEN 222 : ICHRE2(1) = 0 223 : IIRES = IIRES - 1 224 : ENDIF 225 : endif 226 : TYPRET=' ' 226 : CALL ACCTAB(ITABV,'MOT',I0,X0,'VITESSE',L0,IP0, 227 : & TYPRET,I1,X1,CHARRE,LVIT,IP1) 228 : IF (TYPRET.EQ.'LOGIQUE ' .AND. .NOT.LVIT) THEN 229 : ICHRE2(2) = 0 230 : IIRES = IIRES - 1 231 : ENDIF 232 : if (lmodyn) then 233 : TYPRET=' ' 233 : CALL ACCTAB(ITABV,'MOT',I0,X0,'VITESSES',L0,IP0, 234 : & TYPRET,I1,X1,CHARRE,LVIT,IP1) 235 : IF (TYPRET.EQ.'LOGIQUE ' .AND. .NOT.LVIT) THEN 236 : ICHRE2(2) = 0 237 : IIRES = IIRES - 1 238 : ENDIF 239 : endif 240 : TYPRET=' ' 240 : CALL ACCTAB(ITABV,'MOT',I0,X0,'DEPLACEMENT_1/2',L0,IP0, 241 : & TYPRET,I1,X1,CHARRE,LDEP,IP1) 242 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LDEP) THEN 243 : ICHRE2(3) = 1 244 : IIRES = IIRES + 1 245 : ENDIF 246 : TYPRET=' ' 246 : CALL ACCTAB(ITABV,'MOT',I0,X0,'VITESSE_1/2',L0,IP0, 247 : & TYPRET,I1,X1,CHARRE,LVIT,IP1) 248 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVIT) THEN 249 : ICHRE2(4) = 1 250 : IIRES = IIRES + 1 251 : ENDIF 252 : TYPRET=' ' 252 : CALL ACCTAB(ITABV,'MOT',I0,X0,'ACCELERATION',L0,IP0, 253 : & TYPRET,I1,X1,CHARRE,LACC,IP1) 254 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LACC) THEN 255 : ICHRE2(5) = 1 256 : IIRES = IIRES + 1 257 : ENDIF 258 : TYPRET=' ' 258 : CALL ACCTAB(ITABV,'MOT',I0,X0,'ACCELERATION_1/2',L0,IP0, 259 : & TYPRET,I1,X1,CHARRE,LACC,IP1) 260 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LACC) THEN 261 : ICHRE2(6) = 1 262 : IIRES = IIRES + 1 263 : ENDIF 264 : 265 : * ajout des sorties des travaux 266 : TYPRET=' ' 266 : CALL ACCTAB(ITABV,'MOT',I0,X0,'TRAVAIL_EXTERIEUR',L0,IP0, 267 : & TYPRET,I1,X1,CHARRE,LWEXT,IP1) 268 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LWEXT) THEN 269 : ICHRE2(7) = 1 270 : IIRES = IIRES + 1 271 : ENDIF 272 : TYPRET=' ' 272 : CALL ACCTAB(ITABV,'MOT',I0,X0,'TRAVAIL_INTERIEUR',L0,IP0, 273 : & TYPRET,I1,X1,CHARRE,LWINT,IP1) 274 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LWINT) THEN 275 : ICHRE2(8) = 1 276 : IIRES = IIRES + 1 277 : ENDIF 278 : 279 : ENDIF 280 : * 281 : IF (LMODYN) THEN 282 : iliaa = modtla 283 : if (iliaa.gt.0) 283 : &CALL DYNE74(ITSORT,ITCARA,ITAC,ILIAA,KTRAV,II,NLSA,NVALA) 284 : ELSE 285 : TYPRET = ' ' 285 : CALL ACCTAB(ITSORT,'MOT',I0,X0,'LIAISON_A',L0,IP0, 286 : & TYPRET,I1,X1,CHARRE,L1,ITLA) 287 : IF (ITLA.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN 287 : CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_A',L0,IP0, 288 : & 'TABLE',I1,X1,' ',L1,ILIAA) 288 : CALL DYNE24(ITLA,ILIAA,KTRAV,II,NLSA,NVALA) 289 : ENDIF 290 : ENDIF 291 : IF (IERR.NE.0) RETURN 292 : IF (NLSA.NE.0) ICHRE2(9) = 1 293 : * 294 : IF (LMODYN) THEN 295 : iliab = modtlb 296 : if (iliab.gt.0) 296 : &CALL DYNE77(ITSORT,ITCARA,ITAC,ILIAB,KTRAV,II,NLSB,NVALB,NPLB) 297 : ELSE 298 : TYPRET = ' ' 298 : CALL ACCTAB(ITSORT,'MOT',I0,X0,'LIAISON_B',L0,IP0, 299 : & TYPRET,I1,X1,CHARRE,L1,ITLB) 300 : IF (ITLB.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN 300 : CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_B',L0,IP0, 301 : & 'TABLE',I1,X1,' ',L1,ILIAB) 301 : CALL DYNE27(ITLB,ILIAB,KTRAV,II,NLSB,NVALB,NPLB) 302 : ENDIF 303 : ENDIF 304 : ENDIF 305 : IF (IERR.NE.0) RETURN 306 : IF (NLSB.NE.0) ICHRE2(10) = 1 307 : * 308 : NRES = IIRES 309 : NVES = II 310 : IF (IIMPI.EQ.333) THEN 311 : WRITE(IOIMP,*)'DYNE15 : NVES = ',NVES 312 : WRITE(IOIMP,*)'DYNE15 : NLSA = ',NLSA 313 : WRITE(IOIMP,*)'DYNE15 : NLSB = ',NLSB 314 : WRITE(IOIMP,*)'DYNE15 : NVALA = ',NVALA 315 : WRITE(IOIMP,*)'DYNE15 : NVALB = ',NVALB 316 : WRITE(IOIMP,*)'DYNE15 : II = ',II 317 : ENDIF 318 : NREP = 10 319 : NCRES = NVA 320 : NPRES = INT(NP/NINS) + 1 321 : IF ( REPRIS ) NPRES = NPRES - 1 322 : SEGINI,MTRES 323 : KTRES = MTRES 324 : DO 30 I = 1,NVES 325 : ICHRES(I) = ICHRE2(I) 326 : 30 CONTINUE 327 : * end do 328 : * 329 : DO 40 I = 1,NLSA 330 : DO 42 II = 1,NTVAR 331 : ILIREA(I,II) = IVLIAA(I,II) 332 : ILIRNA(I,II) = INLIAA(I,II) 333 : 42 CONTINUE 334 : * end do 335 : IPOLA(I) = MPOLA(I) 336 : INULA(I) = MNULA(I) 337 : 40 CONTINUE 338 : * end do 339 : DO 50 I = 1,NLSB 340 : DO 52 II = 1,NTVAR 341 : ILIREB(I,II) = IVLIAB(I,II) 342 : ILIRNB(I,II) = INLIAB(I,II) 343 : 52 CONTINUE 344 : * end do 345 : IPOLB(I) = MPOLB(I) 346 : INULB(I) = MNULB(I) 347 : 50 CONTINUE 348 : * end do 349 : DO 160 I = 1,NLIAA 350 : ILPOLA(I,1) = IPLA(I) 351 : 160 CONTINUE 352 : * end do 353 : * 354 : SEGSUP,MTRAV 355 : SEGSUP,MTRA 356 : * 357 : * Boucle d'impression des ICHRES: 358 : * 359 : IF (IIMPI.EQ.333) THEN 360 : DO 80 I = 1,NVES 361 : WRITE(IOIMP,*)'DYNE15 : ICHRES(',I,')=',ICHRES(I) 362 : 80 CONTINUE 363 : * end do 364 : ENDIF 365 : * 366 : RETURN 367 : END 368 : 369 :
© Cast3M 2003 - All rights reserved.
Disclaimer