Télécharger norv1.eso

Retour à la liste

Numérotation des lignes :

  1. C NORV1 SOURCE PV 09/03/12 21:29:38 6325
  2.  
  3. SUBROUTINE NORV1(IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,IELTFA,
  4. & IMAIL,INORM,ISURF,ICHPO,ICHTE,ICHCL,ICHNE,ICHMI,
  5. & ICHCO,IOP,ICHGRA,MPOGRA,ICOEFF,LOGBOR,LOGCOE,LOGCCL)
  6. C
  7. C************************************************************************
  8. C
  9. C PROJET : CASTEM 2000
  10. C
  11. C NOM : NORV1
  12. C
  13. C DESCRIPTION : Appelle par NORV
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  16. C
  17. C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS
  18. C
  19. C************************************************************************
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT real*8 (a-h,o-z)
  23. -INC SMLENTI
  24. -INC SMELEME
  25. -INC SMCHPOI
  26. -INC CCOPTIO
  27. -INC SMCOORD
  28. -INC SMLREEL
  29. POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  30. & MELTFA.MELEME
  31. POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  32. & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  33. & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL,
  34. & MPOVCO.MPOVAL
  35. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  36. & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,
  37. & MLEFA2.MLENTI,MLENCO.MLENTI
  38. -INC SMCHAML
  39. INTEGER NBNN,NBREF,NBMAX
  40.  
  41.  
  42.  
  43. C
  44. C**** Variables de COOPTIO
  45. C
  46. C
  47. C**** Variables de COOPTIO
  48. C
  49. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  50. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  51. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  52. C & ,IECHO, IIMPI, IOSPI
  53. C & ,IDIM
  54. C & ,MCOORD
  55. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  56. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  57. C & ,NORINC,NORVAL,NORIND,NORVAD
  58. C & ,NUCROU, IPSAUV
  59.  
  60. C**** Variable de SMLENTI, SMCHPOI
  61. C
  62. INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  63. C
  64. C**** Les includes
  65. C
  66. INTEGER I1,ICOMP,ICOMGR,IGEOM
  67. & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  68. & ,ISURF,IMAIL,ICHPO,ICHCL,ICHNE,ICHGRA,ICOEFF
  69. & ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  70. & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  71. & ,NLS1,NLS2,NLFCL
  72. & ,ISOUS,IELEM,INOEUD,ICELL
  73. INTEGER ICEN2
  74. REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  75. & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  76. & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  77. & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  78. & TRD1,TRD2,TRG,TRD
  79. REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  80. & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,COEF1X,COEF2X,
  81. & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  82. & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22
  83. & QIMPX,QIMPY,QIMPZ
  84.  
  85. REAL*8 VECXG1(2),VECYG1(2)
  86. REAL*8 VECXG2(2),VECYG2(2)
  87. REAL*8 VECXD1(2),VECYD1(2)
  88. REAL*8 VECXD2(2),VECYD2(2)
  89. REAL*8 EPS
  90. INTEGER ICRIT
  91. CHARACTER*(4) NOMCOM(18),NOMCOM3(9)
  92. CHARACTER*8 TYPE
  93. INTEGER LOGBOR,LOGCOE,LOGCCL
  94. C
  95. DATA NOMCOM /'P1DX','P1DY',
  96. & 'P2DX','P2DY',
  97. & 'P3DX','P3DY',
  98. & 'P4DX','P4DY',
  99. & 'P5DX','P5DY',
  100. & 'P6DX','P6DY',
  101. & 'P7DX','P7DY',
  102. & 'P8DX','P8DY',
  103. & 'P9DX','P9DY'/
  104.  
  105. DATA NOMCOM3 /'P1DX','P1DY','P1DZ',
  106. & 'P2DX','P2DY','P2DZ',
  107. & 'P3DX','P3DY','P3DZ'/
  108.  
  109. INTEGER NDIM
  110. SEGMENT MMAT1
  111. REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  112. INTEGER IC(NDIM)
  113. ENDSEGMENT
  114.  
  115. INTEGER K1,K2
  116. SEGMENT INDICE
  117. INTEGER NUME(K1,K2)
  118. ENDSEGMENT
  119. POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  120.  
  121. SEGMENT MATRICE
  122. REAL*8 MAT(K1,K2)
  123. ENDSEGMENT
  124. POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  125.  
  126.  
  127. SEGMENT POINT2
  128. INTEGER POINT(K3)
  129. ENDSEGMENT
  130. POINTEUR IPO2.POINT2
  131.  
  132. SEGMENT MATRICE2
  133. REAL*8 MAT2(K1,K2)
  134. ENDSEGMENT
  135.  
  136. SEGMENT POINT3
  137. INTEGER POINT33(K3)
  138. ENDSEGMENT
  139. POINTEUR IPO3.POINT3
  140.  
  141. SEGMENT INDICE3
  142. INTEGER NU(K1,K2)
  143. ENDSEGMENT
  144. POINTEUR INDIC.INDICE3
  145.  
  146. SEGMENT REP
  147. INTEGER ID(K3)
  148. ENDSEGMENT
  149. POINTEUR TAB.REP,INDLI.REP
  150.  
  151. INTEGER K5
  152. SEGMENT NBFAC
  153. INTEGER NBFACEL(K5)
  154. INTEGER IMELEM(K5)
  155. ENDSEGMENT
  156.  
  157. INTEGER K6
  158. SEGMENT NBCOT
  159. INTEGER NBCOTE(K6)
  160. INTEGER IMECOTE(K6)
  161. ENDSEGMENT
  162.  
  163.  
  164.  
  165. C
  166. C
  167. C**** Nombre total de points (HP IDIM .EQ. 2)
  168. C
  169. c SEGACT MCOORD *MOD
  170. IOP1 = 3
  171. NTOT = MCOORD.XCOOR(/1)/(IDIM+1)
  172.  
  173. C
  174. C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient)
  175. C
  176. CALL KRIPAD(ICEN,MLECEN)
  177. C SEGMENT INTERVENANT POUR PRENDRE EN COMPTE PLUSIEURS SOUS DOMAINES
  178. MELEME = ICEN
  179. NCEN=MELEME.NUM(/2)
  180. SEGDES MELEME
  181. K5 = NCEN
  182. SEGINI NBFAC
  183.  
  184. C
  185. C**** Le MELEME FACE (SPG du CHPOINT dont on veux calculer le gradient)
  186. C
  187. CALL KRIPAD(IFAC,MLEFA)
  188. MELEME = IFAC
  189. K6=MELEME.NUM(/2)
  190. SEGDES MELEME
  191. c SEGINI NBCOT
  192.  
  193.  
  194.  
  195. C
  196. C
  197.  
  198. C
  199. C**** Le MELEME SOMMET
  200. C
  201. CALL KRIPAD(ISOMM,MLESOM)
  202. C
  203. C**** En KRIPAD
  204. C SEGACT ISOMM
  205. C SEGINI MLESOM
  206. C
  207. MELEME = ISOMM
  208. NSOMM = MELEME.NUM(/2)
  209. SEGDES MELEME
  210. C
  211. C**** Le MPOVAL des SURFACES des FACES
  212. C
  213. CALL LICHT(ISURF,MPOSUR,TYPE,IGEOM)
  214. C
  215. C**** Le MPOVAL des NORMALES aux FACES
  216. C
  217. CALL LICHT(INORM,MPONOR,TYPE,IGEOM)
  218. C
  219. C**** Le MPOVAL du CHPOINT
  220. C
  221. CALL LICHT(ICHPO,MPOCHP,TYPE,IGEOM)
  222.  
  223. C**** Le MPOVAL du CHPOINT DU TENSEURS DE DIFFUSIONS
  224. C
  225. IF (ICHTE.GT.0) THEN
  226. CALL LICHT(ICHTE,MPOTEN,TYPE,IGEOM)
  227. ENDIF
  228. C
  229. C**** En LICHT
  230. C SEGACT*MOD MPOCHP
  231. C
  232. NCOMP = MPOCHP.VPOCHA(/2)
  233. IF (ICHTE.GT.0) THEN
  234. c CALL ECCHPO(ICHTE)
  235. ENDIF
  236.  
  237. C
  238. C**** Conditions limites (DIRICHLET)
  239. C
  240. IF (ICHCL .GT. 0) THEN
  241. TYPE=' '
  242. CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM)
  243. C
  244. C******* En LICHT
  245. C SEGACT*MOD MPOVCL
  246. C
  247. CALL KRIPAD(IGEOM,MLENCL)
  248. C
  249. C******* En KRIPAD
  250. C SEGACT IGEOM, MLENCL
  251. C
  252. MELEME = IGEOM
  253. SEGDES MELEME
  254. ELSE
  255. JG = NTOT
  256. SEGINI MLENCL
  257. DO I1 = 1 , JG, 1
  258. MLENCL.LECT(I1)=0
  259. ENDDO
  260. MPOVCL = -1
  261. ENDIF
  262.  
  263. c CONDITIONS DE FLUX
  264. IF (ICHNE .GT. 0) THEN
  265. TYPE=' '
  266. CALL LICHT(ICHNE,MPOVNE,TYPE,IGEOM)
  267. C
  268. C******* En LICHT
  269. C SEGACT*MOD MPOVNE
  270. C
  271. CALL KRIPAD(IGEOM,MLENNE)
  272. C
  273. C******* En KRIPAD
  274. C SEGACT IGEOM, MLENCL
  275. C
  276. MELEME = IGEOM
  277. SEGDES MELEME
  278. ELSE
  279. JG = NTOT
  280. SEGINI MLENNE
  281. DO I1 = 1 , JG, 1
  282. MLENNE.LECT(I1)=0
  283. ENDDO
  284. MPOVNE = -1
  285. ENDIF
  286.  
  287. c CONDITIONS MIXTES
  288. IF (ICHMI .GT. 0) THEN
  289. TYPE=' '
  290. CALL LICHT(ICHMI,MPOVMI,TYPE,IGEOM)
  291. C
  292. C******* En LICHT
  293. C SEGACT*MOD MPOVNE
  294. C
  295. CALL KRIPAD(IGEOM,MLENMI)
  296. C
  297. C******* En KRIPAD
  298. C SEGACT IGEOM, MLENCL
  299. C
  300. MELEME = IGEOM
  301. SEGDES MELEME
  302. ELSE
  303. JG = NTOT
  304. SEGINI MLENMI
  305. DO I1 = 1 , JG, 1
  306. MLENMI.LECT(I1)=0
  307. ENDDO
  308. MPOVMI = -1
  309. ENDIF
  310. C
  311. c OPTION FLUX CONVECTIFS
  312. IF (ICHCO .GT. 0) THEN
  313. TYPE=' '
  314. CALL LICHT(ICHCO,MPOVCO,TYPE,IGEOM)
  315. C
  316. C******* En LICHT
  317. C SEGACT*MOD MPOVNE
  318. C
  319. CALL KRIPAD(IGEOM,MLENCO)
  320. C
  321. C******* En KRIPAD
  322. C SEGACT IGEOM, MLENCL
  323. C
  324. MELEME = IGEOM
  325. SEGDES MELEME
  326. ELSE
  327. JG = NTOT
  328. SEGINI MLENCO
  329. DO I1 = 1 , JG, 1
  330. MLENCO.LECT(I1)=0
  331. ENDDO
  332. MPOVCO = -1
  333. ENDIF
  334. C
  335. C
  336. C**** Boucle sur le FACEL
  337. C
  338. MELEFL=IFACEL
  339. MELEFP=IFACEP
  340. MELEFA=IFAC
  341. MELTFA = IELTFA
  342. SEGACT MELEFL
  343. SEGACT MELEFP
  344. SEGACT MELEFA
  345. SEGACT MELTFA
  346. C FACEL = MAILLAGE NON PARTITIONE
  347. NFAC=MELEFL.NUM(/2)
  348.  
  349. IF (IDIM.EQ.2) THEN
  350. c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES
  351. NAT=1
  352. NSOUPO=1
  353. SEGINI MCHPOI
  354. ICHGRA=MCHPOI
  355. MCHPOI.MOCHDE=
  356. &'Gradient VF '
  357. MCHPOI.JATTRI=2
  358. MCHPOI.IFOPOI=IFOUR
  359. NC=1
  360. SEGINI MSOUPO
  361. MCHPOI.IPCHP(1)=MSOUPO
  362. SEGDES MCHPOI
  363. DO I1=1,NC,1
  364. MSOUPO.NOCOMP(I1)='FLUX'
  365. ENDDO
  366. C
  367. C******* Gradient aux faces
  368.  
  369. N=NFAC
  370. NC=1
  371. C
  372. C
  373. C**** Division par les volumes
  374. C
  375.  
  376. C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE
  377. C ON EST ICI
  378. IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN
  379.  
  380.  
  381. C PARAMETRES POUR LE GRADIENT AUX FACES
  382. SEGINI MPOGRA
  383. MSOUPO.IGEOC=IFAC
  384. MSOUPO.IPOVAL=MPOGRA
  385. SEGDES MSOUPO
  386.  
  387. c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD
  388. CALL NORV2(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  389. & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,MLENNE,
  390. & MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,
  391. & IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND,
  392. & NBFAC,NSOMM,NBMAX)
  393.  
  394. c INVERSION DE CHAQUE MATRICE LOCALE
  395. CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI,
  396. & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB)
  397.  
  398. c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES
  399. c GRADIENTS
  400.  
  401. CALL NORV4(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  402. & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,
  403. & MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP,
  404. & IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND,
  405. & IPO3,VAUX,TAB,MELEME,MPOGRA,MELVA1,MELVA2,
  406. & NBNN,NBFAC,MCHELM,MCHAML)
  407. ICOEFF = MCHELM
  408.  
  409. ELSE
  410. C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT
  411. SEGINI MPOGRA
  412. MSOUPO.IGEOC=IFAC
  413. MSOUPO.IPOVAL=MPOGRA
  414. SEGDES MSOUPO
  415.  
  416. CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,
  417. & MLEFA,MPOCHP,
  418. & MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,MPOVMI,
  419. & LOGBOR,LOGCCL,LOGCOE)
  420. ENDIF
  421. SEGDES MPOGRA
  422.  
  423.  
  424.  
  425. C CAS 3 DIMENSIONS
  426. ELSE
  427.  
  428. c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES
  429. NAT=1
  430. NSOUPO=1
  431. SEGINI MCHPOI
  432. ICHGRA=MCHPOI
  433. MCHPOI.MOCHDE=
  434. &'Gradient VF '
  435. MCHPOI.JATTRI=2
  436. MCHPOI.IFOPOI=IFOUR
  437. NC=1
  438. SEGINI MSOUPO
  439. MCHPOI.IPCHP(1)=MSOUPO
  440. SEGDES MCHPOI
  441. DO I1=1,NC,1
  442. MSOUPO.NOCOMP(I1)='FLUX'
  443. ENDDO
  444. C
  445. C******* Gradient aux faces
  446.  
  447. N=NFAC
  448. NC=1
  449. C
  450. C
  451. C**** Division par les volumes
  452. C
  453.  
  454. C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE
  455. IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN
  456.  
  457.  
  458. C PARAMETRES POUR LE GRADIENT AUX FACES
  459. SEGINI MPOGRA
  460. MSOUPO.IGEOC=IFAC
  461. MSOUPO.IPOVAL=MPOGRA
  462. SEGDES MSOUPO
  463.  
  464. c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD
  465. CALL NOR2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  466. & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  467. & MLENNE,
  468. & MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,
  469. & IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND,
  470. & NBFAC,NBCOT,NSOMM,NBMAX)
  471.  
  472. c INVERSION DE CHAQUE MATRICE LOCALE
  473. CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI,
  474. & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB)
  475.  
  476. c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES
  477. c GRADIENTS
  478. CALL NOR4D3(
  479. & MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  480. & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  481. & MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP,
  482. & IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND,
  483. & IPO3,TAB,MPOGRA,MELVA1,MELVA2,
  484. & NSOMM,NBMAX,NBFAC,NBCOT,MCHELM,MCHAML)
  485. ICOEFF = MCHELM
  486.  
  487. ELSE
  488.  
  489. C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT
  490. SEGINI MPOGRA
  491. MSOUPO.IGEOC=IFAC
  492. MSOUPO.IPOVAL=MPOGRA
  493. SEGDES MSOUPO
  494. CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,MLEFA,
  495. & MPOCHP,MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,
  496. & MPOVMI,LOGBOR,LOGCCL,LOGCOE)
  497.  
  498. ENDIF
  499. SEGDES MPOGRA
  500. ENDIF
  501.  
  502.  
  503.  
  504.  
  505. SEGSUP MLECEN
  506. SEGDES MPOSUR
  507. SEGDES MPONOR
  508. SEGDES MPOCHP
  509. IF(MPOVCL .GT. 0)THEN
  510. SEGDES MPOVCL
  511. ENDIF
  512. IF(MPOVNE .GT. 0)THEN
  513. SEGDES MPOVNE
  514. ENDIF
  515. IF(MPOVMI .GT. 0)THEN
  516. SEGDES MPOVMI
  517. ENDIF
  518. IF(MPOVCO .GT. 0)THEN
  519. SEGDES MPOVCO
  520. ENDIF
  521. SEGSUP MLENCL
  522. SEGSUP MLENNE
  523. SEGSUP MLENMI
  524. SEGSUP MLENCO
  525. SEGSUP MLESOM
  526. SEGSUP NBFAC
  527. SEGDES MELEFL
  528. SEGDES MELEFP
  529. SEGDES MELEFA
  530. SEGDES MELTFA
  531.  
  532. C
  533. 9999 CONTINUE
  534. RETURN
  535. END
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  

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