Télécharger rlexf3.eso

Retour à la liste

Numérotation des lignes :

rlexf3
  1. C RLEXF3 SOURCE CB215821 20/11/25 13:39:29 10792
  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.  
  49. -INC PPARAM
  50. -INC CCOPTIO
  51. INTEGER NBNN, NBELEM
  52. -INC SMELEME
  53. -INC SMCHAML
  54. C
  55. -INC SMCHPOI
  56. POINTEUR MCHCEN.MCHPOI, MCHLI1.MCHPOI, MCHLI2.MCHPOI
  57. & ,MCHGRA.MCHPOI, MCHNOR.MCHPOI
  58. POINTEUR MPOCEN.MPOVAL, MPOLI1.MPOVAL, MPOLI2.MPOVAL,MPOGRA.MPOVAL
  59. & ,MPONOR.MPOVAL
  60. C
  61. -INC SMLENTI
  62. POINTEUR MLECEN.MLENTI, MLELI1.MLENTI,MLELI2.MLENTI,MLEGRA.MLENTI
  63. C
  64. INTEGER IGEOM, NCOM, ISOUS, NBSOUS, IELEM, IVOI, NGV, NLF
  65. & ,NLV,NLL1,NLL2,ICOM,I2,NLNO
  66. REAL*8 VAL
  67. CHARACTER*(LOCOMP) NOM1
  68. C
  69. C**** We read MCHCEN, MPOCEN (its MPOVAL)
  70. C and we create MLECEN
  71. C
  72. CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM)
  73. IF(IERR.NE.0)GOTO 9999
  74. NCOM=MPOCEN.VPOCHA(/2)
  75. C En LICHT SEGACT*MOD MPOCEN
  76. CALL KRIPAD(IGEOM,MLECEN)
  77. IF(IERR.NE.0)GOTO 9999
  78. C SEGACT IGEOM
  79. C SEGINI MLECEN
  80. MELEME=IGEOM
  81. SEGDES MELEME
  82. C
  83. C**** For the boundary conditions
  84. C
  85. C MPOLI1, MLELI1,
  86. C MPOLI2, MLELI2
  87. C
  88. IF(MCHLI1.GT.0)THEN
  89. CALL LICHT(MCHLI1,MPOLI1,NOM1,IGEOM)
  90. IF(IERR.NE.0)GOTO 9999
  91. C En LICHT SEGACT*MOD MPOLI1
  92. CALL KRIPAD(IGEOM,MLELI1)
  93. IF(IERR.NE.0)GOTO 9999
  94. C SEGACT IGEOM
  95. C SEGINI MLELI1
  96. MELEME=IGEOM
  97. SEGDES MELEME
  98. ELSE
  99. MPOLI1=0
  100. CALL KRIPAD(0,MLELI1)
  101. ENDIF
  102. C
  103. IF(MCHLI2.GT.0)THEN
  104. CALL LICHT(MCHLI2,MPOLI2,NOM1,IGEOM)
  105. IF(IERR.NE.0)GOTO 9999
  106. C En LICHT SEGACT*MOD MPOLI2
  107. CALL KRIPAD(IGEOM,MLELI2)
  108. IF(IERR.NE.0)GOTO 9999
  109. C SEGACT IGEOM
  110. C SEGINI MLELI2
  111. MELEME=IGEOM
  112. SEGDES MELEME
  113. ELSE
  114. MPOLI2=0
  115. CALL KRIPAD(0,MLELI2)
  116. ENDIF
  117. C
  118. C**** The gradient
  119. C
  120. C MPOGRA, MLEGRA
  121. C
  122. CALL LICHT(MCHGRA,MPOGRA,NOM1,IGEOM)
  123. IF(IERR.NE.0)GOTO 9999
  124. C En LICHT SEGACT*MOD MPOGRA
  125. CALL KRIPAD(IGEOM,MLEGRA)
  126. IF(IERR.NE.0)GOTO 9999
  127. C En KRIPAD
  128. C SEGACT IGEOM
  129. C SEGINI MLEGRA
  130. C
  131. MELEME=IGEOM
  132. SEGDES MELEME
  133. C
  134. C**** The normals
  135. C
  136. C MPONOR (same order as MPOGRA)
  137. C
  138. CALL LICHT(MCHNOR,MPONOR,NOM1,IGEOM)
  139. IF(IERR.NE.0)GOTO 9999
  140. C En LICHT SEGACT*MOD MPONOR
  141. C
  142. C**** Computation
  143. C
  144. SEGACT MCHELM
  145. NBSOUS=MCHELM.IMACHE(/1)
  146. C
  147. DO ISOUS=1,NBSOUS,1
  148. MELEME=MCHELM.IMACHE(ISOUS)
  149. MCHAM1=MCHELM.ICHAML(ISOUS)
  150. SEGACT MELEME
  151. SEGACT MCHAM1
  152. MELVA1=MCHAM1.IELVAL(1)
  153. MELVA2=MCHAM1.IELVAL(2)
  154. SEGACT MELVA1
  155. SEGACT MELVA2
  156. NOM1=MCHAM1.NOMCHE(1)
  157. IF(NOM1 .NE. 'alphax ')THEN
  158. WRITE(IOIMP,*) NOM1, '!=', 'alphax '
  159. C 21 2
  160. C Données incompatibles
  161. CALL ERREUR(21)
  162. GOTO 9999
  163. ENDIF
  164. NOM1=MCHAM1.NOMCHE(2)
  165. IF(NOM1 .NE. 'alphay ')THEN
  166. WRITE(IOIMP,*) NOM1, '!=', 'alphay '
  167. C 21 2
  168. C Données incompatibles
  169. CALL ERREUR(21)
  170. GOTO 9999
  171. ENDIF
  172. IF(IDIM.EQ.3)THEN
  173. MELVA3=MCHAM1.IELVAL(3)
  174. SEGACT MELVA3
  175. NOM1=MCHAM1.NOMCHE(3)
  176. IF(NOM1 .NE. 'alphaz ')THEN
  177. WRITE(IOIMP,*) NOM1, '!=', 'alphaz '
  178. C 21 2
  179. C Données incompatibles
  180. CALL ERREUR(21)
  181. GOTO 9999
  182. ENDIF
  183. ENDIF
  184. C
  185. NBNN=MELEME.NUM(/1)
  186. NBELEM=MELEME.NUM(/2)
  187. C
  188. DO IELEM=1,NBELEM,1
  189. DO IVOI=1,NBNN,1
  190. NGV=MELEME.NUM(IVOI,IELEM)
  191. IF(IVOI .EQ. 1)THEN
  192. NLF=MLEGRA.LECT(NGV)
  193. C write(*,*) 'NGF=',ngv
  194. IF(NLF.EQ.0)THEN
  195. WRITE (IOIMP,*) 'MCHAML of coefficients???'
  196. C 21 2
  197. C Données incompatibles
  198. CALL ERREUR(21)
  199. GOTO 9999
  200. ENDIF
  201. NLV=0
  202. NLL1=MLELI1.LECT(NGV)
  203. NLL2=MLELI2.LECT(NGV)
  204. ELSE
  205. NLV=MLECEN.LECT(NGV)
  206. NLL1=MLELI1.LECT(NGV)
  207. NLL2=MLELI2.LECT(NGV)
  208. ENDIF
  209. C write(*,*) 'NGV=',ngv
  210. IF((NLL1*NLL2) .NE. 0)THEN
  211. WRITE(IOIMP,*) 'Boundary conditions.'
  212. C 21 2
  213. C Données incompatibles
  214. CALL ERREUR(21)
  215. GOTO 9999
  216. ENDIF
  217. C
  218. DO ICOM = 1, NCOM, 1
  219. IF(NLV.NE.0)THEN
  220. VAL=MPOCEN.VPOCHA(NLV,ICOM)
  221. ELSEIF(NLL1.NE.0)THEN
  222. VAL=MPOLI1.VPOCHA(NLL1,ICOM)
  223. ELSEIF(NLL2.NE.0)THEN
  224. NLNO=MLEGRA.LECT(NGV)
  225. I2=(ICOM-1)*IDIM+1
  226. VAL=(MPOLI2.VPOCHA(NLL2,I2)*MPONOR.VPOCHA(NLNO,1))+
  227. & (MPOLI2.VPOCHA(NLL2,I2+1)*MPONOR.VPOCHA(NLNO,2))
  228. IF(IDIM .EQ. 3) VAL=VAL+
  229. & (MPOLI2.VPOCHA(NLL2,I2+2)*MPONOR.VPOCHA(NLNO,3))
  230. ELSEIF(IVOI .EQ. 1)THEN
  231. VAL=0.0D0
  232. C They can be all equal to 0 just at the first
  233. C iteration (internal FACE point not belonging to BC)
  234. C We chack that the MELVAL are 0
  235. C
  236. IF((MELVA1.VELCHE(IVOI,IELEM) .NE. 0) .OR.
  237. & (MELVA2.VELCHE(IVOI,IELEM) .NE. 0))THEN
  238. WRITE(IOIMP,*) 'Boundary conditions'
  239. C 21 2
  240. C Données incompatibles
  241. CALL ERREUR(21)
  242. GOTO 9999
  243. ELSEIF(IDIM .EQ.3)THEN
  244. IF(MELVA3.VELCHE(IVOI,IELEM) .NE. 0)THEN
  245. WRITE(IOIMP,*) 'Boundary conditions'
  246. C 21 2
  247. C Données incompatibles
  248. CALL ERREUR(21)
  249. GOTO 9999
  250. ENDIF
  251. ENDIF
  252. ELSE
  253. WRITE(IOIMP,*) 'Boundary conditions'
  254. C 21 2
  255. C Données incompatibles
  256. CALL ERREUR(21)
  257. GOTO 9999
  258. ENDIF
  259. C write(*,*) 'VAL =',VAL
  260. I2=(ICOM-1)*IDIM+1
  261. MPOGRA.VPOCHA(NLF,I2)=MPOGRA.VPOCHA(NLF,I2)+
  262. & (MELVA1.VELCHE(IVOI,IELEM)*VAL)
  263. MPOGRA.VPOCHA(NLF,I2+1)=MPOGRA.VPOCHA(NLF,I2+1)+
  264. & (MELVA2.VELCHE(IVOI,IELEM)*VAL)
  265. IF(IDIM.EQ.3)
  266. & MPOGRA.VPOCHA(NLF,I2+2)=MPOGRA.VPOCHA(NLF,I2+2)+
  267. & (MELVA3.VELCHE(IVOI,IELEM)*VAL)
  268. ENDDO
  269. ENDDO
  270. ENDDO
  271. SEGDES MELEME
  272. SEGDES MCHAM1
  273. SEGDES MELVA1
  274. SEGDES MELVA2
  275. IF(IDIM.EQ.3) SEGDES MELVA3
  276. ENDDO
  277. C
  278. SEGDES MCHELM
  279. IF(MPOLI1 .NE. 0) SEGDES MPOLI1
  280. SEGSUP MLELI1
  281. IF(MPOLI2 .NE. 0) SEGDES MPOLI2
  282. SEGSUP MLELI2
  283. SEGDES MPOGRA
  284. SEGDES MPOCEN
  285. SEGSUP MLECEN
  286. SEGSUP MLEGRA
  287. SEGDES MPONOR
  288. C
  289. 9999 RETURN
  290. END
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  

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