Télécharger dyn201.eso

Retour à la liste

Numérotation des lignes :

dyn201
  1. C DYN201 SOURCE BP208322 20/03/26 21:15:47 10562
  2. SUBROUTINE DYN201(I,ITLB,ITYP,KTLIAB,NPLB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Operateur DYNE : *
  8. * Remplissage des tableaux de description des liaisons sur *
  9. * pour les liaisons de type : *
  10. * la base des informations contenues dans la table ILIB *
  11. * - POINT_PLAN avec ou sans amortissement *
  12. * - POINT_PLAN_FROTTEMENT avec ou sans amortissement *
  13. * - CERCLE_PLAN_FROTTEMENT avec ou sans amortissement *
  14. * - POINT_PLAN_FLUIDE *
  15. * *
  16. *--------------------------------------------------------------------*
  17. * *
  18. * Parametres: *
  19. * *
  20. * e I Numero de la liaison. *
  21. * e ITLB Table rassemblant la description d'une liaison. *
  22. * e ITYP Type de la liaison. *
  23. * s KTLIAB Segment descriptif des liaisons sur base B. *
  24. * e NPLB Nombre total de points. *
  25. * *
  26. *--------------------------------------------------------------------*
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. -INC SMEVOLL
  32. -INC SMLREEL
  33. *
  34. SEGMENT MTLIAB
  35. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  36. REAL*8 XPALB(NLIAB,NXPALB)
  37. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  38. ENDSEGMENT
  39. *
  40. LOGICAL L1,L0,LPERM,LVE
  41. CHARACTER*8 MONAMO,MONSEUIL,CHARRE,TYPRET,MARAID,MONPER
  42. *
  43. LVE=.FALSE.
  44. MTLIAB = KTLIAB
  45. *
  46. *--------------------------------------------------------------------*
  47. * --- choc elementaire POINT_PLAN avec ou sans amortissement
  48. *--------------------------------------------------------------------*
  49. *
  50. IF (ITYP.EQ.1) THEN
  51. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  52. & 'POINT',I1,X1,CHARRE,L1,IMOD)
  53. IF (IERR.NE.0) RETURN
  54. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  55. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  56. IF (IERR.NE.0) RETURN
  57.  
  58. MARAID = ' '
  59. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  60. & MARAID,I0,XRAID,CHARRE,L1,IP1)
  61. IF (MARAID .EQ. 'ENTIER ') THEN
  62. XRAID = 1.D0*I1
  63. MARAID = 'FLOTTANT'
  64. ENDIF
  65. IF (IERR.NE.0) RETURN
  66.  
  67. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  68. & 'FLOTTANT',I0,XJEU,CHARRE,L1,IP1)
  69. IF (IERR.NE.0) RETURN
  70.  
  71. MONPER = ' '
  72. LPERM = .FALSE.
  73. CALL ACCTAB(ITLB,'MOT',I1,X0,'LIAISON_PERMANENTE',L0,
  74. & IP0,MONPER,I0,X1,CHARRE,LPERM,IP1)
  75. IF (IERR.NE.0) RETURN
  76.  
  77. TYPRET = ' '
  78. CALL ACCTAB(ITLB,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,IP0,
  79. & TYPRET,I1,X1,CHARRE,L1,IPEVO)
  80. IF (IERR.NE.0) RETURN
  81. *
  82. MONAMO = ' '
  83. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  84. & MONAMO,I1,XAMON,CHARRE,L1,IP1)
  85. IF (IERR.NE.0) RETURN
  86. IF (MONAMO .EQ. 'ENTIER ') THEN
  87. XAMON = 1.D0*I1
  88. MONAMO = 'FLOTTANT'
  89. ENDIF
  90.  
  91. MONSEUIL = ' '
  92. CALL ACCTAB(ITLB,'MOT',I0,X0,'SEUIL_PLASTIQUE',L0,IP0,
  93. & MONSEUIL,I1,XSEUIL,CHARRE,L1,IP1)
  94. IF (MONSEUIL .EQ. 'ENTIER ') THEN
  95. XSEUIL = 1.D0*I1
  96. MONSEUIL = 'FLOTTANT'
  97. ENDIF
  98. IF (IERR.NE.0) RETURN
  99.  
  100.  
  101. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  102. CALL ERREUR(891)
  103. RETURN
  104. ENDIF
  105. *
  106. *
  107. IPALB(I,1) = ITYP
  108. IPALB(I,3) = IDIM
  109. IF(LPERM) IPALB(I,4)=2
  110. XPALB(I,1) = XRAID
  111. XPALB(I,2) = XJEU
  112. *
  113. IPNV = (IDIM + 1) * (IPOI - 1)
  114. PS = 0.D0
  115. DO 10 ID = 1,IDIM
  116. XC = XCOOR(IPNV + ID)
  117. PS = PS + XC * XC
  118. 10 CONTINUE
  119. * end do
  120. IF (PS.LE.0.D0) THEN
  121. CALL ERREUR(162)
  122. RETURN
  123. ENDIF
  124. ID1 = 3
  125. IF (MONAMO.EQ.'FLOTTANT') THEN
  126. XPALB(I,3) = XAMON
  127. ELSE
  128. XPALB(I,3) = 0.D0
  129. ENDIF
  130. IF (MONSEUIL .EQ.'FLOTTANT') THEN
  131. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  132. IPALB(I,1) = 101
  133. ELSE
  134. IPALB(I,1) = 100
  135. ENDIF
  136. ID1 = 4
  137. XPALB(I,ID1) = XSEUIL
  138. ELSE
  139. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  140. IPALB(I,1) = 102
  141. ENDIF
  142. ENDIF
  143.  
  144. *
  145. DO 12 ID = 1,IDIM
  146. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  147. 12 CONTINUE
  148. * end do
  149. IF (IPALB(I,1) .EQ. 101 .OR. IPALB(I,1) .EQ. 102) THEN
  150. MEVOLL = IPEVO
  151. *
  152. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  153. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans des
  154. * tableaux xabsci et xordon
  155. *
  156. SEGACT MEVOLL
  157. KEVOLL = IEVOLL(1)
  158. SEGACT KEVOLL
  159. MLREE1 = IPROGX
  160. MLREE2 = IPROGY
  161. SEGACT MLREE1
  162. SEGACT MLREE2
  163. NIP = XABSCI(/2)
  164. *
  165. DO 16 MM=1,NIP
  166. XABSCI (I,MM) = MLREE1.PROG(MM)
  167. XORDON (I,MM) = MLREE2.PROG(MM)
  168. 16 CONTINUE
  169. *
  170. SEGDES MLREE1
  171. SEGDES MLREE2
  172. SEGDES KEVOLL
  173. SEGDES MEVOLL
  174. ENDIF
  175. *
  176. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  177. IPLIB(I,1) = IPLAC
  178. *
  179. *--------------------------------------------------------------------*
  180. * --- choc elementaire POINT_PLAN_FROTTEMENT avec ou sans amortissement
  181. *--------------------------------------------------------------------*
  182. *
  183. ELSE IF (ITYP.EQ.3) THEN
  184.  
  185. * -- LECTURE --
  186. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  187. & 'POINT',I1,X1,CHARRE,L1,IMOD)
  188. IF (IERR.NE.0) RETURN
  189. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  190. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  191. IF (IERR.NE.0) RETURN
  192. MARAID = ' '
  193. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  194. & MARAID,I0,XRAIN,CHARRE,L1,IP1)
  195. IF (MARAID .EQ. 'ENTIER ') THEN
  196. XRAIN = DBLE(I0)
  197. MARAID = 'FLOTTANT'
  198. ELSEIF(MARAID.NE.'FLOTTANT') THEN
  199. XRAIN = 0.D0
  200. ENDIF
  201. IF (IERR.NE.0) RETURN
  202. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  203. & 'FLOTTANT',I0,XJEU,CHARRE,L1,IP1)
  204. IF (IERR.NE.0) RETURN
  205. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  206. & 'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  207. IF (IERR.NE.0) RETURN
  208. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  209. & 'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  210. IF (IERR.NE.0) RETURN
  211. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  212. & 'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  213. IF (IERR.NE.0) RETURN
  214. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  215. & IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  216. IF (IERR.NE.0) RETURN
  217. TYPRET = ' '
  218. CALL ACCTAB(ITLB,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,IP0,
  219. & TYPRET,I1,X1,CHARRE,L1,IPEVO)
  220. IF (IERR.NE.0) RETURN
  221. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  222. CALL ERREUR(891)
  223. RETURN
  224. ENDIF
  225. IF (TYPRET.EQ.'EVOLUTIO') THEN
  226. ITYP = 103
  227. XRAIN = 0.d0
  228. ENDIF
  229. * amortissement (facultatif)
  230. MONAMO = ' '
  231. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  232. & MONAMO,I1,XAMON,CHARRE,L1,IP1)
  233. IF (IERR.NE.0) RETURN
  234. IF (MONAMO .EQ. 'ENTIER ') THEN
  235. XAMON = DBLE(I1)
  236. MONAMO = 'FLOTTANT'
  237. c bp,2020 : ajout pour simplifier la suite
  238. ELSEIF(MONAMO.NE.'FLOTTANT') THEN
  239. XAMON=0.D0
  240. ENDIF
  241.  
  242. * bp,2016 petit message informatif pour ceux qui, comme moi,
  243. * n'auraient pas lu la notice jusqu'au bout :
  244. IF(XRAIT.LT.0.D0) THEN
  245. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  246. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  247. WRITE(IOIMP,*)
  248. & 'utilisation du modele de frottement regularise d ODEN'
  249. ENDIF
  250. IF(XAMOT.LE.0D0) THEN
  251. c ERREUR: %m1:8 = %r1 inferieur a %r2
  252. MOTERR(1:8)='AMOR*_T*'
  253. REAERR(1)=XAMOT
  254. REAERR(2)=0.D0
  255. CALL ERREUR(41)
  256. RETURN
  257. ENDIF
  258. ENDIF
  259. * bp,2020 : lecture eventuelle des regularisations (n et t)
  260. TYPRET=' '
  261. CALL ACCTAB(ITLB,'MOT',I1,X0,'REGULARISATION',L0,IP0,
  262. & TYPRET,IREG,XREG,CHARRE,L1,IP1)
  263. IF (IERR.NE.0) RETURN
  264. IF (TYPRET .EQ. 'ENTIER ') THEN
  265. XREG=DBLE(IREG)
  266. ELSEIF (TYPRET.NE.'FLOTTANT') THEN
  267. XREG=0.D0
  268. ENDIF
  269. TYPRET=' '
  270. CALL ACCTAB(ITLB,'MOT',I1,X0,'REGULARISATION_TANGENTIELLE',
  271. & L0,IP0,TYPRET,IREGT,XREGT,CHARRE,L1,IP1)
  272. IF (IERR.NE.0) RETURN
  273. IF (TYPRET .EQ. 'ENTIER ') THEN
  274. XREGT=DBLE(IREGT)
  275. ELSEIF (TYPRET.NE.'FLOTTANT') THEN
  276. XREGT=0.D0
  277. ENDIF
  278. * bp,2020 : lecture eventuelle d'une vitesse d'entrainement
  279. TYPRET=' '
  280. CALL ACCTAB(ITLB,'MOT',I1,X0,'VITESSE_ENTRAINEMENT',L0,IP0,
  281. & TYPRET,I1,X1,CHARRE,L1,IPVE)
  282. IF (IERR.NE.0) RETURN
  283. IF(TYPRET.NE.'POINT ') IPVE=0
  284.  
  285. * -- STOCKAGE --
  286. IPALB(I,1) = ITYP
  287. IPALB(I,3) = IDIM
  288. XPALB(I,1) = XRAIN
  289. XPALB(I,2) = XJEU
  290. XPALB(I,3) = XGLIS
  291. XPALB(I,4) = XADHE
  292. XPALB(I,5) = XRAIT
  293. XPALB(I,6) = XAMOT
  294. cbp,2020 IF (MONAMO.EQ.'FLOTTANT') THEN
  295. XPALB(I,7) = XAMON
  296. cbp,2020 ELSE
  297. cbp,2020 XPALB(I,7) = 0.D0
  298. cbp,2020 ENDIF
  299. XPALB(I,8) = XREG
  300. XPALB(I,9) = XREGT
  301. c NORMALE
  302. IPNV = (IDIM + 1) * (IPOI - 1)
  303. PS = 0.D0
  304. DO 20 ID = 1,IDIM
  305. XC = XCOOR(IPNV + ID)
  306. PS = PS + XC * XC
  307. 20 CONTINUE
  308. IF (PS.LE.0.D0) THEN
  309. CALL ERREUR(162)
  310. RETURN
  311. ENDIF
  312. DO 22 ID = 1,IDIM
  313. XPALB(I,9+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  314. 22 CONTINUE
  315. c VITESSE_ENTRAINEMENT
  316. IF(IPVE.NE.0) THEN
  317. IPVE = (IDIM + 1) * (IPVE - 1)
  318. DO 23 ID = 1,IDIM
  319. XPALB(I,9+IDIM+ID) = XCOOR(IPVE + ID)
  320. 23 CONTINUE
  321. ENDIF
  322. * LOI_DE_COMPORTEMENT
  323. IF (IPALB(I,1) .EQ. 103) THEN
  324. MEVOLL = IPEVO
  325. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  326. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans des
  327. * tableaux xabsci et xordon
  328. SEGACT MEVOLL
  329. KEVOLL = IEVOLL(1)
  330. SEGACT KEVOLL
  331. MLREE1 = IPROGX
  332. MLREE2 = IPROGY
  333. SEGACT MLREE1
  334. SEGACT MLREE2
  335. NIP = XABSCI(/2)
  336. DO 26 MM=1,NIP
  337. XABSCI (I,MM) = MLREE1.PROG(MM)
  338. XORDON (I,MM) = MLREE2.PROG(MM)
  339. 26 CONTINUE
  340. SEGDES MLREE1
  341. SEGDES MLREE2
  342. SEGDES KEVOLL
  343. SEGDES MEVOLL
  344. ENDIF
  345. *
  346. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  347. IPLIB(I,1) = IPLAC
  348.  
  349.  
  350. *--------------------------------------------------------------------*
  351. * --- choc elementaire CERCLE_PLAN_FROTTEMENT avec ou sans amortissement
  352. *--------------------------------------------------------------------*
  353. *
  354. ELSE IF (ITYP.EQ.5) THEN
  355. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  356. & 'POINT',I1,X1,CHARRE,L1,IMOD)
  357. IF (IERR.NE.0) RETURN
  358. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  359. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  360. IF (IERR.NE.0) RETURN
  361. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  362. & 'FLOTTANT',I0,XRAIN,CHARRE,L1,IP1)
  363. IF (IERR.NE.0) RETURN
  364. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  365. & 'FLOTTANT',I0,XJEU,CHARRE,L1,IP1)
  366. IF (IERR.NE.0) RETURN
  367. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_SUPPORT',L0,IP0,
  368. & 'FLOTTANT',I0,XRAYP,CHARRE,L1,IP1)
  369. IF (IERR.NE.0) RETURN
  370. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  371. & 'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  372. IF (IERR.NE.0) RETURN
  373. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  374. & 'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  375. IF (IERR.NE.0) RETURN
  376. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  377. & 'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  378. IF (IERR.NE.0) RETURN
  379. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  380. & IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  381. IF (IERR.NE.0) RETURN
  382. *
  383. MONAMO = ' '
  384. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  385. & MONAMO,I1,XAMON,CHARRE,L1,IP1)
  386. IF (IERR.NE.0) RETURN
  387. *
  388. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  389. * pas lu la notice jusqu'au bout :
  390. IF(XRAIT.LT.0.D0) THEN
  391. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  392. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  393. WRITE(IOIMP,*)
  394. & 'utilisation du modele de frottement regularise d ODEN'
  395. ENDIF
  396. IF(XAMOT.LE.0D0) THEN
  397. c ERREUR: %m1:8 = %r1 inferieur a %r2
  398. MOTERR(1:8)='AMOR*_T*'
  399. REAERR(1)=XAMOT
  400. REAERR(2)=0.D0
  401. CALL ERREUR(41)
  402. RETURN
  403. ENDIF
  404. ENDIF
  405.  
  406. IPALB(I,1) = ITYP
  407. IPALB(I,3) = IDIM
  408. XPALB(I,1) = XRAIN
  409. XPALB(I,2) = XJEU
  410. XPALB(I,3) = XGLIS
  411. XPALB(I,4) = XADHE
  412. XPALB(I,5) = XRAIT
  413. XPALB(I,6) = XAMOT
  414. *
  415. IPNV = (IDIM + 1) * (IPOI - 1)
  416. PS = 0.D0
  417. DO 30 ID = 1,IDIM
  418. XC = XCOOR(IPNV + ID)
  419. PS = PS + XC * XC
  420. 30 CONTINUE
  421. * end do
  422. IF (PS.LE.0.D0) THEN
  423. CALL ERREUR(162)
  424. RETURN
  425. ENDIF
  426. IF (MONAMO.EQ.'FLOTTANT') THEN
  427. IPALB(I,1) = 6
  428. XPALB(I,7) = XAMON
  429. ID1 = 7
  430. ELSE
  431. ID1 = 6
  432. ENDIF
  433. ID8 = ID1 + 7*IDIM
  434. XPALB(I,ID8+1) = XRAYP
  435. DO 32 ID = 1,IDIM
  436. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  437. 32 CONTINUE
  438. * end do
  439. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  440. IPLIB(I,1) = IPLAC
  441. *
  442. *--------------------------------------------------------------------*
  443. * --- choc elementaire POINT_PLAN_FLUIDE
  444. *--------------------------------------------------------------------*
  445. *
  446. ELSE IF (ITYP.EQ.7) THEN
  447. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  448. & 'POINT',I1,X1,CHARRE,L1,IMOD)
  449. IF (IERR.NE.0) RETURN
  450. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  451. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  452. IF (IERR.NE.0) RETURN
  453. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_INERTIE',L0,IP0,
  454. & 'FLOTTANT',I0,XINER,CHARRE,L1,IP1)
  455. IF (IERR.NE.0) RETURN
  456. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_CONVECTION',L0,IP0,
  457. & 'FLOTTANT',I0,XCONV,CHARRE,L1,IP1)
  458. IF (IERR.NE.0) RETURN
  459. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_VISCOSITE',L0,IP0,
  460. & 'FLOTTANT',I0,XVISC,CHARRE,L1,IP1)
  461. IF (IERR.NE.0) RETURN
  462. CALL ACCTAB(ITLB,'MOT',I1,X0,
  463. & 'COEFFICIENT_P_D_C_ELOIGNEMENT',L0,IP0,
  464. & 'FLOTTANT',I0,XPCEL,CHARRE,L1,IP1)
  465. IF (IERR.NE.0) RETURN
  466. CALL ACCTAB(ITLB,'MOT',I1,X0,
  467. & 'COEFFICIENT_P_D_C_RAPPROCHEMENT',L0,IP0,
  468. & 'FLOTTANT',I0,XPCRA,CHARRE,L1,IP1)
  469. IF (IERR.NE.0) RETURN
  470. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU_FLUIDE',L0,IP0,
  471. & 'FLOTTANT',I0,XJEU,CHARRE,L1,IP1)
  472. IF (IERR.NE.0) RETURN
  473. *
  474. IPALB(I,1) = ITYP
  475. IPALB(I,3) = IDIM
  476. XPALB(I,1) = XINER
  477. XPALB(I,2) = XCONV
  478. XPALB(I,3) = XVISC
  479. XPALB(I,4) = XPCEL
  480. XPALB(I,5) = XPCRA
  481. XPALB(I,6) = XJEU
  482. *
  483. IPNV = (IDIM + 1) * (IPOI - 1)
  484. PS = 0.D0
  485. DO 70 ID = 1,IDIM
  486. XC = XCOOR(IPNV + ID)
  487. PS = PS + XC * XC
  488. 70 CONTINUE
  489. * end do
  490. IF (PS.LE.0.D0) THEN
  491. CALL ERREUR(162)
  492. RETURN
  493. ENDIF
  494. ID1 = 6
  495. DO 72 ID = 1,IDIM
  496. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  497. 72 CONTINUE
  498. * end do
  499. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  500. IPLIB(I,1) = IPLAC
  501. *
  502. *--------------------------------------------------------------------*
  503. * --- choc elementaire ..._PLAN...
  504. *--------------------------------------------------------------------*
  505. *
  506. * ELSE IF (ITYP.EQ. ) THEN
  507. * ...
  508. * ...
  509. ENDIF
  510. *
  511. END
  512.  
  513.  
  514.  
  515.  
  516.  
  517.  
  518.  
  519.  
  520.  
  521.  

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