C DEVTR1 SOURCE CHAT 05/01/12 22:47:45 5004 SUBROUTINE DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES, & 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 : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * 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 ) * * * Auteur, date de création: * * * * Denis ROBERT-MOUGIN, le 31 mai 1989. * * * *--------------------------------------------------------------------* 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 KRES = 0 IF (ICHRES(1).EQ.1) THEN KRES = KRES + 1 DO 10 I=1,NA1 XRES(KRES,I,IINS2) = Q1(I,1) 10 CONTINUE ENDIF * end do IF (ICHRES(2).EQ.1) THEN KRES = KRES + 1 DO 12 I=1,NA1 XRES(KRES,I,IINS2) = Q2(I,1) 12 CONTINUE * end do ENDIF IF (ICHRES(3).EQ.1) THEN KRES = KRES + 1 DO 14 I=1,NA1 XRES(KRES,I,IINS2) = Q1(I,2) 14 CONTINUE * end do ENDIF IF (ICHRES(4).EQ.1) THEN KRES = KRES + 1 DO 16 I=1,NA1 XRES(KRES,I,IINS2) = Q2(I,2) 16 CONTINUE * end do ENDIF IF (ICHRES(5).EQ.1) THEN KRES = KRES + 1 DO 18 I=1,NA1 XRES(KRES,I,IINS2) = Q3(I,1) 18 CONTINUE * end do ENDIF IF (ICHRES(6).EQ.1) THEN KRES = KRES + 1 DO 20 I=1,NA1 XRES(KRES,I,IINS2) = Q3(I,2) 20 CONTINUE * end do ENDIF ENDIF c ianis cc travaux IF (ICHRES(7).EQ.1) THEN KRES = KRES + 1 DO 60 I=1,NA1 XRES(KRES,I,IINS2) = WEXT(I,1) 60 CONTINUE ENDIF IF (ICHRES(7).EQ.1) THEN KRES = KRES + 1 DO 70 I=1,NA1 XRES(KRES,I,IINS2) = WINT(I,1) 70 CONTINUE ENDIF IF (ICHRES(9).EQ.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 * end do 30 CONTINUE * end do ENDIF IF (ICHRES(10).EQ.1) THEN DO 40 IL = 1,NLSB IIL = INULB(IL) II = 0 DO 42 IV = 1,NTVAR IF (ILIREB(IL,IV).EQ.1) THEN II = II + 1 XRESLB(IL,IINS2,II) = XVALB(IIL,1,IV) ELSE IF (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 * ENDIF 42 CONTINUE * end do 40 CONTINUE * end do 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 * end do 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_CERCLE_FROTTEMENT sans amortissement * IF (ITYP.EQ.23) THEN IDIM = IPALB(I,3) ID0 = 6 + 6*IDIM ID1 = 6 + 7*IDIM ID2 = 6 + 8*IDIM * * ------ choc élémentaire POINT_CERCLE_FROTTEMENT avec amortissement * ELSE IF (ITYP.EQ.24) THEN IDIM = IPALB(I,3) ID0 = 7 + 6*IDIM ID1 = 7 + 7*IDIM ID2 = 7 + 8*IDIM * * ------ choc élémentaire POINT_PLAN_FROTTEMENT * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT avec amortissement * ------ choc élémentaire POINT_POINT_FROTTEMENT * ELSE IF (ITYP.EQ.3 .or. 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) 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 NW on boucle sur ID = 1,IDIMB * 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