Télécharger devalg.eso

Retour à la liste

Numérotation des lignes :

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

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