Télécharger pente1.eso

Retour à la liste

Numérotation des lignes :

  1. C PENTE1 SOURCE KK2000 14/04/10 21:15:26 8032
  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. SEGDES MELEME
  155. ELSE
  156. JG = NTOT
  157. SEGINI MLENCL
  158. DO I1 = 1 , JG
  159. MLENCL.LECT(I1)=0
  160. ENDDO
  161. MPOVCL = -1
  162. ENDIF
  163. C
  164. C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient)
  165. C
  166. CALL KRIPAD(ICEN,MLECEN)
  167. C
  168. C**** En KRIPAD
  169. C SEGACT ICEN
  170. C SEGINI MLECEN
  171. C
  172. MELEME = ICEN
  173. NCEN = MELEME.NUM(/2)
  174. SEGDES MELEME
  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. SEGDES MELEME
  186. C
  187. C**** Si on traite un champ vectoriel avec l'option EULEVECT
  188. C Les composantes doivent etre 2 (3): 'UX' 'UY' ('UZ)
  189. C
  190. MCHPO1 = ICHPO
  191. SEGACT MCHPO1
  192. MSOUP1 = MCHPO1.IPCHP(1)
  193. SEGACT MSOUP1
  194. IF (IOP2.EQ.2) THEN
  195. NCOMP = MSOUP1.NOCOMP(/2)
  196. IF (IDIM.EQ.2) THEN
  197. LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
  198. & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
  199. & (NCOMP .EQ.2)
  200. ELSE
  201. LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
  202. & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
  203. & (MSOUP1.NOCOMP(3).EQ.'UZ ').AND.
  204. & (NCOMP .EQ. 3)
  205. ENDIF
  206. IF (.NOT.LOGVEC) THEN
  207. C
  208. C********** Message d'erreur standard
  209. C -301 0 %m1:40
  210. C
  211. MOTERR(1:40) = 'PENT EULEVECT '
  212. WRITE(IOIMP,*) MOTERR(1:40)
  213. C
  214. C********** Message d'erreur standard
  215. C 21 2
  216. C Données incompatibles
  217. C
  218. CALL ERREUR(21)
  219. GOTO 9999
  220. ENDIF
  221. ENDIF
  222. C
  223. C**** Le MPOVAL du CHPOINT
  224. C
  225. MPOCHP = MSOUP1.IPOVAL
  226. SEGACT MPOCHP
  227. SEGDES MCHPO1
  228. SEGDES MSOUP1
  229. NCOMP = MPOCHP.VPOCHA(/2)
  230. C
  231. C**** Le CHPOINT ICHGRA
  232. C
  233. SEGINI, MCHPO2 = MCHPO1
  234. MCHPO2.MOCHDE = 'Gradient '
  235. ICHGRA = MCHPO2
  236. C
  237. NC = IDIM * NCOMP
  238. SEGINI MSOUP2
  239. C
  240. C Nom de ses composantes
  241. C
  242. MCHPO2.IPCHP(1) = MSOUP2
  243. SEGDES MCHPO2
  244. C
  245. DO I1 = 1, NCOMP
  246. DO I2 = 1, IDIM
  247. MSOUP2.NOCOMP((I1-1)*IDIM+I2) = NOMCOM((I1-1)*3+I2)
  248. ENDDO
  249. ENDDO
  250. MSOUP2.IGEOC = ICEN
  251. C
  252. N = NCEN
  253. SEGINI MPOGRA
  254. MSOUP2.IPOVAL = MPOGRA
  255. SEGDES MSOUP2
  256. C
  257. C**** Les MPOVAL MPOMAX, MPOMIN, (maximum et minimum dans le stencil),
  258. C utilises pour le calcul du limiteur mais calcules dans PENTE2.
  259. C
  260. SEGINI, MPOMAX = MPOCHP
  261. SEGINI, MPOMIN = MPOCHP
  262. C
  263. C**** Segments déjà activés
  264. C
  265. C MPOVCL
  266. C MLENCL
  267. C MLECEN
  268. C MLEFAC
  269. C MPOCHP
  270. C MPOGRA
  271. C MPOMIN
  272. C MPOMAX
  273. C
  274. CALL PENTE2(IOP2,INORM,
  275. & MLECEN,MLEFAC,MLENCL,IMCHAM,
  276. & NCOMP,MPOCHP,MPOVCL,MPOGRA,
  277. & MPOMIN,MPOMAX)
  278. C
  279. IF(IERR .NE. 0)GOTO 9999
  280. C
  281. C
  282. C****************************
  283. C**** Calcul du limiteur ****
  284. C****************************
  285. C
  286. C
  287. C**** Limiteur
  288. C
  289. C
  290. C**** Le MPOVAL du limiteur
  291. C
  292. C MPOCHP = MPOVAL du CHPOINT dont on veux calculer le gradient
  293. C
  294. SEGINI, MPOALP = MPOCHP
  295. C
  296. C**** Le MSOUPO du limiteur
  297. C
  298. SEGINI, MSOUP2 = MSOUP1
  299. DO I1 = 1, NCOMP
  300. MSOUP2.NOCOMP(I1) = NOMMCH(I1)
  301. ENDDO
  302. MSOUP2.IPOVAL = MPOALP
  303. SEGDES MSOUP2
  304. C
  305. C*****Le MCHPOINT du limiteur
  306. C
  307. SEGINI, MCHPO2 = MCHPO1
  308. MCHPO2.MOCHDE = 'Limiteur du gradient '
  309. MCHPO2.IPCHP(1) = MSOUP2
  310. IMCALP = MCHPO2
  311. SEGDES MCHPO2
  312. C
  313. C******* Le MELEME FACEL
  314. C
  315. MELEFL = IFACEL
  316. SEGACT MELEFL
  317. NFAC = MELEFL.NUM(/2)
  318. C
  319. C********** Initialisation du limiteur a 1.0
  320. C
  321. DO I2 = 1, NCOMP
  322. DO I1 = 1, NCEN
  323. MPOALP.VPOCHA(I1,I2) = 1.0D0
  324. ENDDO
  325. ENDDO
  326. C
  327. IF(IOP3 .EQ. 2)THEN
  328. C
  329. C******* Calcul de limiteur Barth-Jespersen
  330. C
  331. C
  332. C******* Dans les cas quadrati, on est obligé de redefinir
  333. C MPOMAX et MPOMIN
  334. C
  335. IF(IOP2 .EQ. 5)THEN
  336. DO I2 = 1, NCOMP
  337. DO I1 = 1, NCEN
  338. MPOMIN.VPOCHA(I1,I2) = MPOCHP.VPOCHA(I1,I2)
  339. ENDDO
  340. ENDDO
  341. CALL PENTE5(NFAC,NCOMP,MELEFL,MPOCHP,MLECEN,MPOVCL,MLENCL,
  342. & MPOMIN,MPOMAX)
  343. ENDIF
  344. CALL PENTE3(NFAC,MELEFL,MLECEN,NCOMP,MPOCHP,
  345. & MPOGRA,MPOMIN,MPOMAX,MPOALP)
  346. IF(IERR .NE. 0)GOTO 9999
  347. SEGDES MELEFL
  348. SEGDES MPOALP
  349. ENDIF
  350. C
  351. C**** Desactivations et destruction de segments
  352. C
  353. SEGSUP MLECEN
  354. SEGSUP MLEFAC
  355. SEGSUP MLENCL
  356. SEGDES MPOCHP
  357. SEGDES MPOGRA
  358. IF (ICHCL .GT. 0)SEGDES MPOVCL
  359. SEGSUP MPOMAX
  360. SEGSUP MPOMIN
  361. C
  362. 9999 CONTINUE
  363. RETURN
  364. END
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  

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