Télécharger klno.eso

Retour à la liste

Numérotation des lignes :

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

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