Télécharger pente1.eso

Retour à la liste

Numérotation des lignes :

  1. C PENTE1 SOURCE CB215821 19/08/20 21:20:12 10287
  2. SUBROUTINE PENTE1(ICEN,IFAC,IFACEL,INORM,IOP2,IOP3,IMCHAM,ICHPO,
  3. & ICHCL,ICHGRA,IMCALP)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : PENTE1
  10. C
  11. C DESCRIPTION : Cette subroutine est appellée par la subroutine
  12. C PENT (calcul du gradient d'un CHPOINT 2D de type
  13. C CENTRE)
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  18. C AUTEUR (Modif.) : R. MOREL, DRN/DMT/SEMT/TTMF
  19. C
  20. C************************************************************************
  21. C
  22. C
  23. C APPELES (Outils) : LICHT, KRIPAD, ERREUR
  24. C
  25. C APPELES (Calcul) : PENTE2, PENTE3
  26. C
  27. C
  28. C************************************************************************
  29. C
  30. C ENTREES : ICEN : pointeur de MELEME 'CENTRE'
  31. C
  32. C IFAC : pointeur de MELEME 'FACE'
  33. C
  34. C IFACEL : pointeur de MELEME 'FACEL'
  35. C
  36. C INORM : pointeur des CHPOINT de normales aux faces
  37. C
  38. C IOP2 : INTEGER:
  39. C 1 2
  40. C 'EULESCAL','EULEVECT'
  41. C
  42. C IOP2 = 1 -> symetrique d'un scalaire au bord
  43. C IOP2 = 2 -> symetrique d'un vecteur au bord
  44. C
  45. C IOP3 : INTEGER;
  46. C IOP3 = 1 -> no limiteur
  47. C IOP3 = 2 -> limiteur
  48. C
  49. C IMCHAM : pointeur d'un object de type MCHAML qui contient
  50. C les elements de matrice mijx, mijx
  51. C
  52. C ICHPO : CHPOINT 'CENTRE' dont on veut calcular le gradient
  53. C (NC composantes, NC < 9)
  54. C
  55. C ICHCL : CHPOINT de conditions limites (optionel)
  56. C
  57. C
  58. C SORTIES: ICHGRA : CHPOINT 'CENTRE' qui contient les gradients
  59. C (2 ou 3 * NC composantes)
  60. C Nom de le composantes:
  61. C 'P1DX', 'P1DY',('P1DZ'), 'P2DX', 'P2DY',('P2DZ')
  62. C
  63. C IMCALP : CHPOINT 'CENTRE' qui contient les limiteurs
  64. C (NC composantes)
  65. C Nom de le composantes:
  66. C 'P1', 'P2', ...
  67. C Dans le cas I0P3 = 1 -> IMCALP = 0
  68. C IOP3 = 3 -> Le composantes sont
  69. C eguals
  70. C
  71. C************************************************************************
  72. C
  73. C HISTORIQUE (Anomalies et modifications éventuelles)
  74. C
  75. C HISTORIQUE : Cree le 4-6-1998
  76. C
  77. C HISTORIQUE : Modifie pour adaptation 3D le 20-10-1998
  78. C Modifie pour reconstruction quadratique exacte
  79. C le 25-04-2000 (A. BECCANTINI)
  80. C
  81. C Modif 10.070.1: on calcule un limiteur egual à 1 dans
  82. C le cas 'NOLIMITE' (IOP3=1)
  83. C
  84. C
  85. C************************************************************************
  86. C
  87. C
  88. IMPLICIT INTEGER(I-N)
  89. IMPLICIT REAL*8(A-H,O-Z)
  90.  
  91. -INC CCOPTIO
  92. -INC SMCOORD
  93. -INC SMCHPOI
  94. -INC SMCHAML
  95. -INC SMELEME
  96. -INC SMLENTI
  97. C
  98. POINTEUR MPOMAX.MPOVAL, MPOMIN.MPOVAL, MPOALP.MPOVAL,
  99. & MPOVCL.MPOVAL, MPOCHP.MPOVAL, MPOGRA.MPOVAL
  100. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLEFAC.MLENTI
  101. POINTEUR MELEFL.MELEME
  102. C
  103. INTEGER ICEN, IFACEL, IOP2, IOP3, IMCHAM, ICHPO, ICHCL, ICHGRA
  104. & ,IMCALP, NCEN, NTOT,INORM, IFAC ,NCOMP, NC
  105. & ,N, I1, I2, NFAC, IGEOM, JG
  106. C
  107. LOGICAL LOGVEC
  108. CHARACTER*(4) NOMCOM(27),NOMMCH(9)
  109. CHARACTER*8 TYPE
  110. C
  111. DATA NOMCOM /'P1DX','P1DY','P1DZ',
  112. & 'P2DX','P2DY','P2DZ',
  113. & 'P3DX','P3DY','P3DZ',
  114. & 'P4DX','P4DY','P4DZ',
  115. & 'P5DX','P5DY','P5DZ',
  116. & 'P6DX','P6DY','P6DZ',
  117. & 'P7DX','P7DY','P7DZ',
  118. & 'P8DX','P8DY','P8DZ',
  119. & 'P9DX','P9DY','P9DZ'/
  120. DATA NOMMCH /'P1 ',
  121. & 'P2 ',
  122. & 'P3 ',
  123. & 'P4 ',
  124. & 'P5 ',
  125. & 'P6 ',
  126. & 'P7 ',
  127. & 'P8 ',
  128. & 'P9 '/
  129. C
  130. C**************************************
  131. C**** PARTIE DU CALCUL DU GRADIENT ****
  132. C**************************************
  133. C
  134. C
  135. C**** Nombre total de points
  136. C
  137. NTOT = MCOORD.XCOOR(/1)/(IDIM+1)
  138. C
  139. C**** Conditions limites
  140. C
  141. IF (ICHCL .GT. 0) THEN
  142. TYPE=' '
  143. CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM)
  144. C
  145. C******* En LICHT
  146. C SEGACT*MOD MPOVCL
  147. C
  148. CALL KRIPAD(IGEOM,MLENCL)
  149. C
  150. C******* En KRIPAD
  151. C SEGACT IGEOM, MLENCL
  152. C
  153. MELEME = IGEOM
  154. ELSE
  155. JG = NTOT
  156. SEGINI MLENCL
  157. DO I1 = 1 , JG
  158. MLENCL.LECT(I1)=0
  159. ENDDO
  160. MPOVCL = -1
  161. ENDIF
  162. C
  163. C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient)
  164. C
  165. CALL KRIPAD(ICEN,MLECEN)
  166. C
  167. C**** En KRIPAD
  168. C SEGACT ICEN
  169. C SEGINI MLECEN
  170. C
  171. MELEME = ICEN
  172. NCEN = MELEME.NUM(/2)
  173. C
  174. C**** Le MLENTI avec la numerotation global/local des points FACE
  175. C
  176. CALL KRIPAD(IFAC,MLEFAC)
  177. C
  178. C**** En KRIPAD
  179. C SEGACT IFAC
  180. C SEGINI MLEFAC
  181. C
  182. MELEME = IFAC
  183. C
  184. C**** Si on traite un champ vectoriel avec l'option EULEVECT
  185. C Les composantes doivent etre 2 (3): 'UX' 'UY' ('UZ)
  186. C
  187. MCHPO1 = ICHPO
  188. SEGACT MCHPO1
  189. MSOUP1 = MCHPO1.IPCHP(1)
  190. SEGACT MSOUP1
  191. IF (IOP2.EQ.2) THEN
  192. NCOMP = MSOUP1.NOCOMP(/2)
  193. IF (IDIM.EQ.2) THEN
  194. LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
  195. & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
  196. & (NCOMP .EQ.2)
  197. ELSE
  198. LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
  199. & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
  200. & (MSOUP1.NOCOMP(3).EQ.'UZ ').AND.
  201. & (NCOMP .EQ. 3)
  202. ENDIF
  203. IF (.NOT.LOGVEC) THEN
  204. C
  205. C********** Message d'erreur standard
  206. C -301 0 %m1:40
  207. C
  208. MOTERR(1:40) = 'PENT EULEVECT '
  209. WRITE(IOIMP,*) MOTERR(1:40)
  210. C
  211. C********** Message d'erreur standard
  212. C 21 2
  213. C Données incompatibles
  214. C
  215. CALL ERREUR(21)
  216. GOTO 9999
  217. ENDIF
  218. ENDIF
  219. C
  220. C**** Le MPOVAL du CHPOINT
  221. C
  222. MPOCHP = MSOUP1.IPOVAL
  223. SEGACT MPOCHP
  224. NCOMP = MPOCHP.VPOCHA(/2)
  225. C
  226. C**** Le CHPOINT ICHGRA
  227. C
  228. SEGINI, MCHPO2 = MCHPO1
  229. MCHPO2.MOCHDE = 'Gradient '
  230. ICHGRA = MCHPO2
  231. C
  232. NC = IDIM * NCOMP
  233. SEGINI MSOUP2
  234. C
  235. C Nom de ses composantes
  236. C
  237. MCHPO2.IPCHP(1) = MSOUP2
  238. C
  239. DO I1 = 1, NCOMP
  240. DO I2 = 1, IDIM
  241. MSOUP2.NOCOMP((I1-1)*IDIM+I2) = NOMCOM((I1-1)*3+I2)
  242. ENDDO
  243. ENDDO
  244. MSOUP2.IGEOC = ICEN
  245. C
  246. N = NCEN
  247. SEGINI MPOGRA
  248. MSOUP2.IPOVAL = MPOGRA
  249. C
  250. C**** Les MPOVAL MPOMAX, MPOMIN, (maximum et minimum dans le stencil),
  251. C utilises pour le calcul du limiteur mais calcules dans PENTE2.
  252. C
  253. SEGINI, MPOMAX = MPOCHP
  254. SEGINI, MPOMIN = MPOCHP
  255. C
  256. C**** Segments déjà activés
  257. C
  258. C MPOVCL
  259. C MLENCL
  260. C MLECEN
  261. C MLEFAC
  262. C MPOCHP
  263. C MPOGRA
  264. C MPOMIN
  265. C MPOMAX
  266. C
  267. CALL PENTE2(IOP2,INORM,
  268. & MLECEN,MLEFAC,MLENCL,IMCHAM,
  269. & NCOMP,MPOCHP,MPOVCL,MPOGRA,
  270. & MPOMIN,MPOMAX)
  271. C
  272. IF(IERR .NE. 0)GOTO 9999
  273. C
  274. C
  275. C****************************
  276. C**** Calcul du limiteur ****
  277. C****************************
  278. C
  279. C
  280. C**** Limiteur
  281. C
  282. C
  283. C**** Le MPOVAL du limiteur
  284. C
  285. C MPOCHP = MPOVAL du CHPOINT dont on veux calculer le gradient
  286. C
  287. SEGINI, MPOALP = MPOCHP
  288. C
  289. C**** Le MSOUPO du limiteur
  290. C
  291. SEGINI, MSOUP2 = MSOUP1
  292. DO I1 = 1, NCOMP
  293. MSOUP2.NOCOMP(I1) = NOMMCH(I1)
  294. ENDDO
  295. MSOUP2.IPOVAL = MPOALP
  296. C
  297. C*****Le MCHPOINT du limiteur
  298. C
  299. SEGINI, MCHPO2 = MCHPO1
  300. MCHPO2.MOCHDE = 'Limiteur du gradient '
  301. MCHPO2.IPCHP(1) = MSOUP2
  302. IMCALP = MCHPO2
  303. C
  304. C******* Le MELEME FACEL
  305. C
  306. MELEFL = IFACEL
  307. SEGACT MELEFL
  308. NFAC = MELEFL.NUM(/2)
  309. C
  310. C********** Initialisation du limiteur a 1.0
  311. C
  312. DO I2 = 1, NCOMP
  313. DO I1 = 1, NCEN
  314. MPOALP.VPOCHA(I1,I2) = 1.0D0
  315. ENDDO
  316. ENDDO
  317. C
  318. IF(IOP3 .EQ. 2)THEN
  319. C
  320. C******* Calcul de limiteur Barth-Jespersen
  321. C
  322. C
  323. C******* Dans les cas quadrati, on est obligé de redefinir
  324. C MPOMAX et MPOMIN
  325. C
  326. IF(IOP2 .EQ. 5)THEN
  327. DO I2 = 1, NCOMP
  328. DO I1 = 1, NCEN
  329. MPOMIN.VPOCHA(I1,I2) = MPOCHP.VPOCHA(I1,I2)
  330. ENDDO
  331. ENDDO
  332. CALL PENTE5(NFAC,NCOMP,MELEFL,MPOCHP,MLECEN,MPOVCL,MLENCL,
  333. & MPOMIN,MPOMAX)
  334. ENDIF
  335. CALL PENTE3(NFAC,MELEFL,MLECEN,NCOMP,MPOCHP,
  336. & MPOGRA,MPOMIN,MPOMAX,MPOALP)
  337. IF(IERR .NE. 0)GOTO 9999
  338. ENDIF
  339. C
  340. C**** Desactivations et destruction de segments
  341. C
  342. SEGSUP MLECEN
  343. SEGSUP MLEFAC
  344. SEGSUP MLENCL
  345. SEGSUP MPOMAX
  346. SEGSUP MPOMIN
  347. C
  348. 9999 CONTINUE
  349. END
  350.  
  351.  
  352.  

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