Télécharger rlexf3.eso

Retour à la liste

Numérotation des lignes :

  1. C RLEXF3 SOURCE PV 09/03/12 21:33:54 6325
  2. SUBROUTINE RLEXF3(MCHCEN,MCHLI1,MCHLI2,MCHNOR,MCHELM,MCHGRA)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : RLEXF3
  8. C
  9. C DESCRIPTION : Appelle par PENDI3
  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 Inputs:
  18. C
  19. C MCHGRA : CHAMPOINT we want to compute the gradient of which
  20. C
  21. C MCHLI1 : CHAMPOINT Dirichlet BC
  22. C
  23. C MCHLI2 : CHAMPOINT: VN BC
  24. C
  25. C MCHNOR : CHAMPOINT: interfaces normales
  26. C
  27. C MCHELM : MCHAML which contains the coeff. to coppute the gradient
  28. C
  29. C Output:
  30. C
  31. C MCHGRA : CHAMPOINT, gradient of MCHGRA
  32. C
  33. C
  34. C**** Variables de COOPTIO
  35. C
  36. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  37. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  38. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  39. C & ,IECHO, IIMPI, IOSPI
  40. C & ,IDIM
  41. C & ,MCOORD
  42. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  43. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  44. C & ,NORINC,NORVAL,NORIND,NORVAD
  45. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  46. C
  47. IMPLICIT INTEGER(I-N)
  48. -INC CCOPTIO
  49. INTEGER NBNN, NBELEM
  50. -INC SMELEME
  51. -INC SMCHAML
  52. C
  53. -INC SMCHPOI
  54. POINTEUR MCHCEN.MCHPOI, MCHLI1.MCHPOI, MCHLI2.MCHPOI
  55. & ,MCHGRA.MCHPOI, MCHNOR.MCHPOI
  56. POINTEUR MPOCEN.MPOVAL, MPOLI1.MPOVAL, MPOLI2.MPOVAL,MPOGRA.MPOVAL
  57. & ,MPONOR.MPOVAL
  58. C
  59. -INC SMLENTI
  60. POINTEUR MLECEN.MLENTI, MLELI1.MLENTI,MLELI2.MLENTI,MLEGRA.MLENTI
  61. C
  62. INTEGER IGEOM, NCOM, ISOUS, NBSOUS, IELEM, IVOI, NGV, NLF
  63. & ,NLV,NLL1,NLL2,ICOM,I2,NLNO
  64. REAL*8 VAL
  65. CHARACTER*8 NOM1
  66. C
  67. C**** We read MCHCEN, MPOCEN (its MPOVAL)
  68. C and we create MLECEN
  69. C
  70. CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM)
  71. IF(IERR.NE.0)GOTO 9999
  72. NCOM=MPOCEN.VPOCHA(/2)
  73. C En LICHT SEGACT*MOD MPOCEN
  74. CALL KRIPAD(IGEOM,MLECEN)
  75. IF(IERR.NE.0)GOTO 9999
  76. C SEGACT IGEOM
  77. C SEGINI MLECEN
  78. MELEME=IGEOM
  79. SEGDES MELEME
  80. C
  81. C**** For the boundary conditions
  82. C
  83. C MPOLI1, MLELI1,
  84. C MPOLI2, MLELI2
  85. C
  86. IF(MCHLI1.GT.0)THEN
  87. CALL LICHT(MCHLI1,MPOLI1,NOM1,IGEOM)
  88. IF(IERR.NE.0)GOTO 9999
  89. C En LICHT SEGACT*MOD MPOLI1
  90. CALL KRIPAD(IGEOM,MLELI1)
  91. IF(IERR.NE.0)GOTO 9999
  92. C SEGACT IGEOM
  93. C SEGINI MLELI1
  94. MELEME=IGEOM
  95. SEGDES MELEME
  96. ELSE
  97. MPOLI1=0
  98. CALL KRIPAD(0,MLELI1)
  99. ENDIF
  100. C
  101. IF(MCHLI2.GT.0)THEN
  102. CALL LICHT(MCHLI2,MPOLI2,NOM1,IGEOM)
  103. IF(IERR.NE.0)GOTO 9999
  104. C En LICHT SEGACT*MOD MPOLI2
  105. CALL KRIPAD(IGEOM,MLELI2)
  106. IF(IERR.NE.0)GOTO 9999
  107. C SEGACT IGEOM
  108. C SEGINI MLELI2
  109. MELEME=IGEOM
  110. SEGDES MELEME
  111. ELSE
  112. MPOLI2=0
  113. CALL KRIPAD(0,MLELI2)
  114. ENDIF
  115. C
  116. C**** The gradient
  117. C
  118. C MPOGRA, MLEGRA
  119. C
  120. CALL LICHT(MCHGRA,MPOGRA,NOM1,IGEOM)
  121. IF(IERR.NE.0)GOTO 9999
  122. C En LICHT SEGACT*MOD MPOGRA
  123. CALL KRIPAD(IGEOM,MLEGRA)
  124. IF(IERR.NE.0)GOTO 9999
  125. C En KRIPAD
  126. C SEGACT IGEOM
  127. C SEGINI MLEGRA
  128. C
  129. MELEME=IGEOM
  130. SEGDES MELEME
  131. C
  132. C**** The normals
  133. C
  134. C MPONOR (same order as MPOGRA)
  135. C
  136. CALL LICHT(MCHNOR,MPONOR,NOM1,IGEOM)
  137. IF(IERR.NE.0)GOTO 9999
  138. C En LICHT SEGACT*MOD MPONOR
  139. C
  140. C**** Computation
  141. C
  142. SEGACT MCHELM
  143. NBSOUS=MCHELM.IMACHE(/1)
  144. C
  145. DO ISOUS=1,NBSOUS,1
  146. MELEME=MCHELM.IMACHE(ISOUS)
  147. MCHAM1=MCHELM.ICHAML(ISOUS)
  148. SEGACT MELEME
  149. SEGACT MCHAM1
  150. MELVA1=MCHAM1.IELVAL(1)
  151. MELVA2=MCHAM1.IELVAL(2)
  152. SEGACT MELVA1
  153. SEGACT MELVA2
  154. NOM1=MCHAM1.NOMCHE(1)
  155. IF(NOM1 .NE. 'alphax ')THEN
  156. WRITE(IOIMP,*) NOM1, '!=', 'alphax '
  157. C 21 2
  158. C Données incompatibles
  159. CALL ERREUR(21)
  160. GOTO 9999
  161. ENDIF
  162. NOM1=MCHAM1.NOMCHE(2)
  163. IF(NOM1 .NE. 'alphay ')THEN
  164. WRITE(IOIMP,*) NOM1, '!=', 'alphay '
  165. C 21 2
  166. C Données incompatibles
  167. CALL ERREUR(21)
  168. GOTO 9999
  169. ENDIF
  170. IF(IDIM.EQ.3)THEN
  171. MELVA3=MCHAM1.IELVAL(3)
  172. SEGACT MELVA3
  173. NOM1=MCHAM1.NOMCHE(3)
  174. IF(NOM1 .NE. 'alphaz ')THEN
  175. WRITE(IOIMP,*) NOM1, '!=', 'alphaz '
  176. C 21 2
  177. C Données incompatibles
  178. CALL ERREUR(21)
  179. GOTO 9999
  180. ENDIF
  181. ENDIF
  182. C
  183. NBNN=MELEME.NUM(/1)
  184. NBELEM=MELEME.NUM(/2)
  185. C
  186. DO IELEM=1,NBELEM,1
  187. DO IVOI=1,NBNN,1
  188. NGV=MELEME.NUM(IVOI,IELEM)
  189. IF(IVOI .EQ. 1)THEN
  190. NLF=MLEGRA.LECT(NGV)
  191. C write(*,*) 'NGF=',ngv
  192. IF(NLF.EQ.0)THEN
  193. WRITE (IOIMP,*) 'MCHAML of coefficients???'
  194. C 21 2
  195. C Données incompatibles
  196. CALL ERREUR(21)
  197. GOTO 9999
  198. ENDIF
  199. NLV=0
  200. NLL1=MLELI1.LECT(NGV)
  201. NLL2=MLELI2.LECT(NGV)
  202. ELSE
  203. NLV=MLECEN.LECT(NGV)
  204. NLL1=MLELI1.LECT(NGV)
  205. NLL2=MLELI2.LECT(NGV)
  206. ENDIF
  207. C write(*,*) 'NGV=',ngv
  208. IF((NLL1*NLL2) .NE. 0)THEN
  209. WRITE(IOIMP,*) 'Boundary conditions.'
  210. C 21 2
  211. C Données incompatibles
  212. CALL ERREUR(21)
  213. GOTO 9999
  214. ENDIF
  215. C
  216. DO ICOM = 1, NCOM, 1
  217. IF(NLV.NE.0)THEN
  218. VAL=MPOCEN.VPOCHA(NLV,ICOM)
  219. ELSEIF(NLL1.NE.0)THEN
  220. VAL=MPOLI1.VPOCHA(NLL1,ICOM)
  221. ELSEIF(NLL2.NE.0)THEN
  222. NLNO=MLEGRA.LECT(NGV)
  223. I2=(ICOM-1)*IDIM+1
  224. VAL=(MPOLI2.VPOCHA(NLL2,I2)*MPONOR.VPOCHA(NLNO,1))+
  225. & (MPOLI2.VPOCHA(NLL2,I2+1)*MPONOR.VPOCHA(NLNO,2))
  226. IF(IDIM .EQ. 3) VAL=VAL+
  227. & (MPOLI2.VPOCHA(NLL2,I2+2)*MPONOR.VPOCHA(NLNO,3))
  228. ELSEIF(IVOI .EQ. 1)THEN
  229. VAL=0.0D0
  230. C They can be all equal to 0 just at the first
  231. C iteration (internal FACE point not belonging to BC)
  232. C We chack that the MELVAL are 0
  233. C
  234. IF((MELVA1.VELCHE(IVOI,IELEM) .NE. 0) .OR.
  235. & (MELVA2.VELCHE(IVOI,IELEM) .NE. 0))THEN
  236. WRITE(IOIMP,*) 'Boundary conditions'
  237. C 21 2
  238. C Données incompatibles
  239. CALL ERREUR(21)
  240. GOTO 9999
  241. ELSEIF(IDIM .EQ.3)THEN
  242. IF(MELVA3.VELCHE(IVOI,IELEM) .NE. 0)THEN
  243. WRITE(IOIMP,*) 'Boundary conditions'
  244. C 21 2
  245. C Données incompatibles
  246. CALL ERREUR(21)
  247. GOTO 9999
  248. ENDIF
  249. ENDIF
  250. ELSE
  251. WRITE(IOIMP,*) 'Boundary conditions'
  252. C 21 2
  253. C Données incompatibles
  254. CALL ERREUR(21)
  255. GOTO 9999
  256. ENDIF
  257. C write(*,*) 'VAL =',VAL
  258. I2=(ICOM-1)*IDIM+1
  259. MPOGRA.VPOCHA(NLF,I2)=MPOGRA.VPOCHA(NLF,I2)+
  260. & (MELVA1.VELCHE(IVOI,IELEM)*VAL)
  261. MPOGRA.VPOCHA(NLF,I2+1)=MPOGRA.VPOCHA(NLF,I2+1)+
  262. & (MELVA2.VELCHE(IVOI,IELEM)*VAL)
  263. IF(IDIM.EQ.3)
  264. & MPOGRA.VPOCHA(NLF,I2+2)=MPOGRA.VPOCHA(NLF,I2+2)+
  265. & (MELVA3.VELCHE(IVOI,IELEM)*VAL)
  266. ENDDO
  267. ENDDO
  268. ENDDO
  269. SEGDES MELEME
  270. SEGDES MCHAM1
  271. SEGDES MELVA1
  272. SEGDES MELVA2
  273. IF(IDIM.EQ.3) SEGDES MELVA3
  274. ENDDO
  275. C
  276. SEGDES MCHELM
  277. IF(MPOLI1 .NE. 0) SEGDES MPOLI1
  278. SEGSUP MLELI1
  279. IF(MPOLI2 .NE. 0) SEGDES MPOLI2
  280. SEGSUP MLELI2
  281. SEGDES MPOGRA
  282. SEGDES MPOCEN
  283. SEGSUP MLECEN
  284. SEGSUP MLEGRA
  285. SEGDES MPONOR
  286. C
  287. 9999 RETURN
  288. END
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  

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