1 : C D2VLB1 SOURCE CHAT 05/01/12 22:35:34 5004 2 : C DEVLB1 SOURCE PETR 97/06/03 21:15:24 2709 3 : SUBROUTINE D2VLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB, 4 : & NPLB,IDIMB,XDT,NPAS,IND,FEXPSM,NPC1,IERRD, 5 : & FTEST,FTOTB0,XABSCI,XORDON,NIP,XCHPFB) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-H,O-Z) 8 : *--------------------------------------------------------------------* 9 : * * 10 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 11 : * ________________________________________________ * 12 : * * 13 : * Calcul des forces de choc sur base B. * 14 : * * 15 : * Paramètres: * 16 : * * 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 JPLIB Tableau contenant les numéros "GIBI" 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 : * e NLIAB Nombre de liaisons sur la base B. * 25 : * e NPLB Nombre total de points intervenant dans les liaisons. * 26 : * e IDIMB Nombre de directions. * 27 : * e XDT Tableau des pas de temps. * 28 : * e NPAS Numéro du pas de temps. * 29 : * e IND Indice du pas. * 30 : * e FEXPSM Tableau contenant les pseudo-modes. * 31 : * e NPC1 * 32 : * e XABSCI Tableau contenant les abscisses de la loi plastique * 33 : * pour la liaison point-point- ... -plastique * 34 : * e XORDON Tableau contenant les ordonnees de la loi plastique * 35 : * pour la liaison point-point- ... -plastique * 36 : * * 37 : * - FTEST Pour tester la force qui sert a enclencher * 38 : * les liaisons conditionnelles * 39 : * * 40 : * - FTOTB0 Pour conserver l'etat de FTOTB au cas ou l'increment * 41 : * est à annuler * 42 : * * 43 : * Auteur, date de création: * 44 : * * 45 : * Lionel VIVAN : le 22 Septembre 1989 : Création * 46 : * Bertrand BEAUFILS : le 31 Mai 1990 : Ajout frottement sec* 47 : * E de LANGRE : le 25 Aout1994 : liaison conditionnelle * 48 : * Ibrahim Pinto, 05/97 , liaisons ligne_cercle * 49 : *--------------------------------------------------------------------* 50 : * 51 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*) 52 : REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*) 53 : REAL*8 XVALB(NLIAB,4,*),XDT(*),FEXPSM(NPLB,NPC1,2,*) 54 : REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*) 55 : REAL*8 FTest(nplb,6) 56 : REAL*8 ftOTB0(NPLB,6),XCHPFB(2,NLIAB,4,*) 57 : 58 : 59 : ** npa, npam1, ind1, indm1 ne sevent que pour les modes negligés; 60 : ** mais comme de toute façon c'est mal fait car on ne tient pas compte des 61 : ** forces nl lors de la contribution des pseudomodes on s'en fiche 62 : 63 : NPA = NPAS 64 : NPAM1 = NPAS 65 : IND1 = 1 66 : INDM1 = 2 67 : 68 : * ind = 1 et ind2 = 2 sauf pour l'initialisation où ind = 2 et ind2 = 3 69 : IND2 = IND + 1 70 : PDT = XDT(NPAS) 71 : 72 : c PDTS2 = 0.5D0 * PDT 73 : PDTS2 = pdt 74 : 75 : * 76 : * Boucle sur le nombre de liaisons 77 : * 78 : DO 10 I = 1,NLIAB 79 : ITYP = IPALB(I,1) 80 : icond= IPALB(I,4) 81 : iannul= 0 82 : 83 : * --- cas des liaisons conditionnelles 84 : if (icond .eq. 1 ) then 85 : c 20 car on a defini nipalb = 20 dans dyne22 86 : DO 101 j = 5,20 87 : jliai = ipalb(i,j) 88 : jpliai = abs ( jliai) 89 : if ( jliai . EQ. 0 ) then 90 : goto 101 91 : else 92 : jtyp = ipalb(jpliai,1) 93 : do 102 ik = 1,nplb 94 : do 103 jk = 1,idimb 95 : ftest(ik,jk) = 0d0 96 : ftotb0 (ik,jk) = ftotb(ik,jk) 97 : 103 continue 98 : 102 continue 99 : IF (jTYP.EQ.1 .OR. jTYP.EQ.3 .OR. jTYP.EQ.103 100 : & .OR. jTYP.EQ.5 .OR. jTYP.EQ.6 .OR. jTYP.EQ.7 101 : & .OR. jTYP.EQ.100 .OR. jTYP.EQ.101 .OR. jTYP.EQ.102) THEN 101 : CALL DEVFB1(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab, 102 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 103 : & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul) 104 : ELSE IF (jTYP.EQ.11 .or. jTYP.EQ.111 105 : & .or. (abs(jTYP)).EQ.13 .OR. jTYP.EQ.113) THEN 105 : CALL DEVFB2(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab, 106 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 107 : & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul) 108 : ELSE IF (jTYP.EQ.21 .OR. jTYP.EQ.22 .OR. jTYP.EQ.23 .OR. 109 : & jTYP.EQ.24 .OR. jTYP.EQ.25 .OR. jTYP.EQ.26.OR.jTYP.EQ.33 110 : + .OR. jTYP.EQ.34 ) THEN 110 : CALL DEVFB3(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab, 111 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 112 : & FEXPSM,NPC1,jpliai,iannul) 113 : ELSE IF (jTYP.EQ.31 .OR. jTYP.EQ.32) THEN 113 : CALL DEVFB4(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab, 114 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 115 : & FEXPSM,NPC1,jpliai,IERRD,iannul) 116 : ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR. 117 : & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN 117 : CALL DEVFB5(jTYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 118 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 119 : & FEXPSM,NPC1,I,XABSCI,XORDON,NIP,iannul) 120 : ELSE IF (jTYP.EQ.35 .OR. jTYP.EQ.36) THEN 120 : CALL DEVFB6(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab, 121 : & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB) 122 : ELSE IF 123 : &(jTYP.EQ.37 .OR. jTYP.EQ.38 .OR. jTYP.EQ.39 .OR. JTYP.EQ.40) THEN 123 : CALL DEVFB7(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab, 124 : & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB) 125 : IF (IERRD.NE.0) RETURN 126 : ENDIF 127 : 128 : xff = 0.d0 129 : do 104 ik = 1,nplb 130 : do 105 jk = 1,idimb 131 : xff = xff + ( ftest(ik,jk) ** 2) 132 : 105 continue 133 : 104 continue 134 : xff = xff ** .5 135 : if ( ((xff .le. 1e-20 ) .and. ( jliai .gt. 0) ) 136 : & .OR. ((xff .gt. 1e-20 ) .and. ( jliai .lt. 0) ) ) 137 : & then 138 : iannul = 1 139 : endif 140 : 141 : endif 142 : 101 continue 143 : * --- fin du cas des liaisons conditionnelles 144 : endif 145 : * 146 : * ------ choc ..._PLAN 147 : * 148 : ** ianis 149 : IF (ITYP.EQ.1 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103 150 : & .OR. ITYP.EQ.5 .OR. ITYP.EQ.6 .OR. ITYP.EQ.7 151 : & .OR. ITYP.EQ.100 .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN 152 : * 152 : CALL DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 153 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 154 : & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul) 155 : * 156 : * ------ choc ..._POINT 157 : * 158 : ELSE IF (ITYP.EQ.11 .or. ITYP.EQ.111 159 : & .or. (abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN 159 : CALL DEVFB2(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 160 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 161 : & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul) 162 : * 163 : * ------ choc POINT_POINT_ ... _PLASTIQUE 164 : * 165 : ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR. 166 : & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN 167 : * 167 : CALL DEVFB5(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,NPLB, 168 : & IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,FEXPSM,NPC1, 169 : & I,XABSCI,XORDON,NIP,iannul) 170 : * 171 : * ------ choc ..._CERCLE(sauf ligne_cercle) 172 : * 173 : ELSE IF (ITYP.EQ.21 .OR. ITYP.EQ.22 .OR. ITYP.EQ.23 .OR. 174 : & ITYP.EQ.24 .OR. ITYP.EQ.25 .OR. ITYP.EQ.26.OR.ITYP.EQ.33 175 : + .OR. ITYP.EQ.34 ) THEN 175 : CALL DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 176 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 177 : & FEXPSM,NPC1,I,iannul) 178 : * 179 : * ------ choc PROFIL_PROFIL_... 180 : * 181 : ELSE IF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN 181 : CALL DEVFB4(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 182 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 183 : & FEXPSM,NPC1,I,IERRD,iannul) 184 : IF (IERRD.NE.0) RETURN 185 : * 186 : * ------ choc LIGNE_LIGNE 187 : * 188 : ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN 188 : CALL DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 189 : & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB) 190 : 191 : 192 : 193 : * 194 : *---------choc LIGNE_CERCLE 195 : * 196 : 197 : 198 : 199 : ELSE IF (ITYP.EQ.37 .OR. ITYP.EQ.38 200 : & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN 200 : CALL DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 201 : & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB) 202 : 203 : 204 : 205 : * 206 : * ------ choc ........... 207 : * 208 : * ELSE IF (ITYP.EQ. ) THEN 208 : * CALL DEVFB (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB, 209 : * & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2, 210 : * & FEXPSM,NPC1,I,iannul) 211 : ENDIF 212 : 213 : 214 : * la suite ne sert à rien après le passage de iannul dans les 215 : * s_p de calcul des forces de laison. 216 : 217 : 218 : * si la liaisn était annulée on l'annule 219 : * if ( ( icond.eq. 1 ) .and. ( iannul.eq.1)) then 220 : * on annulle l'increment de ftotb 221 : 222 : * do 112 ik = 1,nplb 223 : * do 113 jk = 1,idimb 224 : * ftotb (ik,jk) = ftotb0(ik,jk) 225 : * 113 continue 226 : * 112 continue 227 : * end if 228 : 229 : 10 CONTINUE 230 : 231 : 232 : END 233 : 234 : 235 : 236 : 237 : 238 : 239 : 240 : 241 : 242 :
© Cast3M 2003 - All rights reserved.
Disclaimer