Télécharger devps2.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVPS2 SOURCE BP208322 19/04/03 21:15:09 10174
  2. SUBROUTINE DEVPS2(ICHAR1,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS,ITPS,
  3. & IBAS,NUMBAS)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Remplissage du tableau FEXPSM, representant les pseudo-modes *
  12. * aux points de liaison. *
  13. * *
  14. * Paramètres: *
  15. * *
  16. * e ITCHAR Table représentant les chargements *
  17. * e ITBAS Table représentant la base modale *
  18. * e KTLIAB Segment contenant les liaisons sur base B *
  19. * e KTNUM Segment contenant les paramètres numériques *
  20. * e KTPHI Segment des déformées modales *
  21. * es KTFEX Segment contenant les chargements libres *
  22. * e REPRIS Logique indiquant si le calcul est en reprise *
  23. * e ITPS Table contenant les pseudo-modes *
  24. * e IBAS Table contenant les modes *
  25. * e NUMBAS numéro de la sous base *
  26. * *
  27. * Auteur, date de création: *
  28. * *
  29. * Lionel VIVAN, le 10 avril 1990 *
  30. * *
  31. *--------------------------------------------------------------------*
  32. *
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMCHARG
  37. -INC SMLREEL
  38. -INC SMCHPOI
  39. *
  40. * FEXPSM(.,.,1,.) valeur au pas m
  41. * FEXPSM(.,.,2,.) valeur au pas m - 1/2
  42. *
  43. SEGMENT,MTNUM
  44. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  45. ENDSEGMENT
  46. SEGMENT,MTFEX
  47. REAL*8 FEXA(NPFEXA,NPC1,2)
  48. REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB)
  49. REAL*8 FTEXB(NPLB,NPC1,2,IDIM)
  50. * INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  51. ENDSEGMENT
  52. SEGMENT,MTPHI
  53. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  54. INTEGER IAROTA(NSB)
  55. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  56. ENDSEGMENT
  57. SEGMENT,MTLIAB
  58. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  59. REAL*8 XPALB(NLIAB,NXPALB)
  60. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  61. ENDSEGMENT
  62. SEGMENT,MTRAV
  63. REAL*8 FTCHG(NPC2)
  64. ENDSEGMENT
  65. *
  66. LOGICAL L0,L1,REPRIS
  67. CHARACTER*4 NOMAXI(6),NOMTRI(6),COMP
  68. CHARACTER*8 TYPRET,CHARRE
  69. CHARACTER*40 CMOT
  70. PARAMETER ( TOLER = 1.E-6 )
  71. *
  72. DATA NOMAXI/'UR ','UZ ','UT ','RR ','RZ ','RT '/
  73. DATA NOMTRI/'UX ','UY ','UZ ','RX ','RY ','RZ '/
  74. *
  75. MTNUM = KTNUM
  76. MTFEX = KTFEX
  77. MTPHI = KTPHI
  78. MTLIAB = KTLIAB
  79. NPC1 = XDT(/1)
  80. NPLB = IBASB(/1)
  81. NSB = XPHILB(/1)
  82. IDIMB = XPHILB(/4)
  83. MCHARG = ICHAR1
  84. SEGACT,MCHARG
  85. NCHAR = KCHARG(/1)
  86. *
  87. ************************************************************************
  88. * BOUCLE SUR LES PSEUDO-MODES
  89. ************************************************************************
  90. *
  91. IPS = 0
  92. 10 CONTINUE
  93. IPS = IPS + 1
  94. TYPRET = ' '
  95. CALL ACCTAB(ITPS,'ENTIER',IPS,X0,' ',L0,IP0,
  96. & TYPRET,I1,X1,CHARRE,L1,ITPM)
  97. IF (ITPM.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  98. CALL ACCTAB(ITPM,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  99. & 'MOT',I1,X1,CMOT,L1,IP1)
  100.  
  101. ******** CAS D'UN PSEUDO MODE DE SOUSTYPE : 'PSMO_FORC' ****************
  102. IF (CMOT(1:9).EQ.'PSMO_FORC') THEN
  103.  
  104. CALL ACCTAB(ITPM,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
  105. & 'CHPOINT',I1,X1,CHARRE,L1,ICHBA)
  106. *
  107. *---------- boucle sur les chargements elementaires ------------------ *
  108. * jusqu'a trouver celui qui correspond au pseudo mode
  109. DO 20 ICHAR=1,NCHAR
  110. ICHARG = KCHARG(ICHAR)
  111. SEGACT,ICHARG
  112. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  113. & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  114. SEGDES ICHARG
  115. GOTO 20
  116. ENDIF
  117. c test sur le pointeur du CHPOINT definissant le pseudo-mode
  118. IF (ICHBA.EQ.ICHPO1) GOTO 120
  119. 20 CONTINUE
  120. * --- on n'a pas trouve le chargement : erreur ! ---
  121. INTERR(1) = IPS
  122. CALL ERREUR(428)
  123. GOTO 10
  124. * --- on a trouve le chargement : on continue ---
  125. 120 CONTINUE
  126. IF (IIMPI.EQ.333) THEN
  127. WRITE(IOIMP,*)'DEVPSM : pseudo-mode numero ',IPS
  128. WRITE(IOIMP,*)'DEVPSM : chargement ',ICHAR1
  129. WRITE(IOIMP,*)'DEVPSM : numero ',ICHAR
  130. ENDIF
  131.  
  132. *---------- interpolation de f(t) ------------------ *
  133. MLR1 = ICHPO2
  134. MLR2 = ICHPO3
  135. CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  136. IF (IERR.NE.0) RETURN
  137. MTRAV = KTRAV
  138. SEGDES ICHARG
  139. *
  140. *---------- boucle sur les points de liaison ------------------ *
  141. DO 30 IPL = 1,NPLB
  142. IB = IBASB(IPL)
  143. IF (IB.EQ.NUMBAS) THEN
  144. IPTL = JPLIB(IPL)
  145. CALL ACCTAB(ITPM,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  146. & 'CHPOINT',I1,X1,' ',L1,ICHPS)
  147. DO 40 ID = 1,IDIMB
  148. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  149. COMP = NOMAXI(ID)
  150. ELSE
  151. COMP = NOMTRI(ID)
  152. ENDIF
  153. CALL EXTRA9(ICHPS,IPTL,COMP,0,.false.,XVAL,IRET)
  154. IF (IRET.EQ.1) THEN
  155. DO 50 IT=1,NPC1
  156. NP = 2 * IT
  157. FEXPSM(IPL,IT,1,ID) = FEXPSM(IPL,IT,1,ID) +
  158. & ( XVAL * FTCHG(NP) )
  159. NI = NP - 1
  160. FEXPSM(IPL,IT,2,ID) = FEXPSM(IPL,IT,1,ID) +
  161. & ( XVAL * FTCHG(NI) )
  162. 50 CONTINUE
  163. ENDIF
  164. 40 CONTINUE
  165. ENDIF
  166. 30 CONTINUE
  167. *---------- fin de boucle sur les points de liaison ------------------ *
  168.  
  169. SEGSUP MTRAV
  170. c ON PASSE AU PSEUDO-MODE SUIVANT
  171. GOTO 10
  172.  
  173.  
  174. ******** CAS D'UN PSEUDO MODE DE SOUSTYPE : 'PSMO_SEIS' ****************
  175. ELSE IF (CMOT(1:9).EQ.'PSMO_SEIS') THEN
  176.  
  177. CALL ACCTAB(ITPM,'MOT',I0,X0,'DIRECTION',L0,IP0,
  178. & 'ENTIER',IENT,X1,' ',L1,IP1)
  179. CALL ACCTAB(IBAS,'ENTIER',1,X0,' ',L0,IP0,
  180. & 'TABLE',I1,X1,' ',L1,ITMK)
  181. CALL ACCTAB(ITMK,'MOT',I0,X0,'DEPLACEMENTS_GENERALISES',
  182. & L0,IP0,'TABLE',I1,X1,' ',L1,ITMD)
  183. CALL ACCTAB(ITMD,'ENTIER',IENT,X0,' ',L0,IP0,
  184. & 'FLOTTANT',I1,XQXYZ,' ',L1,IP1)
  185. *
  186. *---------- boucle sur les chargements elementaires ------------------ *
  187. * jusqu'a trouver celui qui correspond au pseudo mode
  188. DO 24 ICHAR=1,NCHAR
  189. ICHARG = KCHARG(ICHAR)
  190. SEGACT,ICHARG
  191. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  192. & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  193. SEGDES ICHARG
  194. GOTO 24
  195. ENDIF
  196. MCHPOI = ICHPO1
  197. SEGACT MCHPOI
  198. MSOUPO = IPCHP(1)
  199. SEGDES MCHPOI
  200. SEGACT MSOUPO
  201. MPOVAL = IPOVAL
  202. SEGDES MSOUPO
  203. SEGACT MPOVAL
  204. QXYZ = VPOCHA(1,1)
  205. SEGDES MPOVAL
  206. EPS = ABS(QXYZ + XQXYZ)
  207. c test sur l'unique valeur du CHPOINT definissant le pseudo-mode
  208. IF (EPS.LT.TOLER) GOTO 124
  209. 24 CONTINUE
  210. * --- on n'a pas trouve le chargement : erreur ! ---
  211. INTERR(1) = IPS
  212. CALL ERREUR(428)
  213. GOTO 10
  214. * --- on a trouve le chargement : on continue ---
  215. 124 CONTINUE
  216. IF (IIMPI.EQ.333) THEN
  217. WRITE(IOIMP,*)'DEVPSM : pseudo-mode numero ',IPS
  218. WRITE(IOIMP,*)'DEVPSM : chargement ',ICHAR1
  219. WRITE(IOIMP,*)'DEVPSM : numero ',ICHAR
  220. ENDIF
  221.  
  222. *---------- interpolation de f(t) ------------------ *
  223. MLR1 = ICHPO2
  224. MLR2 = ICHPO3
  225. CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  226. IF (IERR.NE.0) RETURN
  227. MTRAV = KTRAV
  228. SEGDES ICHARG
  229. *
  230. *---------- boucle sur les points de liaison ------------------ *
  231. DO 32 IPL = 1,NPLB
  232. IB = IBASB(IPL)
  233. IF (IB.EQ.NUMBAS) THEN
  234. IPTL = JPLIB(IPL)
  235. CALL ACCTAB(ITPM,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  236. & 'CHPOINT',I1,X1,' ',L1,ICHPS)
  237. DO 42 ID = 1,IDIMB
  238. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  239. COMP = NOMAXI(ID)
  240. ELSE
  241. COMP = NOMTRI(ID)
  242. ENDIF
  243. IRET=0
  244. CALL EXTRA9(ICHPS,IPTL,COMP,0,.false.,XVAL,IRET)
  245. IF (IRET.EQ.1) THEN
  246. DO 52 IT=1,NPC1
  247. NP = 2 * IT
  248. FEXPSM(IPL,IT,1,ID) = FEXPSM(IPL,IT,1,ID) +
  249. & ( XVAL * FTCHG(NP) )
  250. NI = NP - 1
  251. FEXPSM(IPL,IT,2,ID) = FEXPSM(IPL,IT,1,ID) +
  252. & ( XVAL * FTCHG(NI) )
  253. 52 CONTINUE
  254. ENDIF
  255. 42 CONTINUE
  256. ENDIF
  257. 32 CONTINUE
  258. *---------- fin de boucle sur les points de liaison ------------------ *
  259.  
  260. SEGSUP MTRAV
  261. c ON PASSE AU PSEUDO-MODE SUIVANT
  262. GOTO 10
  263.  
  264. ******** CAS D'UN PSEUDO MODE DE SOUSTYPE : 'PSMO_DEPL' ****************
  265. ELSE IF (CMOT(1:9).EQ.'PSMO_DEPL') THEN
  266.  
  267. CALL ACCTAB(ITPM,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
  268. & 'CHPOINT',I1,X1,' ',L1,ICHBA)
  269. *
  270. *---------- boucle sur les chargements elementaires ------------------ *
  271. * jusqu'a trouver celui qui correspond au pseudo mode
  272. DO 28 ICHAR=1,NCHAR
  273. ICHARG = KCHARG(ICHAR)
  274. SEGACT,ICHARG
  275. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  276. & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  277. SEGDES ICHARG
  278. GOTO 28
  279. ENDIF
  280. c test sur le pointeur du CHPOINT definissant le pseudo-mode
  281. IF (ICHBA.EQ.ICHPO1) GOTO 128
  282. 28 CONTINUE
  283. * --- on n'a pas trouve le chargement : erreur ! ---
  284. INTERR(1) = IPS
  285. CALL ERREUR(428)
  286. GOTO 10
  287. * --- on a trouve le chargement : on continue ---
  288. 128 CONTINUE
  289. IF (IIMPI.EQ.333) THEN
  290. WRITE(IOIMP,*)'DEVPSM : pseudo-mode numero ',IPS
  291. WRITE(IOIMP,*)'DEVPSM : chargement ',ICHAR1
  292. WRITE(IOIMP,*)'DEVPSM : numero ',ICHAR
  293. ENDIF
  294.  
  295. *---------- interpolation de f(t) ------------------ *
  296. MLR1 = ICHPO2
  297. MLR2 = ICHPO3
  298. CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  299. IF (IERR.NE.0) RETURN
  300. MTRAV = KTRAV
  301. SEGDES ICHARG
  302. *
  303. *---------- boucle sur les points de liaison ------------------ *
  304. DO 34 IPL = 1,NPLB
  305. IB = IBASB(IPL)
  306. IF (IB.EQ.NUMBAS) THEN
  307. IPTL = JPLIB(IPL)
  308. CALL ACCTAB(ITPM,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  309. & 'CHPOINT',I1,X1,' ',L1,ICHPS)
  310. DO 44 ID = 1,IDIMB
  311. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  312. COMP = NOMAXI(ID)
  313. ELSE
  314. COMP = NOMTRI(ID)
  315. ENDIF
  316. CALL EXTRA9(ICHPS,IPTL,COMP,0,.false.,XVAL,IRET)
  317. IF (IRET.EQ.1) THEN
  318. DO 54 IT=1,NPC1
  319. NP = 2 * IT
  320. FEXPSM(IPL,IT,1,ID) = FEXPSM(IPL,IT,1,ID) +
  321. & ( XVAL * FTCHG(NP) )
  322. NI = NP - 1
  323. FEXPSM(IPL,IT,2,ID) = FEXPSM(IPL,IT,1,ID) +
  324. & ( XVAL * FTCHG(NI) )
  325. 54 CONTINUE
  326. ENDIF
  327. 44 CONTINUE
  328. ENDIF
  329. 34 CONTINUE
  330. *---------- fin de boucle sur les points de liaison ------------------ *
  331.  
  332. SEGSUP MTRAV
  333. c ON PASSE AU PSEUDO-MODE SUIVANT
  334. GOTO 10
  335.  
  336. ENDIF
  337. ******** FIN DISTINCTION ENTRE LES SOUSTYPE DES PSEUDO MODE ************
  338.  
  339. ENDIF
  340. SEGDES MCHARG
  341. *
  342. END
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  

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