Télécharger rlenct.eso

Retour à la liste

Numérotation des lignes :

  1. C RLENCT SOURCE CHAT 05/01/13 03:01:32 5004
  2. SUBROUTINE RLENCT(MELFL,MELSOM,MLEPOI,MLECOE,MLEPOF,MLECOF)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : RLENCT
  8. C
  9. C DESCRIPTION : Appelle par GRADI2
  10. C
  11. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12. C
  13. C AUTEUR : A. BECCANTINI
  14. C
  15. C************************************************************************
  16. C
  17. C
  18. C This subroutine computes the coefficients to compute the gradient
  19. C at intefaces with respect to the values on its neighbors.
  20. C The neighbors are 'CENTRE' points or 'boundary condition' points.
  21. C
  22. C**** Inputs:
  23. C
  24. C MELFL = 'FACEL' meleme
  25. C
  26. C MELSOM = 'SOMMET' meleme
  27. C
  28. C MLEPOI = list of integers.
  29. C MLEPOI.LECT(i) points to the list neighbors of
  30. C MELSOM.NUM(1,I). Neighbors are 'CENTRE' points or
  31. C 'boundary condition' points
  32. C MLECOE = list of integers.
  33. C MLECOE.LECT(i) points to the list of real of coeffients
  34. C to compute the vertex values
  35. C
  36. C MLEPOF = list of integers.
  37. C MLEPOI.LECT(i) points to the list neighbors of
  38. C MELFL.NUM(2,i). Neighbors are 'CENTRE' points or
  39. C 'SOMMET' points.
  40. C MLECOF = list of integers.
  41. C MLECOE.LECT(i) points to the matrix of coeffients to
  42. C compute the gradient with respect the neighbors value
  43. C
  44. C**** Output:
  45. C
  46. C MLEPOF = list of integers.
  47. C MLEPOI.LECT(i) points to the list neighbors of
  48. C MELFL.NUM(2,i). Neighbors are 'CENTRE' points or
  49. C 'boundary condition' points. The first one is the
  50. C 'FACE' point itself.
  51. C MLECOE = list of integers.
  52. C MLECOE.LECT(i) points to the matrix of coeffients to
  53. C compute the gradient
  54. C
  55. C**** Variables de COOPTIO
  56. C
  57. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  58. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  59. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  60. C & ,IECHO, IIMPI, IOSPI
  61. C & ,IDIM
  62. CC & ,MCOORD
  63. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  64. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  65. C & ,NORINC,NORVAL,NORIND,NORVAD
  66. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  67. CC
  68. IMPLICIT INTEGER(I-N)
  69. -INC CCOPTIO
  70. -INC SMCOORD
  71. -INC SMLENTI
  72. -INC SMLREEL
  73. -INC SMELEME
  74. C
  75. INTEGER NTP, NFAC, IFAC, NVOIF, IVOIF, NGV, NLS, NLV
  76. & ,NVOIS,IVOIS,NGVS, LAST, LAST0, NSOMM, IPOS
  77. & ,I1,ICELL,NGF
  78. REAL*8 CELL
  79. INTEGER JG
  80. INTEGER N1,N2
  81. SEGMENT MATRIX
  82. REAL*8 MAT(N1,N2)
  83. ENDSEGMENT
  84. POINTEUR MELSOM.MELEME, MLEPOI.MLENTI,MLECOE.MLENTI, MELFL.MELEME
  85. & ,MLEPOF.MLENTI,MLECOF.MLENTI
  86. & ,MATCOE.MATRIX,MATCO1.MATRIX,MLRCOE.MLREEL,MLREST.MLENTI
  87. & ,MLESOM.MLENTI,MLPOSI.MLENTI
  88. C
  89. C
  90. SEGACT MELFL
  91. C
  92. NTP=MCOORD.XCOOR(/1)/(IDIM+1)
  93. C
  94. C**** Chaining list
  95. C LAST
  96. C MLREST(NTP)
  97. C
  98. JG=NTP
  99. SEGINI MLREST
  100. LAST=-1
  101. C
  102. C**** Position of a point in the list of neighbors
  103. C MLREST is used to clean it at the end
  104. C
  105. JG=NTP
  106. SEGINI MLPOSI
  107. C
  108. C**** We create the MLENTI for the sommets
  109. C
  110. CALL KRIPAD(MELSOM,MLESOM)
  111. IF(IERR .NE. 0)GOTO 9999
  112. C En KRIPAD
  113. C SEGACT MELSOM
  114. C SEGINI MLESOM
  115. C
  116. SEGACT MLEPOF*MOD
  117. NFAC=MLEPOF.LECT(/1)
  118. SEGACT MLECOF*MOD
  119. C
  120. SEGACT MLEPOI
  121. SEGACT MLECOE
  122. C
  123. NSOMM=MLEPOI.LECT(/1)
  124. DO I1=1,NSOMM,1
  125. MLENTI=MLEPOI.LECT(I1)
  126. SEGACT MLENTI
  127. MLREEL=MLECOE.LECT(I1)
  128. SEGACT MLREEL
  129. ENDDO
  130. C
  131. DO IFAC=1,NFAC,1
  132. NGF=MELFL.NUM(2,IFAC)
  133. MLENT1=MLEPOF.LECT(IFAC)
  134. SEGACT MLENT1
  135. NVOIF=MLENT1.LECT(/1)
  136. C
  137. C******* We fill MLREST, MLPOSI
  138. C
  139. LAST=-1
  140. IPOS=1
  141. MLREST.LECT(NGF)=LAST
  142. LAST=NGF
  143. DO IVOIF=1,NVOIF,1
  144. NGV=MLENT1.LECT(IVOIF)
  145. C
  146. C********** First of all, we have to check if this is a
  147. C 'SOMMET' point. In that case we have to replace
  148. C it by its neighbors.
  149. C
  150. NLS=MLESOM.LECT(NGV)
  151. C
  152. IF(NLS .GT. 0)THEN
  153. C 'SOMMET'
  154. MLENT2=MLEPOI.LECT(NLS)
  155. NVOIS=MLENT2.LECT(/1)
  156. DO IVOIS=1,NVOIS,1
  157. NGVS=MLENT2.LECT(IVOIS)
  158. NLV=MLREST.LECT(NGVS)
  159. IF(NLV .EQ. 0)THEN
  160. C
  161. C**************** New point
  162. C
  163. IPOS=IPOS+1
  164. MLREST.LECT(NGVS)=LAST
  165. LAST=NGVS
  166. ENDIF
  167. ENDDO
  168. ELSE
  169. C 'CENTRE'
  170. NLV=MLREST.LECT(NGV)
  171. IF(NLV .EQ. 0)THEN
  172. C
  173. C************* New point
  174. C
  175. IPOS=IPOS+1
  176. MLREST.LECT(NGV)=LAST
  177. LAST=NGV
  178. ENDIF
  179. ENDIF
  180. ENDDO
  181. C
  182. C********** We create the new list of neighbors
  183. C
  184. JG=IPOS
  185. SEGINI MLENTI
  186. MLEPOF.LECT(IFAC)=MLENTI
  187. LAST0=LAST
  188. DO IVOIF=1,IPOS,1
  189. I1=(IPOS-IVOIF)+1
  190. MLENTI.LECT(I1)=LAST
  191. MLPOSI.LECT(LAST)=I1
  192. LAST=MLREST.LECT(LAST)
  193. ENDDO
  194. IF(LAST .NE. -1)THEN
  195. WRITE(IOIMP,*) 'subroutine rlenct.eso'
  196. CALL ERREUR(5)
  197. ENDIF
  198. LAST=LAST0
  199. C
  200. C******* Summarizing
  201. C
  202. C MLENTI: list of the new 'FACE' neighbors
  203. C MLENT1: list of the old 'FACE' neighbors
  204. C MLENT2: is free. It has been used and it will be used
  205. C for the 'SOMMET' neighbors.
  206. C MLPOSI: position of the new neighbors into MLENTI
  207. C MLREST + LAST : chaining list, used to clean MLPOSI
  208. C
  209. C******* Let us call
  210. C MATCOE: matrix of the 'FACE' coeff (IDIM+1,*)
  211. C MATCO1: matrix of the old 'FACE' coeff. (IDIM+1,*)
  212. C MLRCOE: list of the 'SOMMET coeff
  213. C
  214. C
  215. MATCO1=MLECOF.LECT(IFAC)
  216. SEGACT MATCO1
  217. N1=IDIM+1
  218. N2=MLENTI.LECT(/1)
  219. SEGINI MATCOE
  220. MLECOF.LECT(IFAC)=MATCOE
  221. C
  222. C******* Loop on the old 'FACE' neighbors
  223. C
  224. NVOIF=MLENT1.LECT(/1)
  225. DO IVOIF=1,NVOIF,1
  226. NGV=MLENT1.LECT(IVOIF)
  227. NLS=MLESOM.LECT(NGV)
  228. C
  229. IF(NLS .GT. 0)THEN
  230. C 'SOMMET'
  231. MLENT2=MLEPOI.LECT(NLS)
  232. MLRCOE=MLECOE.LECT(NLS)
  233. NVOIS=MLENT2.LECT(/1)
  234. DO IVOIS=1,NVOIS,1
  235. NGVS=MLENT2.LECT(IVOIS)
  236. IPOS=MLPOSI.LECT(NGVS)
  237. IF(IPOS .EQ. 0)THEN
  238. WRITE(IOIMP,*) 'subroutine rlenct.eso'
  239. CALL ERREUR(5)
  240. ENDIF
  241. DO I1=1,IDIM+1,1
  242. MATCOE.MAT(I1,IPOS)=MATCOE.MAT(I1,IPOS)+
  243. & (MATCO1.MAT(I1,IVOIF)*MLRCOE.PROG(IVOIS))
  244. ENDDO
  245. ENDDO
  246. ELSE
  247. C 'CENTRE'
  248. IPOS=MLPOSI.LECT(NGV)
  249. DO I1=1,IDIM+1,1
  250. MATCOE.MAT(I1,IPOS)=MATCOE.MAT(I1,IPOS)+
  251. & MATCO1.MAT(I1,IVOIF)
  252. ENDDO
  253. ENDIF
  254. ENDDO
  255. C
  256. CC
  257. CC******* Test
  258. CC
  259. C ipos=mlenti.lect(/1)
  260. C write(*,*) 'ngf=',melfl.num(2,ifac)
  261. C write(*,*) 'ntvois=',ipos
  262. C write(*,*) 'nvois=',(mlenti.lect(ivoif),ivoif=1,ipos,1)
  263. C write(*,*) 'Position=',
  264. C & (mlposi.lect(mlenti.lect(ivoif)),ivoif=1,ipos,1)
  265. C write(*,*) 'coeff(1) =',(matcoe.mat(1,ivoif),ivoif=1,ipos,1)
  266. C write(*,*) 'coeff(2) =',(matcoe.mat(2,ivoif),ivoif=1,ipos,1)
  267. C write(*,*) 'coeff(3) =',(matcoe.mat(3,ivoif),ivoif=1,ipos,1)
  268. C if(idim.eq.3) write(*,*) 'coeff(4)=',
  269. C & (matcoe.mat(4,ivoif),ivoif=1,ipos,1)
  270. C cell=0.0D0
  271. C do ivoif=1,ipos,1
  272. C cell=cell+matcoe.mat(1,ivoif)
  273. C enddo
  274. C write(*,*) 'sum=',cell
  275. C if(abs(cell-1.0d0) .gt. 1.0d-10)then
  276. CC It must be true if I just consider Dirichlet B.C.
  277. C call erreur(5)
  278. C goto 9999
  279. C endif
  280. C
  281. C******* We clean MLPOSI and MLREST
  282. C
  283. NVOIS=MLENTI.LECT(/1)
  284. DO IVOIF=1,NVOIS,1
  285. MLPOSI.LECT(LAST)=0
  286. ICELL=LAST
  287. LAST=MLREST.LECT(ICELL)
  288. MLREST.LECT(ICELL)=0
  289. ENDDO
  290. IF(LAST .NE. -1)THEN
  291. WRITE(IOIMP,*) 'subroutine rlenct.eso'
  292. CALL ERREUR(5)
  293. ENDIF
  294. C
  295. SEGSUP MATCO1
  296. SEGSUP MLENT1
  297. SEGDES MATCOE
  298. SEGDES MLENTI
  299. C
  300. ENDDO
  301. CC
  302. CC******* Test
  303. CC
  304. C do ifac=1,nfac,1
  305. C mlenti=mlepof.lect(ifac)
  306. C matcoe=mlecof.lect(ifac)
  307. C segact mlenti
  308. C segact matcoe
  309. C ipos=mlenti.lect(/1)
  310. C write(*,*) 'ngf=',melfl.num(2,ifac)
  311. C write(*,*) 'ntvois=',ipos
  312. C write(*,*) 'nvois=',(mlenti.lect(ivoif),ivoif=1,ipos,1)
  313. C write(*,*) 'coeff(1) =',(matcoe.mat(1,ivoif),ivoif=1,ipos,1)
  314. C write(*,*) 'coeff(2) =',(matcoe.mat(2,ivoif),ivoif=1,ipos,1)
  315. C write(*,*) 'coeff(3) =',(matcoe.mat(3,ivoif),ivoif=1,ipos,1)
  316. C if(idim.eq.3) write(*,*) 'coeff(4)=',
  317. C & (matcoe.mat(4,ivoif),ivoif=1,ipos,1)
  318. C cell=0.0D0
  319. C do ivoif=1,ipos,1
  320. C cell=cell+matcoe.mat(1,ivoif)
  321. C enddo
  322. C write(*,*) 'sum=',cell
  323. C if(abs(cell-1.0d0) .gt. 1.0d-10)then
  324. CC It must be true if I just consider Dirichlet B.C.
  325. C call erreur(5)
  326. C goto 9999
  327. C endif
  328. C segdes mlenti
  329. C segdes matcoe
  330. C enddo
  331. C
  332. SEGDES MELFL
  333. C
  334. SEGSUP MLREST
  335. SEGSUP MLPOSI
  336. C
  337. SEGDES MELSOM
  338. SEGSUP MLESOM
  339. C
  340. SEGDES MLEPOF
  341. SEGDES MLECOF
  342. C
  343. NSOMM=MLEPOI.LECT(/1)
  344. DO I1=1,NSOMM,1
  345. MLENTI=MLEPOI.LECT(I1)
  346. SEGSUP MLENTI
  347. MLREEL=MLECOE.LECT(I1)
  348. SEGSUP MLREEL
  349. ENDDO
  350. SEGSUP MLEPOI
  351. SEGSUP MLECOE
  352. C
  353. 9999 CONTINUE
  354. RETURN
  355. END
  356.  
  357.  
  358.  
  359.  

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