Télécharger devlir.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVLIR SOURCE CB215821 19/07/30 21:15:50 10273
  2. SUBROUTINE DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,
  3. & NINS,ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Lecture et coherence des operandes, verification des supports *
  12. * objets TBAS, TKM, TA et TINIT. *
  13. * Obtention de la liste des points de reference. *
  14. * *
  15. * Param}tres: *
  16. * *
  17. * s ITBAS Table representant une base modale *
  18. * s ITKM Table contenant les matrices de raideur et de masse *
  19. * s ITA Table contenant la matrice des amortissements *
  20. * s ITLIA Table rassemblant la description des liaisons *
  21. * s ITCHAR Table contenant les chargements *
  22. * s ITINIT Table donnant les conditions initiales *
  23. * s NP Nombre de pas de temps *
  24. * s PDT Valeur du pas de temps *
  25. * s NINS On veut un resultat tous les NINS pas de calcul *
  26. * s ITSORT Table definissant les resultats attendus *
  27. * s ITREDU Table contenant les noms d'inconnues de la base B *
  28. * auxquelles on se restreint *
  29. * s KPREF Segment des points de reference *
  30. * s KCPR Segment des points *
  31. * *
  32. * Auteur, date de creation: *
  33. * *
  34. * Denis ROBERT-MOUGIN, le 25 mai 1989. *
  35. * *
  36. *--------------------------------------------------------------------*
  37. -INC CCOPTIO
  38. -INC SMMODEL
  39. segment mwinit
  40. integer jpdep,jpvit,jrepr
  41. endsegment
  42. segment mtbas
  43. integer itbmod,lsstru(np1),nsstru
  44. endsegment
  45. *
  46. PARAMETER ( ZERO=0.D0 )
  47. LOGICAL LMODYN, LOAMOR,L0,L1
  48. CHARACTER*8 TYPOBJ
  49. CHARACTER*72 CHARRE,CHARRI
  50. *
  51. NINS = 1
  52. LMODYN = .false.
  53. ITDYN = 0
  54. *
  55. ITBAS = 0
  56. ITKM = 0
  57. ITA = 0
  58. ITLIA = 0
  59. ITCHAR = 0
  60. ITINIT = 0
  61. ITSORT = 0
  62. ITREDU = 0
  63. ITINV = 0
  64. ITIND = 0
  65.  
  66. CALL LIRTAB('PASAPAS',ITDYN,0,IRET)
  67. if (iret.ne.0) lmodyn = .true.
  68. *
  69. * A/ Lecture des operandes, les tables puis les autres:
  70. *
  71. if (lmodyn) then
  72. CALL ACCTAB(ITDYN,'MOT',IM,X0,'MODELE',L0,IP0,
  73. & 'MMODEL',I1,X1,CHARRE,L1,ITMOD)
  74. IF (IERR.NE.0) RETURN
  75. CALL ACCTAB(ITDYN,'MOT',IM,X0,'CARACTERISTIQUES',L0,IP0,
  76. & 'MCHAML',I1,X1,CHARRE,L1,ITCARA)
  77. IF (IERR.NE.0) RETURN
  78. call ecrcha('MECANIQUE')
  79. call ecrcha('FORM')
  80. call ecrobj('MMODEL',ITMOD)
  81. call extrai
  82. call lirobj('MMODEL ',ITMO1,0,iret)
  83. mmodel = itmod
  84. segact mmodel
  85. np1 = kmodel(/1)
  86. segini mtbas
  87. itbas = mtbas
  88. itbmod = itmo1
  89. else
  90. CALL MESLIR(-261)
  91. CALL LIRTAB('BASE_MODALE',ITBAS,0,IRET)
  92. IF (IRET.EQ.0) THEN
  93. CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,0,IRET)
  94. ENDIF
  95. IF (IERR.NE.0) RETURN
  96. IF (ITBAS.NE.0 .AND. IIMPI.EQ.333) THEN
  97. WRITE(IOIMP,*)' on a lu la table definissant la base modale.'
  98. ENDIF
  99. endif
  100. *
  101.  
  102. if (lmodyn) then
  103. else
  104. CALL MESLIR(-262)
  105. CALL LIRTAB('RAIDEUR_ET_MASSE',ITKM,0,IRET)
  106. IF (IERR.NE.0) RETURN
  107. IF (ITKM.NE.0 .AND. IIMPI.EQ.333) THEN
  108. WRITE(IOIMP,*)
  109. & ' on a lu la table definissant les matrices de raideurs.'
  110. ENDIF
  111. endif
  112. *
  113. if (lmodyn) then
  114. ITBMO1 = itbmod
  115. CALL ACTOBJ('MCHAML ',ITCARA,1)
  116. CALL ACTOBJ('MMODEL ',ITBMO1,1)
  117. CALL REDUAF(ITCARA,ITBMO1,ipche1,0,IR,KER)
  118. IF(IR .NE. 1) CALL ERREUR(KER)
  119. IF(IERR .NE. 0) RETURN
  120.  
  121. call ecrcha('AMOR')
  122. call ecrobj('MCHAML',ipche1)
  123. call exis
  124. call lirlog(loamor,1,iret)
  125. if (loamor) then
  126. call ecrobj('MCHAML',itcara)
  127. call ecrobj('MMODEL',itmod)
  128. call amor
  129. call lirobj('RIGIDITE',ITA,1,iret)
  130. IF (IERR.NE.0) RETURN
  131. endif
  132. else
  133. CALL MESLIR(-263)
  134. CALL LIRTAB('AMORTISSEMENT',ITA,0,IRET)
  135. IF (IERR.NE.0) RETURN
  136. IF (ITA.NE.0 .AND. IIMPI.EQ.333) THEN
  137. WRITE(IOIMP,*)
  138. & ' on a lu la table definissant une matrice d''amortissement.'
  139. ENDIF
  140. endif
  141. *
  142. if (lmodyn) then
  143. call ecrcha('LIAISON')
  144. call ecrcha('FORM')
  145. call ecrobj('MMODEL',ITMOD)
  146. call exis
  147. call lirobj('LOGIQUE',itlog,0,iret)
  148.  
  149. if (itlog.eq.1) then
  150. call ecrcha('LIAISON')
  151. call ecrcha('FORM')
  152. call ecrobj('MMODEL',ITMOD)
  153. call extrai
  154. call lirobj('MMODEL',itlia,0,iret)
  155. endif
  156. if (ierr.ne.0) return
  157. else
  158. CALL MESLIR(-264)
  159. CALL LIRTAB('LIAISON',ITLIA,0,IRET)
  160. IF (IERR.NE.0) RETURN
  161. IF (ITLIA.NE.0 .AND. IIMPI.EQ.333) THEN
  162. WRITE(IOIMP,*)' on a lu la table definissant les liaisons.'
  163. ENDIF
  164. endif
  165. *
  166. if (lmodyn) then
  167. typobj = ' '
  168. irep = 0
  169. ITCHAR = 0
  170. CALL ACCTAB(ITDYN,'MOT',IM,X0,'CHARGEMENT',L0,IP0,
  171. & typobj,I1,X1,CHARRE,L1,irep)
  172. if (typobj.eq.'CHARGEME') ITCHAR = irep
  173. else
  174. CALL MESLIR(-265)
  175. CALL LIRTAB('CHARGEMENT',ITCHAR,0,IRET)
  176. IF (IERR.NE.0) RETURN
  177. IF (ITCHAR.NE.0 .AND. IIMPI.EQ.333) THEN
  178. WRITE(IOIMP,*)' on a lu la table definissant les chargements.'
  179. ENDIF
  180. endif
  181. *
  182. if (lmodyn) then
  183. typobj = ' '
  184. irep = 0
  185. CALL ACCTAB(ITDYN,'MOT',IM,X0,'INIT_DYNE',L0,IP0,
  186. & typobj,I1,X1,CHARRE,L1,IREP)
  187.  
  188. if (typobj.eq.'TABLE') then
  189. segini mwinit
  190. itinit = mwinit
  191. jrepr = irep
  192. else
  193. itinv = 0
  194. itind = 0
  195. typobj = ' '
  196. CALL ACCTAB(ITDYN,'MOT',IM,X0,'DEPLACEMENTS',L0,IP0,
  197. & typobj,I1,X1,CHARRE,L1,ITAD)
  198. if (typobj.eq.'TABLE') then
  199. CALL ACCTAB(ITAD,'ENTIER',0,X0,' ',L0,IP0,
  200. & 'CHPOINT',I1,X1,CHARRE,L1,ITIND)
  201. endif
  202. typobj = ' '
  203. CALL ACCTAB(ITDYN,'MOT',IM,X0,'VITESSES',L0,IP0,
  204. & typobj,I1,X1,CHARRE,L1,ITAV)
  205. if (typobj.eq.'TABLE') then
  206. CALL ACCTAB(ITAV,'ENTIER',0,X0,' ',L0,IP0,
  207. & 'CHPOINT',I1,X1,CHARRE,L1,ITINV)
  208. endif
  209. if(itinv.gt.0.or.itind.gt.0) then
  210. segini mwinit
  211. jpdep = itind
  212. jpvit = itinv
  213. itinit = mwinit
  214. endif
  215. endif
  216. else
  217. CALL MESLIR(-266)
  218.  
  219. CALL LIRTAB('INITIAL',ITINIT,0,IRET)
  220. IF (IERR.NE.0) RETURN
  221. IF (ITINIT.NE.0 .AND. IIMPI.EQ.333) THEN
  222. WRITE(IOIMP,*)
  223. &' on a lu la table definissant les conditions initiales.'
  224. ENDIF
  225. endif
  226.  
  227. if (lmodyn) then
  228. * le traitement des reprises semble �tre fait dans devalo
  229. else
  230. CALL LIRTAB('REPRISE',IREP,0,IRET)
  231. IF (IERR.NE.0) RETURN
  232. IF (IREP.NE.0 .AND. IIMPI.EQ.333) THEN
  233. WRITE(IOIMP,*)
  234. &' on a lu la table definissant la reprise'
  235. ENDIF
  236. endif
  237. *
  238. if (lmodyn) then
  239. ITSORT = 0
  240. typobj = ' '
  241. CALL ACCTAB(ITDYN,'MOT',IM,X0,'SORTIE',L0,IP0,
  242. & typobj,I1,X1,CHARRE,L1,ITSOR1)
  243. if (typobj.eq.'TABLE') then
  244. ITSORT = ITSOR1
  245. endif
  246. else
  247. CALL MESLIR(-267)
  248. CALL LIRTAB('SORTIE',ITSORT,0,IRET)
  249. IF (IERR.NE.0) RETURN
  250. IF (ITSORT.NE.0 .AND. IIMPI.EQ.333) THEN
  251. WRITE(IOIMP,*)' on a lu la table definissant les sorties.'
  252. ENDIF
  253. endif
  254. *
  255. if (lmodyn) then
  256. else
  257. CALL MESLIR(-268)
  258. CALL LIRTAB('RESTRICTION',ITREDU,0,IRET)
  259. IF (IERR.NE.0) RETURN
  260. endif
  261. *
  262. if (lmodyn) then
  263. CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_TEMPS',L0,IP0,
  264. & 'FLOTTANT',I1,pdt,CHARRE,L1,IP1)
  265. CALL ACCTAB(ITDYN,'MOT',IM,X0,'NOMBRE_PAS',L0,IP0,
  266. & 'ENTIER',np,X1,CHARRE,L1,IP1)
  267.  
  268. typobj = ' '
  269. nins = 1
  270. CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_SORTIE',L0,IP0,
  271. & typobj,I1,X1,CHARRE,L1,IP1)
  272. if (typobj.eq.'ENTIER') nins = I1
  273. else
  274. CALL MESLIR(-269)
  275. CALL LIRENT(NP,1,IRET)
  276. IF (IERR.NE.0) RETURN
  277. *
  278. CALL MESLIR(-270)
  279. CALL LIRREE(PDT,1,IRET)
  280. IF (IERR.NE.0) RETURN
  281. *
  282. CALL MESLIR(-271)
  283. CALL LIRENT(NINS,0,IRET)
  284. IF (IERR.NE.0) RETURN
  285. endif
  286. *
  287. * B/ Coherence des operandes
  288. *
  289. IF (ITBAS.EQ.0 .AND. ITKM.EQ.0) THEN
  290. CALL ERREUR(478)
  291. RETURN
  292. ENDIF
  293. IF (ITCHAR.EQ.0 .AND. ITINIT.EQ.0 .AND. IREP.EQ.0) THEN
  294. CALL ERREUR(479)
  295. RETURN
  296. ENDIF
  297. IF (NP.LE.0) THEN
  298. IF(LANGUE.EQ.'ANGL') THEN
  299. MOTERR(1:40)='time steps'
  300. ELSE
  301. MOTERR(1:40)='pas de temps de calcul'
  302. ENDIF
  303. CALL ERREUR(480)
  304. RETURN
  305. ENDIF
  306. IF (PDT.LE.ZERO) THEN
  307. CALL ERREUR(481)
  308. RETURN
  309. ENDIF
  310. IF (NINS.LE.0) THEN
  311. * INTERR(1)=NINS
  312. * CALL ERREUR(36)
  313. IF(LANGUE.EQ.'ANGL') THEN
  314. MOTERR(1:40)='calculation steps between two outputs'
  315. ELSE
  316. MOTERR(1:40)='pas de calcul entre deux sorties'
  317. ENDIF
  318. CALL ERREUR(480)
  319. RETURN
  320. ENDIF
  321. *
  322. * C/ Verification des supports des objets TBAS, TKM, TA et TINIT
  323. * et obtention de la liste des points de reference
  324. *
  325. if (lmodyn) then
  326. it1 = itbmod
  327. else
  328. it1 = itbas
  329. endif
  330. CALL DYNE13(IT1,ITKM,KPREF,KCPR,LMODYN)
  331. IF (IERR.NE.0) RETURN
  332. *
  333. END
  334.  
  335.  
  336.  
  337.  

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