devtr1
C DEVTR1 SOURCE BP208322 20/03/26 21:15:36 10562 & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA, & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA, & ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB, & WEXT,WINT,XCHPFB,NPLB) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : * * Transfert des quantités calculées durant le pas dans le * * tableau de sauvegarde, si l'on souhaite les garder ... * * * *--------------------------------------------------------------------* * * * Paramètres: * * * * e Q1(.,.) Vecteur de déplacements généralisés * * e Q2(.,.) Vecteur de vitesses généralisés * * e Q3(.,.) Vecteur de accélérations généralisés * * e NA1 Nombre total d'inconnues en base A * * e IINS2 Numéro du pas de sortie * * e NINS On veut une sortie tous les NINS pas de calcul * * e FTOTA Forces extérieures totalisées en base A * * es XRES Valeurs des variables sauvegardées * * e ICHRES Indique quelles variables seront sauvegardées * * e NRES Nombre de variables ( principales et auxilliaires ) * * e NCRES Nombre de valeurs prises par les variables * * e NPRES Nombre de pas de sortie * * es XREP Valeurs des variables de reprise de calcul * * e NREP Nombre de variables de reprise * * e XMREP Paramètres de liaison nécessaire @ une reprise * * e IMREP Paramètres de liaison nécessaire @ une reprise * * e XPALB Paramètres de liaison * * e IPALB Paramètres de liaison * * e XVALA Tableau contenant les variables internes de liaison A * * e INULA Tableau contenant les repères des liaisons * * e NLIAA Nombre de liaisons sur la base A * * e NLSA Nombre de liaisons en sortie base A * * es XRESLA Valeurs de variables de liaisons sauvegardées base A * * e XVALB Tableau contenant les variables internes de liaison B * * e INULB Tableau contenant les repères des liaisons * * e NLIAB Nombre de liaisons sur la base B * * e NLSB Nombre de liaisons en sortie base B * * es XRESLB Valeurs de variables de liaisons sauvegardées base B * * e,s WEXT travail des forces exterieures * e,s WINT travail des forces interieures (rigidite et * amortissement et forces de liaison ) * * *--------------------------------------------------------------------* REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*) REAL*8 XVALA(NLIAA,4,*),XRESLA(NLSA,NPRES,*) REAL*8 XVALB(NLIAB,4,*),XRESLB(NLSB,NPRES,*) REAL*8 FTOTA(NA1,*),XRES(NRES,NCRES,*),XREP(NREP,*) REAL*8 XPALB(NLIAB,*),XMREP(NLIAB,4,*) INTEGER ICHRES(*),INULA(*),INULB(*) INTEGER ILIREA(NLSA,*),ILIREB(NLSB,*) INTEGER IPALB(NLIAB,*),IMREP(NLIAB,*) REAL*8 WEXT(NA1,2),WINT(NA1,2),XCHPFB(2,NLIAB,4,*) * *-------------------------------------------------------------------- * Sauvegarde pour un pas courant : *-------------------------------------------------------------------- * IF (NRES.NE.0) THEN c +deplacement IF (ICHRES(1).GE.1) THEN DO 10 I=1,NA1 10 CONTINUE ENDIF c +vitesse IF (ICHRES(2).GE.1) THEN DO 12 I=1,NA1 12 CONTINUE * end do ENDIF c +deplacement demi-pas IF (ICHRES(3).GE.1) THEN DO 14 I=1,NA1 14 CONTINUE ENDIF c +vitesse demi-pas IF (ICHRES(4).GE.1) THEN DO 16 I=1,NA1 16 CONTINUE ENDIF c +acceleration IF (ICHRES(5).GE.1) THEN DO 18 I=1,NA1 18 CONTINUE ENDIF c +acceleration demi-pas IF (ICHRES(6).GE.1) THEN DO 20 I=1,NA1 20 CONTINUE ENDIF c +travail exterieur IF (ICHRES(7).GE.1) THEN DO 60 I=1,NA1 60 CONTINUE ENDIF c +travail interieur IF (ICHRES(8).GE.1) THEN DO 70 I=1,NA1 70 CONTINUE ENDIF ENDIF c +liaisons_A IF (ICHRES(9).GE.1) THEN DO 30 IL = 1,NLSA IIL = INULA(IL) II = 0 DO 32 IV = 1,NTVAR IF (ILIREA(IL,IV).EQ.1) THEN II = II + 1 XRESLA(IL,IINS2,II) = XVALA(IIL,1,IV) ENDIF 32 CONTINUE 30 CONTINUE ENDIF c +liaisons_B IF (ICHRES(10).GE.1) THEN c boucle sur les liaisons B DO 40 IL = 1,NLSB IIL = INULB(IL) II = 0 c boucle sur les grandeurs a sortir pour cette liaison DO 42 IV = 1,NTVAR * -sortie d'un LISTREEL IF (ILIREB(IL,IV).EQ.1) THEN II = II + 1 XRESLB(IL,IINS2,II) = XVALB(IIL,1,IV) c * --- bp debut du write --- c if(IINS2.le.2) then c write(*,*) '--------- liaison B',IL,'-------' c write(*,*) 'grandeur ',II,'issue de XVALB',IIL,IV c endif c * --- --- --- --- --- --- * -sortie d'un CHPOINT ELSEIF (ILIREB(IL,IV).EQ.2) THEN DO 43 IP=1,NPLB DO 44 ID=1,2 II = II + 1 XRESLB(IL,IINS2,II) = XCHPFB(ID,IIL,1,IP) 44 CONTINUE 43 CONTINUE ENDIF 42 CONTINUE 40 CONTINUE ENDIF * *-------------------------------------------------------------------- * Sauvegarde pour une reprise *-------------------------------------------------------------------- * IF (IINS2.EQ.NPRES) THEN DO 50 I=1,NA1 XREP(1,I) = Q1(I,1) XREP(2,I) = Q2(I,1) XREP(3,I) = Q1(I,2) XREP(4,I) = Q2(I,2) XREP(5,I) = Q3(I,1) XREP(6,I) = Q3(I,2) XREP(7,I) = FTOTA(I,1) XREP(8,I) = FTOTA(I,2) XREP(9,I) = WEXT(I,1) XREP(10,I)= WINT(I,1) 50 CONTINUE IF (NLIAB.NE.0) THEN DO 51 I = 1,NLIAB ITYP = IPALB(I,1) IMREP(I,1) = ITYP IMREP(I,2) = IPALB(I,2) * * ------ choc élémentaire POINT_PLAN_FROTTEMENT IF (ITYP.EQ.3 .OR. ITYP.EQ.103 ) THEN IDIM = IPALB(I,3) ID0 = 9 + 5*IDIM ID1 = 9 + 6*IDIM ID2 = 9 + 7*IDIM * c * ------ choc élémentaire POINT_CERCLE_FROTTEMENT sans amortissement c ELSEIF (ITYP.EQ.23.OR.ITYP.EQ.123) THEN c IDIM = IPALB(I,3) c ID0 = 6 + 6*IDIM c ID1 = 6 + 7*IDIM c ID2 = 6 + 8*IDIM cbp,2020 * * ------ choc élémentaire POINT_CERCLE_FROTTEMENT avec amortissement ELSE IF (ITYP.EQ.24.OR.ITYP.EQ.124) THEN IDIM = IPALB(I,3) c ID0 = 7 + 6*IDIM c ID1 = 7 + 7*IDIM c ID2 = 7 + 8*IDIM ID0 = 10 + 6*IDIM ID1 = 10 + 7*IDIM ID2 = 10 + 8*IDIM * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT avec amortissement * ------ choc élémentaire POINT_POINT_FROTTEMENT ELSE IF (ITYP.EQ.13.OR. ITYP.EQ.113 .OR. ITYP.EQ.-13 & .OR.ITYP.EQ.6) THEN IDIM = IPALB(I,3) ID0 = 7 + 4*IDIM ID1 = 7 + 5*IDIM ID2 = 7 + 6*IDIM * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT sans amortissement ELSE IF (ITYP.EQ.5 ) THEN IDIM = IPALB(I,3) ID0 = 6 + 4*IDIM ID1 = 6 + 5*IDIM ID2 = 6 + 6*IDIM * * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT * * ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN * * Ne sert pas pour l 'instant car modele d'ODEN de frottement * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26 & .or. ITYP.EQ.125 .OR. ITYP.EQ.126) THEN IDIM = IPALB(I,3) IF (ITYP.EQ.25) THEN IDD = 6 ELSE IDD = 7 ENDIF ID0 = IDD + 6*IDIM ID1 = IDD + 7*IDIM ID2 = IDD + 8*IDIM ID3 = IDD + 2*IDIM DO 82 ID = 1,IDIMB XMREP(I,1,ID) = XPALB(I,ID0+ID) XMREP(I,2,ID) = XPALB(I,ID1+ID) XMREP(I,3,ID) = XPALB(I,ID2+ID) XMREP(I,4,ID) = XPALB(I,ID3+ID) 82 CONTINUE * end do GOTO 51 * ------ choc élémentaire POINT_PLAN_FLUIDE * ELSE IF (ITYP.EQ.7) THEN IDIM = IPALB(I,3) ID1 = 6 + IDIM XMREP(I,1,1) = XPALB(I,ID1+1) XMREP(I,2,1) = XPALB(I,ID1+2) XMREP(I,3,1) = XPALB(I,ID1+3) GOTO 51 C si ityp = 100, on sauvegarde le depl. plastique C directement dans devso4 C NW idem si ITYP = 50/51 ou 16/17 --> dans devso4 C * * * ------ choc .... * * ELSE IF (ITYP.EQ. ) THEN * ... * ELSE GOTO 51 ENDIF c ID0+j : x_adhe c ID1+j : Vglissement c ID2+j : Fglissement DO 52 ID = 1,IDIMB XMREP(I,1,ID) = XPALB(I,ID0+ID) XMREP(I,2,ID) = XPALB(I,ID1+ID) XMREP(I,3,ID) = XPALB(I,ID2+ID) 52 CONTINUE * end do 51 CONTINUE * end do ENDIF ENDIF * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales