Télécharger gradi2.eso

Retour à la liste

Numérotation des lignes :

  1. C GRADI2 SOURCE CHAT 05/01/13 00:20:35 5004
  2. SUBROUTINE GRADI2(ICEN,ISOMM,IFACL0,IFACEP,ISGLI1,ISGLI2,
  3. & INORM,ICHELM)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : GRADI2
  9. C
  10. C DESCRIPTION : Appelle par PENDI2
  11. C
  12. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  13. C
  14. C AUTEUR : A. BECCANTINI
  15. C
  16. C************************************************************************
  17. C
  18. C Inputs:
  19. C
  20. C ICEN : MELEME CENTRE
  21. C
  22. C ISOMM : MELEME SOMMET
  23. C
  24. C IFACL0 : MELEME FACEL (centre G + F + CENTRE D)
  25. C
  26. C IFACEP : MELEME FACEP (SOMMET belonging to a face + F)
  27. C
  28. C ISGLI1 : SPG of Dirichlet BC
  29. C
  30. C ISGLI2 : SPG of von Neumann BC
  31. C
  32. C INORM : interfaces normales
  33. C
  34. C Output :
  35. C
  36. C ICHELM : MCHAML which contains coeff. to compute gradients
  37. C
  38. C
  39. C
  40. C**** Variables de COOPTIO
  41. C
  42. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  43. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  44. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  45. C & ,IECHO, IIMPI, IOSPI
  46. C & ,IDIM
  47. C & ,MCOORD
  48. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  49. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  50. C & ,NORINC,NORVAL,NORIND,NORVAD
  51. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  52. C
  53. IMPLICIT INTEGER(I-N)
  54. -INC CCOPTIO
  55. -INC SMLENTI
  56. -INC SMELEME
  57. C
  58. POINTEUR MLEPOI.MLENTI, MLECOE.MLENTI, MLECOF.MLENTI
  59. & ,MLEPOF.MLENTI
  60. C
  61. INTEGER ICEN,ISOMM,IFACL0,IFACEP,IFACE,IFACEL
  62. & ,ICHELM,ISGLI1,ISGLI2,INORM
  63. C & ,I1,I2,IELEM,JG,NBE,NBN,NBSOUS,NGF,NGF1
  64. C
  65. C
  66. C**** FACE, FACEL, FACEP must have the same order, i.e.
  67. C the i-th point of FACE belongs also to the i-th element of
  68. C FACEP and to the i-th element of FACEL
  69. C
  70. CALL RLEORD(IFACL0,IFACEP,IFACE,IFACEL)
  71. IF(IERR .NE. 0)GOTO 9999
  72. C
  73. C**** test RLEORD
  74. C
  75. C MELEME= IFACEP
  76. C IPT1 = IFACEL
  77. C SEGACT MELEME
  78. C SEGACT IPT1
  79. C NBSOUS=MELEME.LISOUS(/1)
  80. C JG=MAX(1,NBSOUS)
  81. C SEGINI MLENTI
  82. C IF(NBSOUS.EQ.0)THEN
  83. C MLENTI.LECT(1)=IFACEP
  84. C ELSE
  85. C DO I1 = 1, NBSOUS, 1
  86. C MLENTI.LECT(I1)=MELEME.LISOUS(I1)
  87. C ENDDO
  88. C ENDIF
  89. C NBSOUS=JG
  90. C IELEM=0
  91. C DO I1 = 1, NBSOUS, 1
  92. C IPT2=MLENTI.LECT(I1)
  93. C SEGACT IPT2
  94. C NBN=IPT2.NUM(/1)
  95. C NBE=IPT2.NUM(/2)
  96. C DO I2 = 1, NBE, 1
  97. C IELEM=IELEM+1
  98. C NGF=IPT2.NUM(NBN,I2)
  99. C NGF1=IPT1.NUM(2,IELEM)
  100. C write(ioimp,*) ngf, ngf1
  101. C ENDDO
  102. C ENDDO
  103. C
  104. C**** Fin test
  105. C
  106. C
  107. C**** N.B: IFACEL has the same order of face as IFACEP. At the end
  108. C we have to destroy IFACEL
  109. C
  110. C**** The neighbors of each points 'SOMMET'
  111. C Two cases:
  112. C - If the 'sommet' point is on the border, the 'FACE'
  113. C and the 'CENTRE' points are both neighbors
  114. C - If the 'sommet' point does not belongs to the border, the
  115. C 'CENTRE' points are both neighbors
  116. C
  117. CALL RLENSO(IFACEL,IFACEP,ISOMM,MLEPOI)
  118. IF(IERR.NE.0) GOTO 9999
  119. C
  120. C RLENSO creates MLEPOI
  121. C MLEPOI : list of integers.
  122. C MLEPOI.LECT(I) is the pointer of the list of integers
  123. C MLENTI which contains the neighbors of the i-th sommet
  124. C point.
  125. C
  126. CALL RLENCO(ISOMM,ICEN,ISGLI1,ISGLI2,INORM,MLEPOI,MLECOE)
  127. IF(IERR.NE.0) GOTO 9999
  128. C
  129. C RLENCO creates MRECOE
  130. C MLECOE : list of integers.
  131. C MLECOE.LECT(I) is the pointer of the list of real
  132. C MLREEL which contains the coefficient of the i-th sommet
  133. C to compute its value as function of the values on
  134. C its neighbors.
  135. C Note that ISGLI1 is the support of the Dirichlet boundary
  136. C conditions; ISGLI2 is the support of the von Neumann boundary
  137. C conditions. Their intersection is 0 and their union is
  138. C the total boundary. This is checked in the subroutine
  139. C RLENCO
  140. C
  141. CALL RLENCF(IFACEL,IFACEP,MLEPOF,MLECOF)
  142. IF(IERR.NE.0) GOTO 9999
  143. C
  144. C RLENCF creates MLEPOF,MLECOF
  145. C
  146. C MLEPOF : list of integers.
  147. C MLEPOF.LECT(I) is the pointer of the list of the neighbors
  148. C of the I-th FACE. Neighbors are 'CENTRE' points and
  149. C 'VERTEX' points.
  150. C
  151. C MLECOF : list of integers.
  152. C MLECOF.LECT(I) is the pointer of the matrix of real
  153. C which contains the coefficient of the i-th face
  154. C to compute its gradient as function of the values on
  155. C its neighbors.
  156. C
  157. CALL RLENCT(IFACEL,ISOMM,MLEPOI,MLECOE,MLEPOF,MLECOF)
  158. IF(IERR.NE.0) GOTO 9999
  159. C
  160. C RLENCT adjusts MLEPOF,MLECOF such that
  161. C
  162. C MLEPOF : list of integers.
  163. C MLEPOF.LECT(I) is the pointer of the list of the neighbors
  164. C of the I-th FACE. Neighbors are just 'CENTRE' points and
  165. C 'boundary conditions' points.
  166. C
  167. C MLECOF : list of integers.
  168. C MLECOF.LECT(I) is the pointer of the matrix of real
  169. C which contains the coefficient of the i-th face
  170. C to compute its gradient as function of the values on
  171. C its neighbors.
  172. C
  173. C N.B.: segments MLEPOI,MLECOE are destroyed into RLENCT
  174. C
  175. C
  176. C**** Creation de MCHAML
  177. C MLECOE, MLEPOF -> MCHAML
  178. C
  179. CALL RLEXC1(MLEPOF,MLECOF,ICHELM)
  180. IF(IERR.NE.0)GOTO 9999
  181. C
  182. C**** On detrui le IFACEL et IFAC ici crée
  183. C
  184. MELEME=IFACEL
  185. SEGSUP MELEME
  186. MELEME=IFACE
  187. SEGSUP MELEME
  188. C
  189. 9999 CONTINUE
  190. RETURN
  191. END
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  

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