Télécharger norv.eso

Retour à la liste

Numérotation des lignes :

  1. C NORV SOURCE PV 07/11/23 21:18:24 5978
  2. SUBROUTINE NORV(IDOMA)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : NORV (OPERATEUR GIBIANE)
  8. C
  9. C DESCANDRIPTION : Calcul du gradient d'un CHPOINT 2D de type CENTRE
  10. C Avec tenseur dispersif hétérogène
  11. C Référence : Discretization on unstructured grids for
  12. C inhomogenous, anisotropic media. Part 1:derivation of the
  13. C methods,
  14. C I AAVATSMARK, T. BARKVE, O BOE, AND T. MANNSETH
  15. C SIAM JCP, VOL 19, n0 5, pp 1700-1716, Septembre 1998
  16. C
  17. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  18. C
  19. C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS
  20. C
  21. C************************************************************************
  22. C
  23. C
  24. C************************************************************************
  25. C
  26. C PHRASE D'APPEL (GIBIANE) :
  27. C
  28. C
  29. C RCHPO1 RCHELEM1 = 'PENT'
  30. C MCLE1 MCLE2 TABDO CHPO1 (MCLE6 CHPO3) (MCLE4 CHPO2) ;
  31. C
  32. C ou
  33. C
  34. C RCHPO1 = 'PENT'
  35. C MCLE1 MCLE2 TABDO CHPO1 (MCLE6 CHPO3) (MCL4 CHPO2) MCLE5 RCHELEM1 ;
  36. C
  37. C
  38. C Entrées:
  39. C
  40. C TABDO : Donnée de la table domaine;
  41. C
  42. C MCLE1 : type du champ par point CHPO1. Pour le moment, seul le type
  43. C 'FACE' est autorisé;
  44. C
  45. C MCLE2 : Traitement des éléments de bord et ordre de précision du
  46. C calcul de gradient . Options sont possibles : 'NORVEGE'
  47. C
  48. C
  49. C CHPO1 : Donnée du Champ par point de type MCLE1;
  50. C
  51. C MCLE6 : Donnée ou non de CHPO3
  52. C 'DISPDIF' si donnée, vide sinon
  53. C
  54. C CHPO3 : Donnée du Champ par point du tenseur de diffusion dispersion
  55. C
  56. C MCLE4 : Donnée ou non du CHPO2
  57. C 'TIMP' si donnée, vide sinon.
  58. C
  59. C CHPO2 : Donnée du Champ par point des conditions aux limites
  60. C
  61. C MCLE5 : Donnée ou non du RCHELEM1:
  62. C 'GRADGEO' si donnée, vide sinon.
  63. C
  64. C
  65. C E/S :
  66. C
  67. C RCHELEM1: Champ par élément des coefficients géométriques pour le
  68. C calcul du gradient (et du hessien)
  69. C (entrée si MCLE4 = 'GRADGEO', sinon sortie).
  70. C
  71. C
  72. C Sorties:
  73. C
  74. C RCHPO1 : Champ par point contenant le gradient de CHPO1 (toujours
  75. C calculé) ;
  76. C
  77. C************************************************************************
  78. C
  79. C HISTORIQUE (Anomalies et modifications éventuelles)
  80. C
  81. C HISTORIQUE : Creé le 2/3/2001
  82. C HISTORIQUE : 11/02/2003 Ajout d'une option Neuman et d'une option MIXTE
  83. C : Prise en compte de plusieurs sous domaines, Optimisation
  84. C : des paramètres NBMAX,NBNN de manière à optimiser la place
  85. C : mémoire et le temps calcul
  86. C
  87. C************************************************************************
  88. C
  89. C
  90.  
  91. C
  92. C
  93. C
  94. IMPLICIT INTEGER(I-N)
  95. IMPLICIT REAL*8 (a-h,o-z)
  96. -INC CCOPTIO
  97. -INC SMCHPOI
  98. -INC SMLMOTS
  99. C
  100. C**** Variables de COOPTIO
  101. C
  102. INTEGER ICOND, IDOMA, IRET1, ICEN, IFACEL, IFACEP, ICELL, ISOMM
  103. & ,NBOPT, IOPPOS, IOPMET, IOPLIM
  104. & ,ICHPO, ICHGRA, IMCALP, ICOEFF
  105. & ,NBCOMP
  106. & ,ICHCL, ICHCLG, ICHHES, IFAC, INORM, IVOLUM, ISURF
  107. & ,NSOUPO, IMAIL, ISGLIM,IELTFA,ICHTE
  108.  
  109. C
  110. CHARACTER*(8) MOT,MTYPR
  111. CHARACTER*(7) GRAD(2)
  112. REAL*8 XKT
  113. INTEGER LOGBOR,LOGCOE,LOGCCL
  114. DATA GRAD/'GRADGEO','GRADGCL'/
  115. C
  116. C
  117. C**** Lecture du MELEME SPG des points CENTRE.
  118. C
  119. c CALL GIBTEM(XKT)
  120. c WRITE(6,*) 'PENT XKT=',XKT
  121. CALL LEKTAB(IDOMA,'CENTRE',ICEN)
  122. IF(IERR .NE. 0) GOTO 9999
  123. C
  124. C**** Lecture du MELEME SPG des points SOMMET
  125. C
  126. CALL LEKTAB(IDOMA,'SOMMET',ISOMM)
  127. IF(IERR .NE. 0) GOTO 9999
  128. C
  129. C**** Lecture du MELEME de connect. FACEL
  130. C
  131. CALL LEKTAB(IDOMA,'FACEL',IFACEL)
  132. IF(IERR .NE. 0) GOTO 9999
  133. C
  134. C**** Lecture du MELEME de connect. FACEP
  135. C
  136. CALL LEKTAB(IDOMA,'FACEP',IFACEP)
  137. IF(IERR .NE. 0) GOTO 9999
  138. C
  139. C**** Lecture du MELEME des points FACE
  140. C
  141. CALL LEKTAB(IDOMA,'FACE',IFAC)
  142. IF (IERR .NE. 0) GOTO 9999
  143.  
  144. C
  145. C**** Lecture du MELEME de connect. IELTFA
  146. C
  147. CALL LEKTAB(IDOMA,'ELTFA',IELTFA)
  148. IF (IERR .NE. 0) GOTO 9999
  149.  
  150. C
  151. C**** Lecture du MELEME MAILLAGE
  152. C
  153. CALL LEKTAB(IDOMA,'MAILLAGE',IMAIL)
  154. IF(IERR .NE. 0) GOTO 9999
  155. C
  156. C**** Lecture du CHPOINT contenant les normales aux faces
  157. C
  158. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  159. IF (IERR .NE. 0) GOTO 9999
  160. C
  161. C
  162. C**** Lecture du CHPOINT contenant les surfaces
  163. C
  164. CALL LEKTAB(IDOMA,'XXSURFAC',ISURF)
  165. IF (IERR .NE. 0) GOTO 9999
  166.  
  167.  
  168. C
  169. C**** Lecture du CHPOINT dont on veut calculer le gradient!
  170. C
  171. CALL LIROBJ('CHPOINT ',ICHPO,1,IRET1)
  172. IF(IERR .NE. 0) GOTO 9999
  173.  
  174. C**** Control du CHPOINT
  175. C
  176. MLMOTS=0
  177. CALL QUEPO1(ICHPO, ICEN, MLMOTS)
  178. IF (IERR .NE. 0) GOTO 9999
  179. C En sortie, MLMOTS contient le nom de composantes de ICHPO
  180. SEGACT MLMOTS
  181. NBCOMP = MLMOTS.MOTS(/2)
  182. SEGDES MLMOTS
  183. IF(NBCOMP .GT. 9)THEN
  184. C
  185. C******* Message d'erreur standard
  186. C -301 0 %m1:40
  187. C
  188. MOTERR(1:40) = 'NBCOMP > 9 '
  189. WRITE(IOIMP,*) MOTERR(1:40)
  190. CALL ERREUR(22)
  191. GOTO 9999
  192. ENDIF
  193.  
  194. C LECTURE DES TENSEURS DE DIFFUSIONS
  195. IRET1=0
  196. CALL LIRCHA(MOT,0,IRET1)
  197. IF(IERR .NE. 0) GOTO 9999
  198. IF(IRET1.NE.0)THEN
  199. IF(MOT .EQ. 'DISPDIF') THEN
  200. CALL LIROBJ('CHPOINT ',ICHTE,1,ICELL)
  201. MCHPOI = ICHTE
  202. SEGACT MCHPOI
  203. NSOUPO = MCHPOI.IPCHP(/1)
  204. IF(NSOUPO .EQ. 0) ICHTE=0
  205. SEGDES MCHPOI
  206. ELSE
  207. C
  208. C******* Je la remets dans la pile
  209. C
  210. CALL ECRCHA(MOT)
  211. ICHTE=0
  212. ENDIF
  213. ELSE
  214. ICHTE=0
  215. ENDIF
  216. C
  217. C**** Lecture du CHPOINT du conditions aux limites dirichlet(optionel)
  218. C
  219. IRET1=0
  220. CALL LIRCHA(MOT,0,IRET1)
  221. IF(IERR .NE. 0) GOTO 9999
  222. IF(IRET1.NE.0)THEN
  223. IF(MOT .EQ. 'TIMP') THEN
  224. CALL LIROBJ('CHPOINT ',ICHCL,1,ICELL)
  225. MCHPOI = ICHCL
  226. SEGACT MCHPOI
  227. NSOUPO = MCHPOI.IPCHP(/1)
  228. IF(NSOUPO .EQ. 0) ICHCL=0
  229. SEGDES MCHPOI
  230. ELSE
  231. C
  232. C******* Je la remets dans la pile
  233. C
  234. CALL ECRCHA(MOT)
  235. ICHCL=0
  236. ENDIF
  237. ELSE
  238. ICHCL=0
  239. ENDIF
  240. C**** Control du CHPOIT
  241. C N.B.: MLMOTS contient les composantes de ICHPO
  242. C
  243. IF(ICHCL .GT. 0)THEN
  244. ICELL = 0
  245. CALL QUEPO1(ICHCL, ICELL, MLMOTS)
  246. IF (IERR .NE. 0) GOTO 9999
  247. ENDIF
  248. C
  249. C
  250. C**** Lecture du CHPOINT du conditions aux limites Neuman (optionel)
  251. C
  252. IRET1=0
  253. CALL LIRCHA(MOT,0,IRET1)
  254. IF(IERR .NE. 0) GOTO 9999
  255. IF(IRET1.NE.0)THEN
  256. IF(MOT .EQ. 'QIMP') THEN
  257. CALL LIROBJ('CHPOINT ',ICHNE,1,ICELL)
  258. MCHPOI = ICHNE
  259. SEGACT MCHPOI
  260. NSOUPO = MCHPOI.IPCHP(/1)
  261. IF(NSOUPO .EQ. 0) ICHNE=0
  262. SEGDES MCHPOI
  263. ELSE
  264. C
  265. C******* Je la remets dans la pile
  266. C
  267. CALL ECRCHA(MOT)
  268. ICHNE=0
  269. ENDIF
  270. ELSE
  271. ICHNE=0
  272. ENDIF
  273.  
  274. C
  275. C**** Lecture du CHPOINT du conditions aux limites mixtes (optionel)
  276. C
  277. IRET1=0
  278. CALL LIRCHA(MOT,0,IRET1)
  279. IF(IERR .NE. 0) GOTO 9999
  280. IF(IRET1.NE.0)THEN
  281. IF(MOT .EQ. 'MIXT') THEN
  282. CALL LIROBJ('CHPOINT ',ICHMI,1,ICELL)
  283. MCHPOI = ICHMI
  284. SEGACT MCHPOI
  285. NSOUPO = MCHPOI.IPCHP(/1)
  286. IF(NSOUPO .EQ. 0) ICHMI=0
  287. SEGDES MCHPOI
  288. ELSE
  289. C
  290. C******* Je la remets dans la pile
  291. C
  292. CALL ECRCHA(MOT)
  293. ICHMI=0
  294. ENDIF
  295. ELSE
  296. ICHMI=0
  297. ENDIF
  298.  
  299. IRET1=0
  300. IOP = 0
  301. CALL LIRCHA(MOT,0,IRET1)
  302. IF(IERR .NE. 0) GOTO 9999
  303. IF(IRET1.NE.0)THEN
  304. IF ((MOT .EQ. 'UPWIND')
  305. & .OR.(MOT .EQ. 'CENTERED')
  306. & .OR.(MOT .EQ. 'UPWICENT')) THEN
  307. IF (MOT .EQ. 'UPWIND') THEN
  308. IOP = 1
  309. ELSEIF (MOT .EQ. 'CENTERED') THEN
  310. IOP = 2
  311. ELSEIF (MOT .EQ. 'UPWICENT') THEN
  312. IOP = 3
  313. ENDIF
  314. CALL LIROBJ('CHPOINT ',ICHCO,1,ICELL)
  315. MCHPOI = ICHCO
  316. SEGACT MCHPOI
  317. NSOUPO = MCHPOI.IPCHP(/1)
  318. IF(NSOUPO .EQ. 0) ICHCO=0
  319. SEGDES MCHPOI
  320. ELSE
  321. C
  322. C******* Je la remets dans la pile
  323. C
  324. CALL ECRCHA(MOT)
  325. ICHCO=0
  326. ENDIF
  327. ELSE
  328. ICHCO=0
  329. ENDIF
  330. C
  331. C**** Lecture du MCHAMLs qui contiennent les elements de matrice
  332. C pour le calcul du gradient et (eventuelment) de l'hessian
  333. C
  334. C Si MOT = 'GRADGEO', on a ces MCHAMLs; sinon il faut le calculer
  335. C
  336. LOGCOE = 1
  337. LOGCCL = 1
  338. LOGBOR = 1
  339. CALL LIRCHA(MOT,0,IRET1)
  340. c CALL LIRMOT(GRAD,2,ICELL,1)
  341. IF(IERR .NE. 0) GOTO 9999
  342. IF(IRET1 .EQ. 0)THEN
  343. LOGCOE = 1
  344. LOGCCL = 1
  345. LOGBOR = 1
  346. ELSEIF( (MOT .NE. 'GRADGEO') .AND.
  347. & (MOT .NE. 'GRADGCL') .AND.
  348. & (MOT .NE. 'GRADBOR')) THEN
  349. CALL ECRCHA(MOT)
  350. c IF(IERR .NE. 0) GOTO 9999
  351. LOGCOE = 1
  352. LOGCCL = 1
  353. LOGBOR = 1
  354. ELSEIF (MOT .EQ. 'GRADGEO') THEN
  355. LOGCOE = 0
  356. CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  357. c IF(IERR .NE. 0) GOTO 9999
  358. ELSEIF (MOT .EQ. 'GRADGCL') THEN
  359. LOGCCL = 0
  360. CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  361. c IF(IERR .NE. 0) GOTO 9999
  362. ELSEIF (MOT .EQ. 'GRADBOR') THEN
  363. LOGBOR = 0
  364. CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  365. ENDIF
  366.  
  367. c IF(IERR .NE. 0)GOTO 9999
  368. c IF(ICELL .EQ. 1)THEN
  369. c LOGCOE = 0
  370. c CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  371. c IF(IERR .NE. 0) GOTO 9999
  372. c ELSEIF(ICELL .EQ. 2)THEN
  373. c LOGCL = 0
  374. c CALL LIROBJ('MCHAML ',ICOEFF,1,IRET1)
  375. c IF(IERR .NE. 0) GOTO 9999
  376. c ENDIF
  377.  
  378.  
  379.  
  380.  
  381.  
  382. CALL NORV1(IOPPOS,ICEN,ISOMM,IFAC,IFACEL,IFACEP,IELTFA,IMAIL,
  383. & INORM,ISURF,ICHPO,ICHTE,ICHCL,ICHNE,ICHMI,ICHCO,
  384. & IOP,ICHGRA,MPOGRA,ICOEFF,LOGBOR,LOGCOE,LOGCCL)
  385.  
  386.  
  387. IF(IERR .NE. 0) GOTO 9999
  388. C
  389. C**** Ecriture de gradient, (hessian), (limiteur),
  390. C (MCHAMLs pour le calcul de gradient et/ou du hessian)
  391. C
  392. IF( (MOT .NE. 'GRADGEO') .AND. (MOT .NE.'GRADGCL')
  393. & .AND. (MOT .NE.'GRADBOR') ) THEN
  394. CALL ECROBJ('MCHAML',ICOEFF)
  395. IF(IERR .NE. 0) GOTO 9999
  396. ENDIF
  397. CALL ECROBJ('CHPOINT',ICHGRA)
  398. IF(IERR .NE. 0) GOTO 9999
  399. C
  400. SEGSUP MLMOTS
  401. C
  402. C**** Sortie du programme
  403. C
  404. 9999 CONTINUE
  405. C
  406. RETURN
  407. END
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  

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