Télécharger klno.eso

Retour à la liste

Numérotation des lignes :

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

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