Télécharger d3valg.eso

Retour à la liste

Numérotation des lignes :

  1. C D3VALG SOURCE BP208322 18/01/30 21:15:09 9719
  2. C
  3. C D2VALG SOURCE BP208322 18/01/05 21:15:09 9672
  4. SUBROUTINE D3VALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,
  5. & KTRES,KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS,
  6. & RIGIDE,BETA)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. *--------------------------------------------------------------------*
  10. * *
  11. * Opérateur DYNE : algorithme newmark acc moyenne *
  12. * ________________________________________________ *
  13. * *
  14. * Mise en oeuvre de l'algorithme. *
  15. * *
  16. * Paramètres: *
  17. * *
  18. * es KTQ Segment contenant les variables généralisées *
  19. * (et les travaux)
  20. * es KTKAM Segment contenant les vecteurs XK, XASM et XM *
  21. * es KTPHI Segment contenant les déformées modales *
  22. * es KTLIAA Segment descriptif des liaisons en base A *
  23. * es KTLIAB Segment descriptif des liaisons en base B *
  24. * es KTFEX Segment contenant les chargements libres *
  25. * es KTPAS Segment des variables au cours d'un pas de temps *
  26. * es KTRES Segment de sauvegarde des résultats *
  27. * es KTNUM Segment contenant les paramètres numériques *
  28. * es KPREF Segment des points de référence *
  29. * e NINS On veut une sortie tous les NINS pas de calcul *
  30. * e REPRIS Vrai si reprise de calcul, faux sinon *
  31. * e RIGIDE Vrai si l'on a un corps rigide, faux sinon *
  32. * e BETA = valeur du parametre BETA du Newmark *
  33. * *
  34. * inspire de D2VALG *
  35. * *
  36. *--------------------------------------------------------------------*
  37. SEGMENT,MTQ
  38. REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  39. REAL*8 WEXT(NA1,2),WINT(NA1,2)
  40. ENDSEGMENT
  41. SEGMENT,MTKAM
  42. REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  43. REAL*8 XOPER(NB1,NB1,NOPER)
  44. ENDSEGMENT
  45. SEGMENT,MTPHI
  46. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  47. INTEGER IAROTA(NSB)
  48. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  49. ENDSEGMENT
  50. SEGMENT,MTLIAA
  51. INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  52. REAL*8 XPALA(NLIAA,NXPALA)
  53. ENDSEGMENT
  54. SEGMENT,MTLIAB
  55. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  56. REAL*8 XPALB(NLIAB,NXPALB)
  57. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  58. ENDSEGMENT
  59. SEGMENT,MTFEX
  60. REAL*8 FEXA(NPFEXA,NPC1,2)
  61. REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB)
  62. REAL*8 FTEXB(NPLB,NPC1,2,IDIM)
  63. INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  64. ENDSEGMENT
  65. SEGMENT,MTPAS
  66. REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1)
  67. REAL*8 XPTB(NPLB,4,IDIMB),FINERT(NA1,4)
  68. REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR)
  69. REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB)
  70. ENDSEGMENT
  71. SEGMENT,MTRES
  72. REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
  73. REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
  74. REAL*8 XMREP(NLIAB,4,IDIMB)
  75. INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP)
  76. INTEGER ILIRES(NRESLI,NCRES)
  77. INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
  78. INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
  79. INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
  80. INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
  81. INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
  82. INTEGER ILPOLA(NLIAA,2)
  83. ENDSEGMENT
  84. SEGMENT,MTNUM
  85. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  86. ENDSEGMENT
  87. SEGMENT,MPREF
  88. INTEGER IPOREF(NPREF)
  89. ENDSEGMENT
  90. * Segment "local" pour DEVLFA ...
  91. SEGMENT,LOCLFA
  92. REAL*8 FTEST(NA1,4),FTOTA0(NA1,4)
  93. ENDSEGMENT
  94. * Segment "local" pour DEVLB1 ...
  95. SEGMENT,LOCLB1
  96. REAL*8 FTEST2(NPLB,6),FTOTB0(NPLB,6)
  97. ENDSEGMENT
  98. *
  99. LOGICAL L0,L1,REPRIS,RIGIDE
  100. CHARACTER*8 TYPRET
  101. c parametre du Newmark (acc. moyenne par defaut)
  102. REAL*8 GAMMA,BETA
  103. DATA GAMMA /0.5D0/
  104. c DATA BETA /0.25D0/
  105.  
  106. *
  107. MTQ = KTQ
  108. MTKAM = KTKAM
  109. MTNUM = KTNUM
  110. MTFEX = KTFEX
  111. MPREF = KPREF
  112. MTRES = KTRES
  113. MTPAS = KTPAS
  114. LOCLFA = KOCLFA
  115. LOCLB1 = KOCLB1
  116. NP = XDT(/1) - 1
  117. NA1 = Q2(/1)
  118. NB1K = XK(/2)
  119. NB1C = XASM(/2)
  120. NB1M = XM(/2)
  121. NB1 = XOPER(/1)
  122. NOPER = XOPER(/3)
  123. NRES = XRES(/1)
  124. NREP = XREP(/1)
  125. NCRES = XRES(/2)
  126. NPRES = XRES(/3)
  127. NPFEXA = FEXA(/1)
  128. NPC1 = FEXA(/2)
  129. MTLIAA = KTLIAA
  130. NLIAA = IPALA(/1)
  131. NLSA = INULA(/1)
  132. MTPHI = KTPHI
  133. MTLIAB = KTLIAB
  134. NLIAB = IPALB(/1)
  135. NLSB = INULB(/1)
  136. NPLB = JPLIB(/1)
  137. NA2 = XPHILB(/3)
  138. IDIMB = XPHILB(/4)
  139. NTVAR = ILIREB(/2)
  140. NIP = XABSCI(/2)
  141. NSB = INMSB(/1)
  142. IERRD = 0
  143. *
  144. * Boucle sur les pas de calcul:
  145. *
  146. IINS = 0
  147. IINS2 = 0
  148. *
  149. * Calcul du premier pas:
  150. *
  151. c write(*,*) '=== Calcul du premier pas ==='
  152. c write(*,*) 'Q1(:,2) =',(Q1(iou,2),iou=1,NA1)
  153. c write(*,*) 'Q2(:,2) =',(Q2(iou,2),iou=1,NA1)
  154. c write(*,*) 'Q3(:,2) =',(Q3(iou,2),iou=1,NA1)
  155. T=XTEMPS(1)
  156. PDT=XDT(1)
  157. * coef du Newmark
  158. pdt2=pdt**2
  159. B1 = (0.5D0-BETA)*pdt2
  160. B2 = (1.D0-GAMMA)*pdt
  161. B3 = GAMMA*pdt
  162. B4 = BETA*pdt2
  163.  
  164. CALL D3VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,1,FTOTA,FEXA,IFEXA,
  165. & NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  166. & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,
  167. & FTOTB,FTOTBA,XPTB,
  168. & FEXPSM,FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0,
  169. & WEXT,WINT,XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,
  170. & KTPHI,XCHPFB,XOPER,NB1,NB1K,NB1C,NB1M,B1,B2,B3,B4)
  171. IF (IERRD.NE.0) THEN
  172. IF (IERRD.EQ.1) CALL ERREUR(528)
  173. RETURN
  174. ENDIF
  175. *
  176. * Remplissage du tableau de sauvegarde:
  177. *
  178. IINS = IINS + 1
  179. IF ( .NOT. REPRIS ) THEN
  180. IINS2 = IINS2 + 1
  181. CALL D2VTRI(Q1,Q2,Q3,NA1,IINS2,FTOTA,XRES,ICHRES,NRES,NCRES,
  182. & NPRES,XVALA,INULA,NLIAA,NLSA,XRESLA,XVALB,INULB,
  183. & NLIAB,NLSB,XRESLB,ILIREA,ILIREB,NTVAR,WEXT,WINT,
  184. & XCHPFB,NPLB)
  185. ENDIF
  186. IF (IINS.EQ.NINS) THEN
  187. IINS = 0
  188. IINS2 = IINS2 + 1
  189. CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
  190. & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
  191. & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,ILIREB,
  192. & NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,WEXT,WINT,
  193. & XCHPFB,NPLB)
  194. ENDIF
  195. *
  196. DO 10 I=2,NP
  197. *
  198. * Decalage ou mise a zero dans les tableaux pour le pas suivant:
  199. *
  200. CALL D2NE16(Q1,Q2,Q3,NA1,FTOTA,XPTB,NPLB,IDIMB,FINERT,WEXT,WINT)
  201. *
  202. * Calcul d'un pas:
  203. *
  204. T=XTEMPS(I)
  205. c PDT=XDT(I)
  206. c * coef du Newmark
  207. c pdt2=pdt**2
  208. c B1 = (0.5-BETA)*pdt2
  209. c B2 = (1.-GAMMA)*pdt
  210. c B3 = GAMMA*pdt
  211. c B4 = BETA*pdt2
  212. * lignes ci dessus inutiles car PDT constant (cf devalo)
  213. *
  214. c if(I.le.5) write(*,*) '=== Calcul du pas ===',I
  215. CALL D3VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,I,FTOTA,FEXA,
  216. & IFEXA,NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  217. & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,
  218. & XVALB,FTOTB,FTOTBA,XPTB,
  219. & FEXPSM,FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0,
  220. & WEXT,WINT,XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,
  221. & KTPHI,XCHPFB,XOPER,NB1,NB1K,NB1C,NB1M,B1,B2,B3,B4)
  222. *
  223. IF (IERRD.NE.0) THEN
  224. IF (IERRD.EQ.1) CALL ERREUR(528)
  225. RETURN
  226. ENDIF
  227. *
  228. * Remplissage du tableau de sauvegarde:
  229. *
  230. IINS = IINS + 1
  231. IF (IINS.EQ.NINS) THEN
  232. IINS = 0
  233. IINS2 = IINS2 + 1
  234. CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
  235. & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
  236. & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,
  237. & ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,
  238. & WEXT,WINT,XCHPFB,NPLB)
  239. ENDIF
  240. 10 CONTINUE
  241. * end do
  242. *
  243. END
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  

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