1 : C DEVFB6 SOURCE CHAT 05/01/12 22:45:39 5004 2 : SUBROUTINE DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 3 : & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 9 : * ________________________________________________ * 10 : * * 11 : * Calcul des forces de choc sur base B pour les liaisons de * 12 : * type LIGNE_LIGNE * 13 : * * 14 : * Paramètres: * 15 : * * 16 : * e ITYP type de la liaison. * 17 : * es FTOTB Forces extérieures totalisées sur la base B. * 18 : * e XPTB Tableau des déplacements des points * 19 : * e IPALB Renseigne sur la liaison. * 20 : * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. * 21 : * e XPALB Tableau contenant les paramètres de la liaison. * 22 : * es XVALB Tableau contenant les variables internes de liaisons. * 23 : * es XCHPFB Tableau contenant les valeurs des futurs chpoints * 24 : * e NLIAB Nombre de liaisons sur la base B. * 25 : * e NPLB Nombre total de points intervenant dans les liaisons. * 26 : * e IND Indice du pas. * 27 : * e I numéro de la liaison. * 28 : * * 29 : * * 30 : * Auteur, date de création: * 31 : * * 32 : * Samuel DURAND : le 18 Octobre 1996 : Création * 33 : * * 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 : * Initialisations 41 : * 42 : * 43 : XVALB(I,IND,1) =0.D0 44 : XVALB(I,IND,3) =0.D0 45 : XVALB(I,IND,4) =0.D0 46 : XVALB(I,IND,5) =0.D0 47 : XVALB(I,IND,6) =0.D0 48 : XVALB(I,IND,10) = 0.D0 49 : XVALB(I,IND,11) = 0.D0 50 : XVALB(I,IND,12) = 0.D0 51 : IDIM = IPALB(I,3) 52 : IF (ITYP.EQ.35) THEN 53 : ID1 = 6 54 : ELSE 55 : ID1 = 7 56 : ENDIF 57 : NNOEES = IPALB(I,22) 58 : NNOEMA=IPALB(I,21) 59 : IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM 60 : ICH = 26 + NNOEMA+NNOEES 61 : ICG = 26 + 2*(NNOEMA+NNOEES) 62 : DO 5 J=1,(NNOEMA+NNOEES) 63 : IPALB(I,ICH+J) = 0 64 : IPALB(I,ICG+J) = 0 65 : DO 7 ID=1,IDIM 66 : XPALB(I,IFO+ID) = 0.D0 67 : 7 CONTINUE 68 : IFO = IFO + IDIM 69 : 5 CONTINUE 70 : IF (IDIM.EQ.3) THEN 71 : IDIMB=6 72 : ELSE 73 : IDIMB=3 74 : ENDIF 75 : DO 8 IP=1,NPLB 76 : XCHPFB(1,I,IND,IP)=0.D0 77 : XCHPFB(2,I,IND,IP)=0.D0 78 : 8 CONTINUE 79 : ******************************************************************* 80 : * On s'intéresse au choc des noeuds esclaves sur le maillage maitre 81 : ******************************************************************* 82 : ILOCAL=IPALB(I,23) 83 : * Recherche des plus proches voisins 83 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0) 84 : * Boucle sur tous les noeuds esclaves 85 : DO 10 IESC=1,NNOEES 85 : CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND 86 : &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB) 87 : 10 CONTINUE 88 : *************************** 89 : * Traitement symétrique 90 : *************************** 91 : ISYM=IPALB(I,26) 92 : IF (ISYM.EQ.0.OR.ISYM.EQ.1) THEN 93 : * On renverse les roles du maitre et de l esclave 93 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1) 94 : IF (ISYM.EQ.0) THEN 95 : * symétrie globale 96 : * boucle sur tous les noeuds maitres 97 : DO 20 IMAI=1,NNOEMA 97 : CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND 98 : &,IND2,PDTS2,I,IANNUL,IMAI,1,XCHPFB) 99 : 20 CONTINUE 100 : ELSE 101 : * symétrie locale 102 : * 103 : * 104 : IREF=1 105 : INOE=1 106 : ICH = 26 + NNOEES+NNOEMA 107 : ICG = 26 + 2*(NNOEES+NNOEMA) 108 : 30 CONTINUE 109 : IF (IPALB(I,ICH+INOE).EQ.1) THEN 110 : * Ce noeud a précédemment été sollicité 110 : CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB, 111 : &IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB) 112 : IMOINS=INOE-1 113 : 35 CONTINUE 114 : IF (IMOINS.NE.0.AND.IMOINS.NE.IREF) THEN 115 : * On regarde avant 115 : CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB, 116 : &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,IMOINS,1,XCHPFB) 117 : IAPRES=IPALB(I,ICG+IMOINS)+IPALB(I,ICH+IMOINS) 118 : IF (IAPRES.GT.IPALB(I,ICH+IMOINS)) THEN 119 : IMOINS=IMOINS-1 120 : GOTO 35 121 : ENDIF 122 : ENDIF 123 : INOE=INOE+1 124 : 36 CONTINUE 125 : * On regarde apres 125 : CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB, 126 : &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB) 127 : IAPRES=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE) 128 : IF (IAPRES.GT.IPALB(I,ICH+INOE)) THEN 129 : IF (INOE.NE.NNOEMA) THEN 130 : INOE=INOE+1 131 : GOTO 36 132 : ENDIF 133 : ELSE 134 : IREF=INOE 135 : IF (INOE.NE.NNOEMA) THEN 136 : INOE=INOE+1 137 : GOTO 30 138 : ENDIF 139 : ENDIF 140 : ELSE 141 : IF (INOE.NE.NNOEMA) THEN 142 : INOE=INOE+1 143 : GOTO 30 144 : ENDIF 145 : ENDIF 146 : ENDIF 147 : * On pondère les forces 148 : ICH = 26 + NNOEES+NNOEMA 149 : ICG = 26 + 2*(NNOEES+NNOEMA) 150 : IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM 151 : DO 21 INOE=1,(NNOEES+NNOEMA) 152 : IPALB(I,ICH+INOE)=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE) 153 : IF (IPALB(I,ICH+INOE).EQ.2) THEN 154 : DO 22 ID=1,IDIM 155 : FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+ 156 : &XPALB(I,IFO+ID)/2. 157 : 22 CONTINUE 158 : XCHPFB(1,I,IND,IPLIB(I,INOE))= 159 : &XCHPFB(1,I,IND,IPLIB(I,INOE))/2. 160 : XCHPFB(2,I,IND,IPLIB(I,INOE))= 161 : &XCHPFB(2,I,IND,IPLIB(I,INOE))/2. 162 : ELSE 163 : DO 23 ID=1,IDIM 164 : FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+ 165 : &XPALB(I,IFO+ID) 166 : 23 CONTINUE 167 : ENDIF 168 : IFO = IFO+IDIM 169 : 21 CONTINUE 170 : ELSE 171 : ****************** 172 : * pas de symétrie 173 : ****************** 174 : IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM 175 : DO 40 INOE=1,(NNOEMA+NNOEES) 176 : DO 42 ID=1,IDIM 177 : FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+ 178 : &XPALB(I,IFO+ID) 179 : 42 CONTINUE 180 : IFO = IFO+IDIM 181 : 40 CONTINUE 182 : * 183 : * 184 : ENDIF 185 : * 186 : * 187 : END 188 : 189 :
© Cast3M 2003 - All rights reserved.
Disclaimer