Télécharger devlir.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVLIR SOURCE CB215821 16/12/05 21:15:17 9237
  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 REDUAF(ITCARA,ITBMO1,ipche1,0,IR,KER)
  116. IF(IR .NE. 1) CALL ERREUR(KER)
  117. IF(IERR .NE. 0) RETURN
  118.  
  119. call ecrcha('AMOR')
  120. call ecrobj('MCHAML',ipche1)
  121. call exis
  122. call lirlog(loamor,1,iret)
  123. if (loamor) then
  124. call ecrobj('MCHAML',itcara)
  125. call ecrobj('MMODEL',itmod)
  126. call amor
  127. call lirobj('RIGIDITE',ITA,1,iret)
  128. IF (IERR.NE.0) RETURN
  129. endif
  130. else
  131. CALL MESLIR(-263)
  132. CALL LIRTAB('AMORTISSEMENT',ITA,0,IRET)
  133. IF (IERR.NE.0) RETURN
  134. IF (ITA.NE.0 .AND. IIMPI.EQ.333) THEN
  135. WRITE(IOIMP,*)
  136. & ' on a lu la table definissant une matrice d''amortissement.'
  137. ENDIF
  138. endif
  139. *
  140. if (lmodyn) then
  141. call ecrcha('LIAISON')
  142. call ecrcha('FORM')
  143. call ecrobj('MMODEL',ITMOD)
  144. call exis
  145. call lirobj('LOGIQUE',itlog,0,iret)
  146.  
  147. if (itlog.eq.1) then
  148. call ecrcha('LIAISON')
  149. call ecrcha('FORM')
  150. call ecrobj('MMODEL',ITMOD)
  151. call extrai
  152. call lirobj('MMODEL',itlia,0,iret)
  153. endif
  154. if (ierr.ne.0) return
  155. else
  156. CALL MESLIR(-264)
  157. CALL LIRTAB('LIAISON',ITLIA,0,IRET)
  158. IF (IERR.NE.0) RETURN
  159. IF (ITLIA.NE.0 .AND. IIMPI.EQ.333) THEN
  160. WRITE(IOIMP,*)' on a lu la table definissant les liaisons.'
  161. ENDIF
  162. endif
  163. *
  164. if (lmodyn) then
  165. typobj = ' '
  166. irep = 0
  167. ITCHAR = 0
  168. CALL ACCTAB(ITDYN,'MOT',IM,X0,'CHARGEMENT',L0,IP0,
  169. & typobj,I1,X1,CHARRE,L1,irep)
  170. if (typobj.eq.'CHARGEME') ITCHAR = irep
  171. else
  172. CALL MESLIR(-265)
  173. CALL LIRTAB('CHARGEMENT',ITCHAR,0,IRET)
  174. IF (IERR.NE.0) RETURN
  175. IF (ITCHAR.NE.0 .AND. IIMPI.EQ.333) THEN
  176. WRITE(IOIMP,*)' on a lu la table definissant les chargements.'
  177. ENDIF
  178. endif
  179. *
  180. if (lmodyn) then
  181. typobj = ' '
  182. irep = 0
  183. CALL ACCTAB(ITDYN,'MOT',IM,X0,'INIT_DYNE',L0,IP0,
  184. & typobj,I1,X1,CHARRE,L1,IREP)
  185.  
  186. if (typobj.eq.'TABLE') then
  187. segini mwinit
  188. itinit = mwinit
  189. jrepr = irep
  190. else
  191. itinv = 0
  192. itind = 0
  193. typobj = ' '
  194. CALL ACCTAB(ITDYN,'MOT',IM,X0,'DEPLACEMENTS',L0,IP0,
  195. & typobj,I1,X1,CHARRE,L1,ITAD)
  196. if (typobj.eq.'TABLE') then
  197. CALL ACCTAB(ITAD,'ENTIER',0,X0,' ',L0,IP0,
  198. & 'CHPOINT',I1,X1,CHARRE,L1,ITIND)
  199. endif
  200. typobj = ' '
  201. CALL ACCTAB(ITDYN,'MOT',IM,X0,'VITESSES',L0,IP0,
  202. & typobj,I1,X1,CHARRE,L1,ITAV)
  203. if (typobj.eq.'TABLE') then
  204. CALL ACCTAB(ITAV,'ENTIER',0,X0,' ',L0,IP0,
  205. & 'CHPOINT',I1,X1,CHARRE,L1,ITINV)
  206. endif
  207. if(itinv.gt.0.or.itind.gt.0) then
  208. segini mwinit
  209. jpdep = itind
  210. jpvit = itinv
  211. itinit = mwinit
  212. endif
  213. endif
  214. else
  215. CALL MESLIR(-266)
  216.  
  217. CALL LIRTAB('INITIAL',ITINIT,0,IRET)
  218. IF (IERR.NE.0) RETURN
  219. IF (ITINIT.NE.0 .AND. IIMPI.EQ.333) THEN
  220. WRITE(IOIMP,*)
  221. &' on a lu la table definissant les conditions initiales.'
  222. ENDIF
  223. endif
  224.  
  225. if (lmodyn) then
  226. * le traitement des reprises semble �tre fait dans devalo
  227. else
  228. CALL LIRTAB('REPRISE',IREP,0,IRET)
  229. IF (IERR.NE.0) RETURN
  230. IF (IREP.NE.0 .AND. IIMPI.EQ.333) THEN
  231. WRITE(IOIMP,*)
  232. &' on a lu la table definissant la reprise'
  233. ENDIF
  234. endif
  235. *
  236. if (lmodyn) then
  237. ITSORT = 0
  238. typobj = ' '
  239. CALL ACCTAB(ITDYN,'MOT',IM,X0,'SORTIE',L0,IP0,
  240. & typobj,I1,X1,CHARRE,L1,ITSOR1)
  241. if (typobj.eq.'TABLE') then
  242. ITSORT = ITSOR1
  243. endif
  244. else
  245. CALL MESLIR(-267)
  246. CALL LIRTAB('SORTIE',ITSORT,0,IRET)
  247. IF (IERR.NE.0) RETURN
  248. IF (ITSORT.NE.0 .AND. IIMPI.EQ.333) THEN
  249. WRITE(IOIMP,*)' on a lu la table definissant les sorties.'
  250. ENDIF
  251. endif
  252. *
  253. if (lmodyn) then
  254. else
  255. CALL MESLIR(-268)
  256. CALL LIRTAB('RESTRICTION',ITREDU,0,IRET)
  257. IF (IERR.NE.0) RETURN
  258. endif
  259. *
  260. if (lmodyn) then
  261. CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_TEMPS',L0,IP0,
  262. & 'FLOTTANT',I1,pdt,CHARRE,L1,IP1)
  263. CALL ACCTAB(ITDYN,'MOT',IM,X0,'NOMBRE_PAS',L0,IP0,
  264. & 'ENTIER',np,X1,CHARRE,L1,IP1)
  265.  
  266. typobj = ' '
  267. nins = 1
  268. CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_SORTIE',L0,IP0,
  269. & typobj,I1,X1,CHARRE,L1,IP1)
  270. if (typobj.eq.'ENTIER') nins = I1
  271. else
  272. CALL MESLIR(-269)
  273. CALL LIRENT(NP,1,IRET)
  274. IF (IERR.NE.0) RETURN
  275. *
  276. CALL MESLIR(-270)
  277. CALL LIRREE(PDT,1,IRET)
  278. IF (IERR.NE.0) RETURN
  279. *
  280. CALL MESLIR(-271)
  281. CALL LIRENT(NINS,0,IRET)
  282. IF (IERR.NE.0) RETURN
  283. endif
  284. *
  285. * B/ Coherence des operandes
  286. *
  287. IF (ITBAS.EQ.0 .AND. ITKM.EQ.0) THEN
  288. CALL ERREUR(478)
  289. RETURN
  290. ENDIF
  291. IF (ITCHAR.EQ.0 .AND. ITINIT.EQ.0 .AND. IREP.EQ.0) THEN
  292. CALL ERREUR(479)
  293. RETURN
  294. ENDIF
  295. IF (NP.LE.0) THEN
  296. IF(LANGUE.EQ.'ANGL') THEN
  297. MOTERR(1:40)='time steps'
  298. ELSE
  299. MOTERR(1:40)='pas de temps de calcul'
  300. ENDIF
  301. CALL ERREUR(480)
  302. RETURN
  303. ENDIF
  304. IF (PDT.LE.ZERO) THEN
  305. CALL ERREUR(481)
  306. RETURN
  307. ENDIF
  308. IF (NINS.LE.0) THEN
  309. * INTERR(1)=NINS
  310. * CALL ERREUR(36)
  311. IF(LANGUE.EQ.'ANGL') THEN
  312. MOTERR(1:40)='calculation steps between two outputs'
  313. ELSE
  314. MOTERR(1:40)='pas de calcul entre deux sorties'
  315. ENDIF
  316. CALL ERREUR(480)
  317. RETURN
  318. ENDIF
  319. *
  320. * C/ Verification des supports des objets TBAS, TKM, TA et TINIT
  321. * et obtention de la liste des points de reference
  322. *
  323. if (lmodyn) then
  324. it1 = itbmod
  325. else
  326. it1 = itbas
  327. endif
  328. CALL DYNE13(IT1,ITKM,KPREF,KCPR,LMODYN)
  329. IF (IERR.NE.0) RETURN
  330. *
  331. END
  332.  
  333.  
  334.  

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