Télécharger klno.eso

Retour à la liste

Numérotation des lignes :

  1. C KLNO SOURCE GF238795 18/02/01 21:15:55 9724
  2. SUBROUTINE KLNO
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C Operateur KLNO
  7. C
  8. C Objet : transforme un CHAMPOINT CENTRE en un CHAMPOINT SOMMET
  9. C
  10. C SYNTAXE : CHPS = KLNO OBJM CHPC (MOTCLE (GRAD LIMI));
  11. C
  12. C OBJM : Objet modèle 'Navier_Stokes'
  13. C : a la rigueur table DOMAINE
  14. C CHPC : CHAMPOINT CENTRE
  15. C CHPS : CHAMPOINT SOMMET
  16. C
  17. C*************************************************************************
  18. -INC SMELEME
  19. POINTEUR MELEMS.MELEME,MELEMC.MELEME,MELEP1.MELEME
  20. POINTEUR IGEOMB.MELEME
  21. -INC CCOPTIO
  22. -INC CCREEL
  23. -INC SMCOORD
  24. -INC CCGEOME
  25. -INC SMMODEL
  26. -INC SMCHPOI
  27. POINTEUR IZB.MCHPOI,IZBB.MPOVAL
  28. POINTEUR IZD.MCHPOI,IZDD.MPOVAL
  29. -INC SMLENTI
  30. POINTEUR IZIPAP.MLENTI,IZIPAD.MLENTI
  31. -INC SIZFFB
  32. POINTEUR IZF1.IZFFM
  33. DIMENSION ITABO(4)
  34. integer IP
  35. CHARACTER*8 TYPE,TYPC,NOM0,TYPSPG, CHAI
  36. CHARACTER*8 LISMO(5)
  37. DATA LISMO/'CENTRE ','CENTREP0','CENTREP1','MSOMMET','VOLUMF '/
  38. IP=0
  39. C***********************************************************************
  40. C**** Case VF **********************************************************
  41. C***********************************************************************
  42. CALL QUETYP(TYPE,1,IRET)
  43. IF(IERR.NE.0)GOTO 9999
  44. IF(TYPE .EQ. 'MOT ')THEN
  45. CALL LIRCHA(CHAI,1,IRET)
  46. IF(IERR.NE.0)GOTO 9999
  47. IF(CHAI.EQ. 'VF ')THEN
  48. C
  49. C CHPOINT to project
  50. C
  51. CALL LIROBJ('CHPOINT',IZB,1,IRET)
  52. IF(IERR.NE.0)GOTO 9999
  53. SEGACT IZB
  54. IF(IZB.IPCHP(/1).NE.1) THEN
  55. CALL ERREUR(920)
  56. C Erreur dans le partitionnement
  57. GOTO 9999
  58. ENDIF
  59. SEGDES IZB
  60. C
  61. C Domain table
  62. C
  63. CALL LIROBJ('TABLE ',MTABD,1,IRET)
  64. IF(IERR.NE.0)GOTO 9999
  65. C
  66. C Gradient
  67. C
  68. CALL LIROBJ('CHPOINT',MCHPO1,1,IRET)
  69. IF(IERR.NE.0)GOTO 9999
  70. C
  71. C Limiter
  72. C
  73. CALL LIROBJ('CHPOINT',MCHPO2,1,IRET)
  74. IF(IERR.NE.0)GOTO 9999
  75. C
  76. C Computation
  77. C
  78. CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD)
  79. IF(IERR.NE.0)GOTO 9999
  80. C
  81. C We write the result
  82. C
  83. CALL ECROBJ('CHPOINT ',MCHPOI)
  84. GOTO 9999
  85. ELSE
  86. C
  87. C******* I apologize myself and I give back the mot
  88. C
  89. CALL REFUS
  90. ENDIF
  91. ENDIF
  92.  
  93. C***********************************************************************
  94. C**** End of the case VF ***********************************************
  95. C***********************************************************************
  96. C
  97. IAXI=0
  98. IF(IFOMOD.EQ.0)IAXI=2
  99.  
  100. CALL LIRCHA(CHAI,0,IRET)
  101.  
  102. IF(IRET.EQ.0)THEN
  103. TYPSPG='CENTRE'
  104. ELSE
  105. CALL REFUS
  106. CALL LIRMOT(LISMO,5,IP,1)
  107. IF(IP.EQ.0)RETURN
  108. TYPSPG=LISMO(IP)
  109. ENDIF
  110.  
  111. IF(TYPSPG.EQ.'VOLUMF')GO TO 51
  112.  
  113. CALL LIROBJ('CHPOINT',IZB,1,IRETOU)
  114. IF(IRETOU.EQ.0)RETURN
  115. *
  116. * Verification du CHPOINT
  117. *
  118.  
  119. SEGACT IZB
  120. IF(IZB.IPCHP(/1).NE.1)THEN
  121. C% Erreur dans le partitionnement
  122. CALL ERREUR(920)
  123. SEGDES IZB
  124. RETURN
  125. ENDIF
  126.  
  127.  
  128. CALL LIROBJ('MMODEL ',MMODEL,0,IRET)
  129. IF(IRET.EQ.1)THEN
  130. *
  131. * Verification de l'objet modele 'Navier-Stokes'
  132. *
  133. C***
  134. SEGACT MMODEL
  135. N1=KMODEL(/1)
  136. DO 41 L=1,N1
  137. IMODEL=KMODEL(L)
  138. SEGACT IMODEL
  139. IF(FORMOD(1).NE.'NAVIER_STOKES')THEN
  140. IF(FORMOD(1).NE.'DARCY')THEN
  141. C% On veut un modèle de type %m1:16 .
  142. MOTERR( 1:16) = 'NAVIER_STOKES '
  143. CALL ERREUR(719)
  144. RETURN
  145. ENDIF
  146. ENDIF
  147. SEGDES IMODEL
  148. 41 CONTINUE
  149.  
  150. CALL LEKMOD(MMODEL,MTABD,INEFMD)
  151. C INEFMD=1 LINE =2 MACRO =3 QUADRATIQUE =4 LINB
  152. ELSE
  153. CALL LIROBJ('TABLE ',MTABD,1,IRET)
  154. IF(IRET.EQ.0)RETURN
  155. ENDIF
  156. C------------------ Traitement du cas VOLUMF ----------------------------
  157. 51 CONTINUE
  158. IF (IP .EQ. 5) THEN
  159. CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU)
  160. IF(IRETOU.EQ.0) THEN
  161. C% Information manquante (objet CHPOINT) : pas de définition de la densité
  162. CALL ERREUR(839)
  163. RETURN
  164. ENDIF
  165. CALL LIROBJ('CHPOINT',MCHPO2,1,IRETOU)
  166. IF(IRETOU.EQ.0) THEN
  167. C% Information manquante (objet CHPOINT) : pas de définition de la densité
  168. CALL ERREUR(839)
  169. RETURN
  170. ENDIF
  171. CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD)
  172. GOTO 360
  173. ENDIF
  174.  
  175. C------------------ Traitement des cas CENTRE CENTREP0 CENTREP1 ---------
  176. 52 CONTINUE
  177. C
  178.  
  179. DEUPI=1.D0
  180. IF(IAXI.NE.0)DEUPI=2.D0*XPI
  181.  
  182. CALL LICHTL(IZB,IZBB,TYPC,IGEOMB)
  183. NC=IZBB.VPOCHA(/2)
  184. N=IZBB.VPOCHA(/1)
  185. SEGINI MPOVA3
  186. SEGACT IGEOMB
  187.  
  188. CALL LEKTAB(MTABD,TYPSPG,MELEMC)
  189. IF (IERR.NE.0) RETURN
  190. CALL KRIPAD(IGEOMB,IZIPAP)
  191. CALL VERPAD(IZIPAP,MELEMC,IRET)
  192. IF(IRET.NE.0)THEN
  193. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  194. MOTERR(1: 8) = TYPSPG
  195. MOTERR(9:16) = 'CHPOINT '
  196. CALL ERREUR(788)
  197. RETURN
  198. ENDIF
  199.  
  200. CALL LEKTAB(MTABD,'SOMMET',MELEMS)
  201. CALL KRIPAD(MELEMS,IZIPAD)
  202. TYPE='SOMMET'
  203. CALL CRCHPT(TYPE,MELEMS,NC,MCHPOI)
  204. CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM)
  205.  
  206. CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
  207.  
  208. C------------ Cas MSOMMET ------------------------------------------------
  209. C------------ Cas MSOMMET ------------------------------------------------
  210.  
  211. IF(TYPSPG.EQ.'MSOMMET')THEN
  212.  
  213. IF(INEFMD.EQ.2)THEN
  214. CALL LEKTAB(MTABD,'MACRO1',MELEME)
  215. ENDIF
  216.  
  217. CALL VERPAD(IZIPAD,MELEMC,IRET)
  218. IF(IRET.NE.0)THEN
  219. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  220. MOTERR(1: 8) = TYPSPG
  221. MOTERR(9:16) = 'CHPOINT '
  222. CALL ERREUR(788)
  223. RETURN
  224. ENDIF
  225.  
  226. C On place les valeurs aux sommets de l'élément
  227. DO 741 I=1,N
  228. DO 741 M=1,NC
  229. iu = IZIPAD.LECT(MELEMC.NUM(1,I))
  230. VPOCHA(iu,M)=IZBB.VPOCHA(I,M)
  231. 741 CONTINUE
  232.  
  233. IF(INEFMD.EQ.1)GO TO 790
  234.  
  235. SEGACT MELEME
  236. NBSOUS=LISOUS(/1)
  237.  
  238. DO 742 L=1,(MAX(1,NBSOUS))
  239. IPT1=MELEME
  240. IF(NBSOUS.NE.0)IPT1=LISOUS(L)
  241. SEGACT IPT1
  242.  
  243. NBELEM =IPT1.NUM(/2)
  244. NBNN =IPT1.NUM(/1)
  245.  
  246. IF(IPT1.ITYPEL.EQ.6)THEN
  247. C write(6,*)' TRI6'
  248.  
  249. DO 643 K=1,NBELEM
  250. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  251. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  252. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  253. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  254. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  255. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  256. DO 645 M=1,NC
  257. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  258. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  259. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  260. 645 CONTINUE
  261. 643 CONTINUE
  262.  
  263. ELSEIF(IPT1.ITYPEL.EQ.7)THEN
  264. C write(6,*)' TRI7'
  265.  
  266. DO 743 K=1,NBELEM
  267. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  268. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  269. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  270. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  271. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  272. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  273. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  274. DO 745 M=1,NC
  275. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  276. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  277. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  278. VPOCHA(iu7,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  279. 745 CONTINUE
  280. 743 CONTINUE
  281.  
  282. ELSEIF(IPT1.ITYPEL.EQ.11)THEN
  283. C write(6,*)' QUA9'
  284.  
  285. DO 943 K=1,NBELEM
  286. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  287. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  288. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  289. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  290. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  291. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  292. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  293. iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  294. iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  295. DO 945 M=1,NC
  296. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  297. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  298. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  299. VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  300. VPOCHA(iu9,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  301. & VPOCHA(iu7,M))/4.D0
  302. 945 CONTINUE
  303. 943 CONTINUE
  304.  
  305. ELSEIF(IPT1.ITYPEL.EQ.33)THEN
  306. C write(6,*)' CU27'
  307.  
  308. DO 2743 K=1,NBELEM
  309. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  310. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  311. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  312. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  313. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  314. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  315. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  316. iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  317. iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  318. iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  319. iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  320. iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  321. iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  322. iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  323. iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  324. iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  325. iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  326. iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  327. iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  328. iu20= IZIPAD.LECT(IPT1.NUM(20,K))
  329. iu21= IZIPAD.LECT(IPT1.NUM(21,K))
  330. iu22= IZIPAD.LECT(IPT1.NUM(22,K))
  331. iu23= IZIPAD.LECT(IPT1.NUM(23,K))
  332. iu24= IZIPAD.LECT(IPT1.NUM(24,K))
  333. iu25= IZIPAD.LECT(IPT1.NUM(25,K))
  334. iu26= IZIPAD.LECT(IPT1.NUM(26,K))
  335. iu27= IZIPAD.LECT(IPT1.NUM(27,K))
  336. DO 2745 M=1,NC
  337. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  338. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  339. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  340. VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  341. VPOCHA(iu25,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  342. & VPOCHA(iu7,M))/4.D0
  343.  
  344. VPOCHA(iu14,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M))*0.5
  345. VPOCHA(iu16,M)=(VPOCHA(iu15,M)+VPOCHA(iu17,M))*0.5
  346. VPOCHA(iu18,M)=(VPOCHA(iu17,M)+VPOCHA(iu19,M))*0.5
  347. VPOCHA(iu20,M)=(VPOCHA(iu19,M)+VPOCHA(iu13,M))*0.5
  348. VPOCHA(iu26,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+
  349. & VPOCHA(iu19,M))/4.D0
  350.  
  351. VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5
  352. VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu15,M))*0.5
  353. VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu17,M))*0.5
  354. VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu19,M))*0.5
  355.  
  356. VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu15,M)+
  357. & VPOCHA(iu13,M))/4.D0
  358. VPOCHA(iu22,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu17,M)+
  359. & VPOCHA(iu15,M))/4.D0
  360. VPOCHA(iu23,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M)+VPOCHA(iu17,M)+
  361. & VPOCHA(iu19,M))/4.D0
  362. VPOCHA(iu24,M)=(VPOCHA(iu1 ,M)+VPOCHA(iu7,M)+VPOCHA(iu19,M)+
  363. & VPOCHA(iu13,M))/4.D0
  364. VPOCHA(iu27,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  365. &VPOCHA(iu7,M)+VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+
  366. & VPOCHA(iu19,M))/8.D0
  367. 2745 CONTINUE
  368. 2743 CONTINUE
  369.  
  370. ELSEIF(IPT1.ITYPEL.EQ.34)THEN
  371. C write(6,*)' PR21'
  372.  
  373. DO 2143 K=1,NBELEM
  374. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  375. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  376. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  377. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  378. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  379. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  380. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  381. iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  382. iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  383. iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  384. iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  385. iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  386. iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  387. iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  388. iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  389. iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  390. iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  391. iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  392. iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  393. iu20= IZIPAD.LECT(IPT1.NUM(20,K))
  394. iu21= IZIPAD.LECT(IPT1.NUM(21,K))
  395. DO 2145 M=1,NC
  396. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  397. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  398. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  399. VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  400.  
  401. VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5
  402. VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5
  403. VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5
  404. VPOCHA(iu20,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/3.D0
  405.  
  406. VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  407. VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5
  408. VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5
  409.  
  410. VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+
  411. & VPOCHA(iu10,M))/4.D0
  412. VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+
  413. & VPOCHA(iu14,M))/4.D0
  414. VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+
  415. & VPOCHA(iu10,M))/4.D0
  416. VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  417. & VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/6.D0
  418. 2145 CONTINUE
  419. 2143 CONTINUE
  420.  
  421. ELSEIF(IPT1.ITYPEL.EQ.40)THEN
  422. C write(6,*)' PR18'
  423.  
  424. DO 1843 K=1,NBELEM
  425. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  426. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  427. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  428. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  429. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  430. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  431. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  432. iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  433. iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  434. iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  435. iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  436. iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  437. iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  438. iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  439. iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  440. iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  441. iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  442. iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  443. DO 1845 M=1,NC
  444. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  445. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  446. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  447.  
  448. VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5
  449. VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5
  450. VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5
  451.  
  452. VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  453. VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5
  454. VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5
  455.  
  456. VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+
  457. & VPOCHA(iu10,M))/4.D0
  458. VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+
  459. & VPOCHA(iu14,M))/4.D0
  460. VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+
  461. & VPOCHA(iu10,M))/4.D0
  462. 1845 CONTINUE
  463. 1843 CONTINUE
  464.  
  465. ELSEIF(IPT1.ITYPEL.EQ.35)THEN
  466. C write(6,*)' TE15'
  467.  
  468. DO 1543 K=1,NBELEM
  469. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  470. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  471. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  472. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  473. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  474. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  475. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  476. iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  477. iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  478. iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  479. iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  480. iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  481. iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  482. iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  483. iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  484. DO 1545 M=1,NC
  485. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  486. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  487. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  488. VPOCHA(iu11,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  489.  
  490. VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  491. VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5
  492. VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5
  493.  
  494. VPOCHA(iu12,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu10,M))/3.D0
  495. VPOCHA(iu13,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu10,M))/3.D0
  496. VPOCHA(iu14,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu10,M))/3.D0
  497. VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  498. & VPOCHA(iu10,M))/4.D0
  499. 1545 CONTINUE
  500. 1543 CONTINUE
  501.  
  502. ELSEIF(IPT1.ITYPEL.EQ.24)THEN
  503. C write(6,*)' TE10'
  504.  
  505. DO 1043 K=1,NBELEM
  506. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  507. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  508. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  509. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  510. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  511. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  512. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  513. iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  514. iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  515. iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  516. DO 1045 M=1,NC
  517. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  518. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  519. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  520.  
  521. VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  522. VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5
  523. VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5
  524. 1045 CONTINUE
  525. 1043 CONTINUE
  526.  
  527. ELSEIF(IPT1.ITYPEL.EQ.36)THEN
  528. C write(6,*)' PY19'
  529.  
  530. DO 1943 K=1,NBELEM
  531. iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  532. iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  533. iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  534. iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  535. iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  536. iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  537. iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  538. iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  539. iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  540. iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  541. iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  542. iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  543. iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  544. iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  545. iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  546. iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  547. iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  548. iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  549. iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  550. DO 1945 M=1,NC
  551. VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  552. VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  553. VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  554. VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  555. VPOCHA(iu14,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  556. & VPOCHA(iu7,M))/4.D0
  557.  
  558. VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5
  559. VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu13,M))*0.5
  560. VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu13,M))*0.5
  561. VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu13,M))*0.5
  562.  
  563. VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu13,M))/3.D0
  564. VPOCHA(iu16,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0
  565. VPOCHA(iu17,M)=(VPOCHA(iu7,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0
  566. VPOCHA(iu18,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M)+VPOCHA(iu13,M))/3.D0
  567. VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  568. & VPOCHA(iu7,M)+VPOCHA(iu13,M))/5.D0
  569. 1945 CONTINUE
  570. 1943 CONTINUE
  571.  
  572. ELSE
  573. write(6,*)' KLNO : Element ',IPT1.ITYPEL,' non implemente'
  574. C% Type d'élément incorrect
  575. CALL ERREUR(16)
  576. RETURN
  577. ENDIF
  578. segdes IPT1
  579. 742 CONTINUE
  580.  
  581.  
  582. 790 CONTINUE
  583.  
  584. SEGDES MPOVAL,MCHPOI,IZBB
  585. SEGSUP IZIPAD,IZIPAP
  586. CALL ECROBJ('CHPOINT ',MCHPOI)
  587.  
  588. RETURN
  589.  
  590.  
  591. ENDIF
  592.  
  593. C------------ Cas MSOMMET Fin --------------------------------------------
  594. C------------ Cas MSOMMET Fin --------------------------------------------
  595.  
  596.  
  597. CALL LEKTAB(MTABD,'MACRO1',MACRO1)
  598. CALL LEKTAB(MTABD,'QUADRATI',MQUAD)
  599. IF(IERR.NE.0)RETURN
  600.  
  601.  
  602. KPRE=2
  603.  
  604. MELEP1=MELEMC
  605. IF(TYPSPG.EQ.'CENTREP0')THEN
  606. IF(MACRO1.NE.0)MELEME=MACRO1
  607. KPRE=3
  608. ELSEIF(TYPSPG.EQ.'CENTREP1')THEN
  609. KPRE=4
  610. IF(MACRO1.NE.0)MELEME=MACRO1
  611. CALL LEKTAB(MTABD,'ELTP1NC ',MELEP1)
  612. ENDIF
  613.  
  614.  
  615. CALL CRCHPT(TYPE,MELEMS,NC,IZD)
  616. CALL LICHTM(IZD,IZDD,TYPC,IGEOM)
  617.  
  618. SEGACT MELEME,MELEP1,MELEMS
  619.  
  620. IF(IAXI.NE.0)THEN
  621.  
  622. NPTD=MELEMS.NUM(/2)
  623. RMINS=XGRAND
  624. DO 232 I=1,NPTD
  625. J=MELEMS.NUM(1,I)
  626. R=XCOOR((J-1)*(IDIM+1) +1)
  627. R=ABS(R)
  628. IF(R.LT.RMINS)RMINS=R
  629. 232 CONTINUE
  630.  
  631. RMIN=XGRAND
  632. DO 314 I=1,N
  633. J=IGEOMB.NUM(1,I)
  634. R=XCOOR((J-1)*(IDIM+1) +1)
  635. R=ABS(R)
  636. IF(R.LT.RMIN)RMIN=R
  637. 314 CONTINUE
  638. DR=1.2D0*(RMIN-RMINS)
  639. DR=ABS(DR)
  640. dr=max(xpetit,dr)
  641.  
  642. DO 315 I=1,N
  643. J=IGEOMB.NUM(1,I)
  644. R=XCOOR((J-1)*(IDIM+1) +1)
  645. R=ABS(R)
  646. DO 315 L=1,NC
  647. MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)*(R + DR*EXP(-(R/DR)))
  648. 315 CONTINUE
  649. DR=RMIN-RMINS
  650. if (abs(dr).lt.xpetit) dr=xpetit
  651. ELSE
  652. DO 316 I=1,N
  653. DO 316 L=1,NC
  654. MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)
  655. 316 CONTINUE
  656. ENDIF
  657.  
  658. NBSOUS=LISOUS(/1)
  659. IF(NBSOUS.EQ.0)NBSOUS=1
  660.  
  661. DO 350 N=1,NC
  662. NK=0
  663. DO 1 L=1,NBSOUS
  664. IPT1=MELEME
  665. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  666. SEGACT IPT1
  667. NP=IPT1.NUM(/1)
  668. NEL=IPT1.NUM(/2)
  669.  
  670. NOM0=NOMS(IPT1.ITYPEL)//' '
  671.  
  672. IF(MQUAD.NE.0)THEN
  673. IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  674. IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  675. IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  676. ELSEIF(MACRO1.NE.0)THEN
  677. IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' '
  678. IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  679. IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  680. ELSE
  681. IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' '
  682. ENDIF
  683.  
  684. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  685. C write(6,*)' NOM0=',nom0,kpre,IZFFM
  686.  
  687. IF(IZFFM.EQ.0)THEN
  688. C% Type d'élément incorrect
  689. CALL ERREUR(16)
  690. RETURN
  691. ENDIF
  692.  
  693. SEGACT IZFFM*MOD
  694. IZHR=KZHR(1)
  695. SEGACT IZHR*MOD
  696. NPG=FN(/2)
  697. NES=GR(/1)
  698. IZF1=KTP(1)
  699. SEGACT IZF1*MOD
  700. MP1=IZF1.FN(/1)
  701. NPGP=IZF1.FN(/2)
  702.  
  703. DO 10 K=1,NEL
  704. NK=NK+1
  705. DO 12 I=1,NP
  706. J=IPT1.NUM(I,K)
  707. DO 12 M=1,IDIM
  708. XYZ(M,I)=XCOOR((J-1)*(IDIM+1) +M)
  709. 12 CONTINUE
  710.  
  711. CALL CALJBR
  712. &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  713.  
  714. DO 35 I=1,NP
  715. IU=IZIPAD.LECT(IPT1.NUM(I,K))
  716. UU=0.D0
  717. DD=0.D0
  718. DO 340 LL=1,NPG
  719. VL=0.D0
  720. DO 34 J=1,MP1
  721. KK=IZIPAP.LECT(MELEP1.NUM(J,NK))
  722. VL=VL+IZF1.FN(J,LL)*MPOVA3.VPOCHA(KK,N)
  723. 34 CONTINUE
  724. DD=DD+FN(I,LL)*PGSQ(LL)*DEUPI
  725. UU=UU+VL*FN(I,LL)*PGSQ(LL)*DEUPI
  726. 340 CONTINUE
  727. VPOCHA(IU,N)=VPOCHA(IU,N)+UU
  728. IZDD.VPOCHA(IU,N)=IZDD.VPOCHA(IU,N)+DD
  729. 35 CONTINUE
  730.  
  731. 10 CONTINUE
  732. SEGDES IPT1
  733. 1 CONTINUE
  734.  
  735. NPTD=VPOCHA(/1)
  736. DO 13 I=1,NPTD
  737. VPOCHA(I,N)=VPOCHA(I,N)/IZDD.VPOCHA(I,1)
  738. 13 CONTINUE
  739.  
  740. IF(IAXI.NE.0)THEN
  741. DO 132 I=1,NPTD
  742. J=MELEMS.NUM(1,I)
  743. R=XCOOR((J-1)*(IDIM+1) +1)
  744. VPOCHA(I,N)=VPOCHA(I,N)/(R + DR*EXP(-(R/DR)))
  745. 132 CONTINUE
  746. ENDIF
  747.  
  748. 350 CONTINUE
  749.  
  750. SEGSUP MPOVA3
  751. SEGDES IZBB
  752. SEGDES MELEME,MPOVAL
  753. C
  754. SEGSUP IZIPAD,IZIPAP,IZFFM,IZHR,IZF1,IZD,IZDD
  755.  
  756. 360 CONTINUE
  757. CALL ECROBJ('CHPOINT ',MCHPOI)
  758.  
  759. RETURN
  760.  
  761. 1001 FORMAT(20(1X,I5))
  762. 1002 FORMAT(10(1X,1PE11.4))
  763. 1008 FORMAT(10(1X,A8))
  764. 9999 CONTINUE
  765. END
  766.  
  767.  
  768.  
  769.  
  770.  
  771.  
  772.  
  773.  
  774.  
  775.  
  776.  
  777.  
  778.  
  779.  
  780.  
  781.  
  782.  
  783.  
  784.  
  785.  
  786.  
  787.  
  788.  
  789.  
  790.  
  791.  
  792.  
  793.  
  794.  
  795.  
  796.  
  797.  
  798.  
  799.  
  800.  

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