Télécharger pente1.eso

Retour à la liste

Numérotation des lignes :

  1. C PENTE1 SOURCE PV 20/03/30 21:22:02 10567
  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.  
  92. -INC PPARAM
  93. -INC CCOPTIO
  94. -INC SMCOORD
  95. -INC SMCHPOI
  96. -INC SMCHAML
  97. -INC SMELEME
  98. -INC SMLENTI
  99. C
  100. POINTEUR MPOMAX.MPOVAL, MPOMIN.MPOVAL, MPOALP.MPOVAL,
  101. & MPOVCL.MPOVAL, MPOCHP.MPOVAL, MPOGRA.MPOVAL
  102. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLEFAC.MLENTI
  103. POINTEUR MELEFL.MELEME
  104. C
  105. INTEGER ICEN, IFACEL, IOP2, IOP3, IMCHAM, ICHPO, ICHCL, ICHGRA
  106. & ,IMCALP, NCEN, NTOT,INORM, IFAC ,NCOMP, NC
  107. & ,N, I1, I2, NFAC, IGEOM, JG
  108. C
  109. LOGICAL LOGVEC
  110. CHARACTER*(4) NOMCOM(27),NOMMCH(9)
  111. CHARACTER*8 TYPE
  112. C
  113. DATA NOMCOM /'P1DX','P1DY','P1DZ',
  114. & 'P2DX','P2DY','P2DZ',
  115. & 'P3DX','P3DY','P3DZ',
  116. & 'P4DX','P4DY','P4DZ',
  117. & 'P5DX','P5DY','P5DZ',
  118. & 'P6DX','P6DY','P6DZ',
  119. & 'P7DX','P7DY','P7DZ',
  120. & 'P8DX','P8DY','P8DZ',
  121. & 'P9DX','P9DY','P9DZ'/
  122. DATA NOMMCH /'P1 ',
  123. & 'P2 ',
  124. & 'P3 ',
  125. & 'P4 ',
  126. & 'P5 ',
  127. & 'P6 ',
  128. & 'P7 ',
  129. & 'P8 ',
  130. & 'P9 '/
  131. C
  132. C**************************************
  133. C**** PARTIE DU CALCUL DU GRADIENT ****
  134. C**************************************
  135. C
  136. C
  137. C**** Nombre total de points
  138. C
  139. NTOT = nbpts
  140. C
  141. C**** Conditions limites
  142. C
  143. IF (ICHCL .GT. 0) THEN
  144. TYPE=' '
  145. CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM)
  146. C
  147. C******* En LICHT
  148. C SEGACT*MOD MPOVCL
  149. C
  150. CALL KRIPAD(IGEOM,MLENCL)
  151. C
  152. C******* En KRIPAD
  153. C SEGACT IGEOM, MLENCL
  154. C
  155. MELEME = IGEOM
  156. ELSE
  157. JG = NTOT
  158. SEGINI MLENCL
  159. DO I1 = 1 , JG
  160. MLENCL.LECT(I1)=0
  161. ENDDO
  162. MPOVCL = -1
  163. ENDIF
  164. C
  165. C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient)
  166. C
  167. CALL KRIPAD(ICEN,MLECEN)
  168. C
  169. C**** En KRIPAD
  170. C SEGACT ICEN
  171. C SEGINI MLECEN
  172. C
  173. MELEME = ICEN
  174. NCEN = MELEME.NUM(/2)
  175. C
  176. C**** Le MLENTI avec la numerotation global/local des points FACE
  177. C
  178. CALL KRIPAD(IFAC,MLEFAC)
  179. C
  180. C**** En KRIPAD
  181. C SEGACT IFAC
  182. C SEGINI MLEFAC
  183. C
  184. MELEME = IFAC
  185. C
  186. C**** Si on traite un champ vectoriel avec l'option EULEVECT
  187. C Les composantes doivent etre 2 (3): 'UX' 'UY' ('UZ)
  188. C
  189. MCHPO1 = ICHPO
  190. SEGACT MCHPO1
  191. MSOUP1 = MCHPO1.IPCHP(1)
  192. SEGACT MSOUP1
  193. IF (IOP2.EQ.2) THEN
  194. NCOMP = MSOUP1.NOCOMP(/2)
  195. IF (IDIM.EQ.2) THEN
  196. LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
  197. & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
  198. & (NCOMP .EQ.2)
  199. ELSE
  200. LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
  201. & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
  202. & (MSOUP1.NOCOMP(3).EQ.'UZ ').AND.
  203. & (NCOMP .EQ. 3)
  204. ENDIF
  205. IF (.NOT.LOGVEC) THEN
  206. C
  207. C********** Message d'erreur standard
  208. C -301 0 %m1:40
  209. C
  210. MOTERR(1:40) = 'PENT EULEVECT '
  211. WRITE(IOIMP,*) MOTERR(1:40)
  212. C
  213. C********** Message d'erreur standard
  214. C 21 2
  215. C Données incompatibles
  216. C
  217. CALL ERREUR(21)
  218. GOTO 9999
  219. ENDIF
  220. ENDIF
  221. C
  222. C**** Le MPOVAL du CHPOINT
  223. C
  224. MPOCHP = MSOUP1.IPOVAL
  225. SEGACT MPOCHP
  226. NCOMP = MPOCHP.VPOCHA(/2)
  227. C
  228. C**** Le CHPOINT ICHGRA
  229. C
  230. SEGINI, MCHPO2 = MCHPO1
  231. MCHPO2.MOCHDE = 'Gradient '
  232. ICHGRA = MCHPO2
  233. C
  234. NC = IDIM * NCOMP
  235. SEGINI MSOUP2
  236. C
  237. C Nom de ses composantes
  238. C
  239. MCHPO2.IPCHP(1) = MSOUP2
  240. C
  241. DO I1 = 1, NCOMP
  242. DO I2 = 1, IDIM
  243. MSOUP2.NOCOMP((I1-1)*IDIM+I2) = NOMCOM((I1-1)*3+I2)
  244. ENDDO
  245. ENDDO
  246. MSOUP2.IGEOC = ICEN
  247. C
  248. N = NCEN
  249. SEGINI MPOGRA
  250. MSOUP2.IPOVAL = MPOGRA
  251. C
  252. C**** Les MPOVAL MPOMAX, MPOMIN, (maximum et minimum dans le stencil),
  253. C utilises pour le calcul du limiteur mais calcules dans PENTE2.
  254. C
  255. SEGINI, MPOMAX = MPOCHP
  256. SEGINI, MPOMIN = MPOCHP
  257. C
  258. C**** Segments déjà activés
  259. C
  260. C MPOVCL
  261. C MLENCL
  262. C MLECEN
  263. C MLEFAC
  264. C MPOCHP
  265. C MPOGRA
  266. C MPOMIN
  267. C MPOMAX
  268. C
  269. CALL PENTE2(IOP2,INORM,
  270. & MLECEN,MLEFAC,MLENCL,IMCHAM,
  271. & NCOMP,MPOCHP,MPOVCL,MPOGRA,
  272. & MPOMIN,MPOMAX)
  273. C
  274. IF(IERR .NE. 0)GOTO 9999
  275. C
  276. C
  277. C****************************
  278. C**** Calcul du limiteur ****
  279. C****************************
  280. C
  281. C
  282. C**** Limiteur
  283. C
  284. C
  285. C**** Le MPOVAL du limiteur
  286. C
  287. C MPOCHP = MPOVAL du CHPOINT dont on veux calculer le gradient
  288. C
  289. SEGINI, MPOALP = MPOCHP
  290. C
  291. C**** Le MSOUPO du limiteur
  292. C
  293. SEGINI, MSOUP2 = MSOUP1
  294. DO I1 = 1, NCOMP
  295. MSOUP2.NOCOMP(I1) = NOMMCH(I1)
  296. ENDDO
  297. MSOUP2.IPOVAL = MPOALP
  298. C
  299. C*****Le MCHPOINT du limiteur
  300. C
  301. SEGINI, MCHPO2 = MCHPO1
  302. MCHPO2.MOCHDE = 'Limiteur du gradient '
  303. MCHPO2.IPCHP(1) = MSOUP2
  304. IMCALP = MCHPO2
  305. C
  306. C******* Le MELEME FACEL
  307. C
  308. MELEFL = IFACEL
  309. SEGACT MELEFL
  310. NFAC = MELEFL.NUM(/2)
  311. C
  312. C********** Initialisation du limiteur a 1.0
  313. C
  314. DO I2 = 1, NCOMP
  315. DO I1 = 1, NCEN
  316. MPOALP.VPOCHA(I1,I2) = 1.0D0
  317. ENDDO
  318. ENDDO
  319. C
  320. IF(IOP3 .EQ. 2)THEN
  321. C
  322. C******* Calcul de limiteur Barth-Jespersen
  323. C
  324. C
  325. C******* Dans les cas quadrati, on est obligé de redefinir
  326. C MPOMAX et MPOMIN
  327. C
  328. IF(IOP2 .EQ. 5)THEN
  329. DO I2 = 1, NCOMP
  330. DO I1 = 1, NCEN
  331. MPOMIN.VPOCHA(I1,I2) = MPOCHP.VPOCHA(I1,I2)
  332. ENDDO
  333. ENDDO
  334. CALL PENTE5(NFAC,NCOMP,MELEFL,MPOCHP,MLECEN,MPOVCL,MLENCL,
  335. & MPOMIN,MPOMAX)
  336. ENDIF
  337. CALL PENTE3(NFAC,MELEFL,MLECEN,NCOMP,MPOCHP,
  338. & MPOGRA,MPOMIN,MPOMAX,MPOALP)
  339. IF(IERR .NE. 0)GOTO 9999
  340. ENDIF
  341. C
  342. C**** Desactivations et destruction de segments
  343. C
  344. SEGSUP MLECEN
  345. SEGSUP MLEFAC
  346. SEGSUP MLENCL
  347. SEGSUP MPOMAX
  348. SEGSUP MPOMIN
  349. C
  350. 9999 CONTINUE
  351. END
  352.  
  353.  
  354.  
  355.  

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