Télécharger vfsym1.eso

Retour à la liste

Numérotation des lignes :

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

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