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