1 : C DEVFB7 SOURCE CHAT 05/01/12 22:45:43 5004 2 : C DEVFB6 SOURCE LAVARENN 96/10/30 21:16:12 2349 3 : SUBROUTINE DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 4 : & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : *--------------------------------------------------------------------* 8 : * * 9 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 10 : * ________________________________________________ * 11 : * * 12 : * Calcul des forces de choc sur base B pour les liaisons de * 13 : * type LIGNE_CERCLE * 14 : * * 15 : * Paramètres: * 16 : * * 17 : * e ITYP type de la liaison. * 18 : * es FTOTB Forces extérieures totalisées sur la base B. * 19 : * e XPTB Tableau des déplacements des points * 20 : * e IPALB Renseigne sur la liaison. * 21 : * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. * 22 : * e XPALB Tableau contenant les paramètres de la liaison. * 23 : * es XVALB Tableau contenant les variables internes de liaisons. * 24 : * es XCHPFB Tableau contenant les valeurs des futurs chpoints * 25 : * e NLIAB Nombre de liaisons sur la base B. * 26 : * e NPLB Nombre total de points intervenant dans les liaisons. * 27 : * e IND Indice du pas. * 28 : * e I numéro de la liaison. * 29 : * * 30 : * * 31 : * Auteur, date de création: * 32 : * * 33 : * Ibrahim PINTO, 05/97 * 34 : *--------------------------------------------------------------------* 35 : * 36 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*) 37 : REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*) 38 : REAL*8 XVALB(NLIAB,4,*),XCHPFB(2,NLIAB,4,*) 39 : 40 : 41 : 42 : 43 : * 44 : * Initialisations 45 : * 46 : * 47 : XVALB(I,IND,1) =0.D0 48 : XVALB(I,IND,3) =0.D0 49 : XVALB(I,IND,4) =0.D0 50 : XVALB(I,IND,5) =0.D0 51 : XVALB(I,IND,6) =0.D0 52 : XVALB(I,IND,10) = 0.D0 53 : XVALB(I,IND,11) = 0.D0 54 : XVALB(I,IND,12) = 0.D0 55 : IDIM = IPALB(I,3) 56 : IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN 57 : ID1 = 6 58 : ELSE 59 : ID1 = 7 60 : ENDIF 61 : NNOEES = IPALB(I,22) 62 : NNOEMA=IPALB(I,21) 63 : IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM 64 : ICH = 26 + NNOEMA+NNOEES 65 : ICG = 26 + 2*(NNOEMA+NNOEES) 66 : DO 5 J=1,(NNOEMA+NNOEES) 67 : IPALB(I,ICH+J) = 0 68 : IPALB(I,ICG+J) = 0 69 : DO 7 ID=1,IDIM 70 : XPALB(I,IFO+ID) = 0.D0 71 : 7 CONTINUE 72 : IFO = IFO + IDIM 73 : 5 CONTINUE 74 : IF (IDIM.EQ.3) THEN 75 : IDIMB=6 76 : ELSE 77 : IDIMB=3 78 : ENDIF 79 : DO 8 IP=1,NPLB 80 : XCHPFB(1,I,IND,IP)=0.D0 81 : XCHPFB(2,I,IND,IP)=0.D0 82 : 8 CONTINUE 83 : ******************************************************************* 84 : * On s'intéresse au choc des noeuds esclaves sur le maillage maitre 85 : ******************************************************************* 86 : 87 : 88 : 89 : ILOCAL=IPALB(I,23) 90 : ISYM = IPALB(I,26) 91 : 92 : 93 : IF (ISYM.EQ.1 .OR. ISYM.EQ.0) THEN 94 : 95 : ******************************************************************** 96 : * On s'intéresse au choc des noeuds maitres sur le maillage esclave* 97 : ******************************************************************** 98 : 99 : * Recherche des plus proches voisins 99 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1) 100 : * Boucle sur tous les noeuds MAITRES 101 : DO 10 IESC=1,NNOEMA 101 : CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND 102 : &,IND2,PDTS2,I,IANNUL,IESC,1,XCHPFB) 103 : 10 CONTINUE 104 : 105 : 106 : ELSE 107 : 108 : 109 : ******************************************************************** 110 : * On s'intéresse au choc des noeuds esclaves sur le maillage maitre* 111 : ******************************************************************** 112 : 113 : * Recherche des plus proches voisins 113 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0) 114 : * Boucle sur tous les noeuds esclaves 115 : DO 20 IESC=1,NNOEES 115 : CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND 116 : &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB) 117 : 20 CONTINUE 118 : 119 : ENDIF 120 : 121 : 122 : IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM 123 : DO 40 INOE=1,(NNOEMA+NNOEES) 124 : DO 42 ID=1,IDIM 125 : FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+ 126 : &XPALB(I,IFO+ID) 127 : 42 CONTINUE 128 : IFO = IFO+IDIM 129 : 40 CONTINUE 130 : * 131 : * 132 : 133 : END 134 : 135 : 136 : 137 :
© Cast3M 2003 - All rights reserved.
Disclaimer