Télécharger devlb1.eso

Retour à la liste

Numérotation des lignes :

devlb1
  1. C DEVLB1 SOURCE BP208322 20/09/18 21:15:36 10718
  2.  
  3. SUBROUTINE DEVLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB,
  4. & NPLB,IDIMB,PDT,NPAS,IND,FEXPSM,NPC1,IERRD,
  5. & FTEST,XABSCI,XORDON,NIP,XCHPFB)
  6.  
  7. *--------------------------------------------------------------------*
  8. * Opérateur DYNE (de Vogelaere) *
  9. * Calcul des forces de choc base B *
  10. *--------------------------------------------------------------------*
  11. * *
  12. * Paramètres: *
  13. * *
  14. * es FTOTB Forces extérieures totalisées sur la base B. *
  15. * e XPTB Tableau des déplacements des points *
  16. * e IPALB Renseigne sur la liaison. *
  17. * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
  18. * e JPLIB Tableau contenant les numéros "GIBI" de la liaison. *
  19. * e XPALB Tableau contenant les paramètres de la liaison. *
  20. * es XVALB Tableau contenant les variables internes de liaisons. *
  21. * e NLIAB Nombre de liaisons sur la base B. *
  22. * e NPLB Nombre total de points intervenant dans les liaisons. *
  23. * e IDIMB Nombre de directions. *
  24. * e PDT pas de temps. *
  25. * e NPAS Numéro du pas de temps. *
  26. * e IND Indice du pas. *
  27. * e FEXPSM Tableau contenant les pseudo-modes. *
  28. * e NPC1 *
  29. * e XABSCI Tableau contenant les abscisses de la loi plastique *
  30. * pour la liaison point-point- ... -plastique *
  31. * e XORDON Tableau contenant les ordonnees de la loi plastique *
  32. * pour la liaison point-point- ... -plastique *
  33. * *
  34. * - FTEST Pour tester la force qui sert a enclencher *
  35. * les liaisons conditionnelles *
  36. * *
  37. *--------------------------------------------------------------------*
  38.  
  39. IMPLICIT INTEGER(I-N)
  40. IMPLICIT REAL*8(A-H,O-Z)
  41. *
  42. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*)
  43. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,2,*),FTOTB(NPLB,*)
  44. REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  45. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*)
  46. REAL*8 FTEST(NPLB,6)
  47. REAL*8 XCHPFB(2,NLIAB,4,*)
  48. * tableaux fortran locaux pour l'instant -> a mettre dans LOCLFB ?
  49. REAL*8 KTOTXB(NPLB,IDIMB,IDIMB),KTOTVB(NPLB,IDIMB,IDIMB)
  50.  
  51. *--------------------------------------------------------------------*
  52. *old IND ,IND2 : indice courant et precedent
  53. *new IND ,IND2 : depl et vitesse courant
  54. * |_______________ pas de temps _______________|
  55. * ____ algorithme ___|__ ind=1 __|__ ind=2 __|_ind=3_|__ ind=4 __|
  56. *old De_Vogelaere | t_{n+1} | t_{n+1/2} | t_n | t_{n-1/2} |
  57. * ~. ~.
  58. *new De_Vogelaere | x_{n+1} | x_{n+1} | x_n | x_{n-1/2} |
  59. * ~.
  60. * x =estimation de la vitesse
  61. *---------------------------------------------------------------------*
  62. * NPA ,IND1 : pas et indice courant pour les pseudo-modes
  63. * NPAM1,INDM1 : pas et indice precedent pour les pseudo-modes
  64. *---------------------------------------------------------------------*
  65. IF (IND.EQ.1) THEN
  66. NPA = NPAS + 1
  67. NPAM1 = NPAS + 1
  68. IND1 = 1
  69. INDM1 = 2
  70. ELSEIF (IND.EQ.2) THEN
  71. NPA = NPAS + 1
  72. NPAM1 = NPAS
  73. IND1 = 2
  74. INDM1 = 1
  75. ELSE
  76. c cas particulier de l'initialisation
  77. NPA = NPAS
  78. NPAM1 = NPAS
  79. IND1 = 1
  80. INDM1 = 2
  81. ENDIF
  82. IND2 = IND + 1
  83. PDTS2 = 0.5D0 * PDT
  84.  
  85. *--------------------------------------------------------------------*
  86. *
  87. * Boucle sur le nombre de liaisons
  88. *
  89. *--------------------------------------------------------------------*
  90. DO 10 I = 1,NLIAB
  91.  
  92. ITYP = IPALB(I,1)
  93. icond= IPALB(I,4)
  94. iannul= 0
  95.  
  96. * --- cas des liaisons conditionnelles
  97. if (icond .eq. 1 ) then
  98. c 20 car on a defini nipalb = 20 dans dyne22
  99. DO 101 j = 5,20
  100. jliai = ipalb(i,j)
  101. jpliai = abs ( jliai)
  102. if ( jliai . EQ. 0 ) then
  103. goto 101
  104. else
  105. jtyp = ipalb(jpliai,1)
  106. do 102 ik = 1,nplb
  107. do 103 jk = 1,idimb
  108. ftest(ik,jk) = 0d0
  109. cbp, supprime le 2019-01-15 ftotb0 (ik,jk) = ftotb(ik,jk)
  110. 103 continue
  111. 102 continue
  112. IF (jTYP.EQ.1 .OR. jTYP.EQ.3 .OR. jTYP.EQ.103
  113. & .OR. jTYP.EQ.5 .OR. jTYP.EQ.6 .OR. jTYP.EQ.7
  114. & .OR. jTYP.EQ.100 .OR. jTYP.EQ.101 .OR. jTYP.EQ.102) THEN
  115. CALL DEVFB1(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  116. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  117. & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul,
  118. & KTOTXB,KTOTVB,IDIMB,.false.)
  119. ELSEIF (jTYP.EQ.11 .or. jTYP.EQ.111
  120. & .or. (abs(jTYP)).EQ.13 .OR. jTYP.EQ.113) THEN
  121. CALL DEVFB2(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  122. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  123. & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul)
  124. ELSEIF (jTYP.EQ.21 .OR. jTYP.EQ.22 .OR. jTYP.EQ.23
  125. & .OR. jTYP.EQ.24 .OR. jTYP.EQ.25 .OR. jTYP.EQ.26
  126. & .OR. jTYP.EQ.33 .OR. jTYP.EQ.34 .OR. jTYP.EQ.123
  127. & .OR. jTYP.EQ.124 .OR. jTYP.EQ.125 .OR. jTYP.EQ.126
  128. & .OR. jTYP.EQ.133 .OR. jTYP.EQ.134 ) THEN
  129. CALL DEVFB3(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  130. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  131. & FEXPSM,NPC1,jpliai,iannul,
  132. & KTOTXB,KTOTVB,IDIMB,.false.)
  133. ELSEIF (jTYP.EQ.31 .OR. jTYP.EQ.32) THEN
  134. CALL DEVFB4(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  135. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  136. & FEXPSM,NPC1,jpliai,IERRD,iannul)
  137. ELSEIF (ITYP.EQ.16 .OR. ITYP.EQ.17
  138. & .OR. ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  139. CALL DEVFB5(jTYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  140. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  141. & FEXPSM,NPC1,I,XABSCI,XORDON,NIP,iannul)
  142. ELSEIF (jTYP.EQ.35 .OR. jTYP.EQ.36) THEN
  143. CALL DEVFB6(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  144. & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
  145. ELSEIF (jTYP.EQ.37 .OR. jTYP.EQ.38
  146. & .OR. jTYP.EQ.39 .OR. JTYP.EQ.40) THEN
  147. CALL DEVFB7(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  148. & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
  149. IF (IERRD.NE.0) RETURN
  150. ENDIF
  151.  
  152. xff = 0.d0
  153. do 104 ik = 1,nplb
  154. do 105 jk = 1,idimb
  155. xff = xff + ( ftest(ik,jk) ** 2)
  156. 105 continue
  157. 104 continue
  158. xff = xff ** .5
  159. if ( ((xff .le. 1e-20 ) .and. ( jliai .gt. 0) )
  160. & .OR. ((xff .gt. 1e-20 ) .and. ( jliai .lt. 0) ) )
  161. & then
  162. iannul = 1
  163. endif
  164.  
  165. endif
  166. 101 continue
  167.  
  168. endif
  169. * --- fin du cas des liaisons conditionnelles
  170.  
  171.  
  172. * ------ choc ..._PLAN
  173. *
  174. IF (ITYP.EQ.1 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103
  175. & .OR. ITYP.EQ.5 .OR. ITYP.EQ.6 .OR. ITYP.EQ.7
  176. & .OR. ITYP.EQ.100 .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN
  177. *
  178. CALL DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  179. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  180. & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul,
  181. & KTOTXB,KTOTVB,IDIMB,.false.)
  182. *
  183. * ------ choc ..._POINT
  184. *
  185. ELSEIF (ITYP.EQ.11 .or. ITYP.EQ.111
  186. & .or. (abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN
  187. CALL DEVFB2(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  188. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  189. & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
  190. *
  191. * ------ choc ..._CERCLE(sauf ligne_cercle)
  192. *
  193. ELSEIF (ITYP.EQ.21 .OR. ITYP.EQ.22 .OR. ITYP.EQ.23
  194. & .OR. ITYP.EQ.24 .OR. ITYP.EQ.25 .OR. ITYP.EQ.26
  195. & .OR. ITYP.EQ.33 .OR. ITYP.EQ.34 .OR. jTYP.EQ.123
  196. & .OR. jTYP.EQ.124 .OR. jTYP.EQ.125 .OR. jTYP.EQ.126
  197. & .OR. jTYP.EQ.133 .OR. jTYP.EQ.134 ) THEN
  198.  
  199. CALL DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  200. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  201. & FEXPSM,NPC1,I,iannul,
  202. & KTOTXB,KTOTVB,IDIMB,.false.)
  203. *
  204. * ------ choc PROFIL_PROFIL_...
  205. *
  206. ELSEIF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN
  207. CALL DEVFB4(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  208. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  209. & FEXPSM,NPC1,I,IERRD,iannul)
  210. IF (IERRD.NE.0) RETURN
  211. *
  212. * ------ choc POINT_POINT_ ... _PLASTIQUE
  213. *
  214. ELSEIF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR.
  215. & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  216. *
  217. CALL DEVFB5(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,NPLB,
  218. & IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,FEXPSM,NPC1,
  219. & I,XABSCI,XORDON,NIP,iannul)
  220. *
  221. * ------ choc LIGNE_LIGNE
  222. *
  223. ELSEIF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN
  224. CALL DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  225. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  226.  
  227. *
  228. *------- choc LIGNE_CERCLE
  229. *
  230. ELSEIF (ITYP.EQ.37 .OR. ITYP.EQ.38
  231. & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN
  232. CALL DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  233. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  234. *
  235. * ------ liaison PALIER_FLUIDE
  236.  
  237. ELSEIF (ITYP.EQ.60) THEN
  238. CALL DEVFB8(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  239. & NPLB,IND,IND2,PDTS2,I,iannul)
  240.  
  241. *
  242. * ------ choc ...........
  243. *
  244. * ELSEIF (ITYP.EQ. ) THEN
  245. * CALL DEVFB (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  246. * & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  247. * & FEXPSM,NPC1,I,iannul)
  248. ENDIF
  249.  
  250.  
  251. 10 CONTINUE
  252.  
  253.  
  254. END
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales