Télécharger norv2.eso

Retour à la liste

Numérotation des lignes :

  1. C NORV2 SOURCE PV 09/03/12 21:29:40 6325
  2. SUBROUTINE NORV2(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  3. & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,
  4. & MLENNE,MLENMI,MPOVCL,
  5. & MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2,SCMB,INDLI,
  6. & TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NSOMM,NBMAX)
  7.  
  8.  
  9.  
  10. C
  11. C************************************************************************
  12. C
  13. C PROJET : CASTEM 2000
  14. C
  15. C NOM : NORV2
  16. C
  17. C DESCRIPTION : Appelle par NORV1
  18. C
  19. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  20. C
  21. C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS
  22. C
  23. C************************************************************************
  24. C
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT real*8 (a-h,o-z)
  27. -INC SMLENTI
  28. -INC SMELEME
  29. -INC SMCHPOI
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. -INC SMLREEL
  33. POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  34. & MELTFA.MELEME
  35. POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  36. & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  37. & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL
  38. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  39. & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI
  40. -INC SMCHAML
  41. INTEGER NBNN,NBREF
  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,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,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,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,QIMPS,XLAMBDA1,XLAMBDA2
  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)
  94. CHARACTER*8 TYPE
  95. C
  96. DATA NOMCOM /'P1DX','P1DY',
  97. & 'P2DX','P2DY',
  98. & 'P3DX','P3DY',
  99. & 'P4DX','P4DY',
  100. & 'P5DX','P5DY',
  101. & 'P6DX','P6DY',
  102. & 'P7DX','P7DY',
  103. & 'P8DX','P8DY',
  104. & 'P9DX','P9DY'/
  105.  
  106. INTEGER NDIM
  107. SEGMENT MMAT1
  108. REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  109. INTEGER IC(NDIM)
  110. ENDSEGMENT
  111.  
  112. INTEGER K1,K2
  113. SEGMENT INDICE
  114. INTEGER NUME(K1,K2)
  115. ENDSEGMENT
  116. POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  117.  
  118. SEGMENT MATRICE
  119. REAL*8 MAT(K1,K2)
  120. ENDSEGMENT
  121. POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  122.  
  123. INTEGER K3
  124. SEGMENT POINT2
  125. INTEGER POINT(K3)
  126. ENDSEGMENT
  127. POINTEUR IPO2.POINT2
  128.  
  129. SEGMENT MATRICE2
  130. REAL*8 MAT2(K1,K2)
  131. ENDSEGMENT
  132. POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  133.  
  134. SEGMENT INDICE3
  135. INTEGER IND3(K1,K2,K3)
  136. ENDSEGMENT
  137.  
  138.  
  139. SEGMENT REP
  140. INTEGER ID(K3)
  141. ENDSEGMENT
  142. POINTEUR TAB.REP,INDLI.REP
  143.  
  144. INTEGER K5
  145. SEGMENT NBFAC
  146. INTEGER NBFACEL(K5)
  147. INTEGER IMELEM(K5)
  148. ENDSEGMENT
  149.  
  150.  
  151. c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS
  152. c SOUS DOMAINE
  153.  
  154. MAUX = MELTFA
  155. NMAI1 = 0
  156. NBSO = MAX(1,MELTFA.LISOUS(/1))
  157. c WRITE(6,*) 'NBSO= ',NBSO
  158. IELTFA = MELTFA
  159. IF (NBSO.EQ.1) THEN
  160. K5 = MELTFA.NUM(/2)
  161. ELSEIF (NBSO.EQ.2) THEN
  162. IPT1 = MELTFA.LISOUS(1)
  163. SEGACT IPT1
  164. N1 = IPT1.NUM(/2)
  165. NMAI1 = N1
  166. SEGDES IPT1
  167. IPT2 = MELTFA.LISOUS(2)
  168. SEGACT IPT2
  169. N2 = IPT2.NUM(/2)
  170. NMAI2 = N2
  171. SEGDES IPT2
  172. K5 = N1 + N2
  173. ENDIF
  174.  
  175.  
  176.  
  177. IF (NBSO.EQ.1) THEN
  178. DO I = 1,K5
  179. NTYPE = MELTFA.ITYPEL
  180. IF (NTYPE .EQ. 4) THEN
  181. NBFACEL(I) = 3
  182. IMELEM(I) = MELTFA
  183. ELSE
  184. NBFACEL(I) = 4
  185. IMELEM(I) = MELTFA
  186. ENDIF
  187. c SEGDES MELTFA
  188. ENDDO
  189. ELSEIF (NBSO.EQ.2) THEN
  190. IPT1 = MELTFA.LISOUS(1)
  191. SEGACT IPT1
  192. IPT2 = MELTFA.LISOUS(2)
  193. SEGACT IPT2
  194. DO I = 1,K5
  195. N1 = IPT1.NUM(/2)
  196. IF (I.LE.N1) THEN
  197. IF (IPT1.ITYPEL .EQ. 4) THEN
  198. NBFACEL(I) = 3
  199. IMELEM(I) = IPT1
  200. ELSE
  201. NBFACEL(I) = 4
  202. IMELEM(I) = IPT1
  203. ENDIF
  204. c SEGDES IPT1
  205. ELSE
  206. IF (IPT2.ITYPEL .EQ. 4) THEN
  207. NBFACEL(I) = 3
  208. IMELEM(I) = IPT2
  209. ELSE
  210. NBFACEL(I) = 4
  211. IMELEM(I) = IPT2
  212. ENDIF
  213. c SEGDES IPT2
  214. ENDIF
  215. ENDDO
  216. ENDIF
  217.  
  218. C SEGMENT SERVANT A UN PRECALCUL DE NBMAX
  219. K3 = NSOMM
  220. SEGINI INDLI
  221. SEGINI TAB
  222. DO I = 1,K3
  223. INDLI.ID(I) = 0
  224. TAB.ID(I) = 0
  225. ENDDO
  226.  
  227. NFAC=MELEFL.NUM(/2)
  228. NBMAX = 0
  229.  
  230. C PRECALCUL DE NBMAX
  231. DO NLCF= 1, NFAC, 1
  232. c WRITE(6,*) 'NLCF= ',NLCF
  233. NGCF=MELEFL.NUM(2,NLCF)
  234. NGCF1=MELEFA.NUM(1,NLCF)
  235. NGCF2=MELEFP.NUM(3,NLCF)
  236. IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN
  237. WRITE(IOIMP,*)
  238. & 'Il ne faut pas jouer avec la table domaine!'
  239. CALL ERREUR(5)
  240. GOTO 9999
  241. ENDIF
  242. NGCG=MELEFL.NUM(1,NLCF)
  243. NGCD=MELEFL.NUM(3,NLCF)
  244. NLCG=MLECEN.LECT(NGCG)
  245. NLCD=MLECEN.LECT(NGCD)
  246.  
  247. NGS1=MELEFP.NUM(1,NLCF)
  248. NGS2=MELEFP.NUM(2,NLCF)
  249. NLS1=MLESOM.LECT(NGS1)
  250. NLS2=MLESOM.LECT(NGS2)
  251.  
  252. INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  253. NBMAX = MAX(NBMAX,INDLI.ID(NLS1))
  254.  
  255. INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  256. NBMAX = MAX(NBMAX,INDLI.ID(NLS2))
  257.  
  258. ENDDO
  259. SEGSUP INDLI
  260. SEGSUP TAB
  261.  
  262.  
  263.  
  264.  
  265. C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL
  266. c INITIALISATION DES MATRICES
  267. c NBMAX = 10
  268. c NBMAX = NBMAX + 1
  269. c WRITE(6,*) 'NBMAX= ',NBMAX
  270. K3 = NSOMM
  271. SEGINI INDLI
  272. SEGINI TAB
  273. DO I = 1,K3
  274. INDLI.ID(I) = 0
  275. TAB.ID(I) = 0
  276. ENDDO
  277.  
  278. K1 = NBMAX
  279. K2 = NSOMM
  280. SEGINI IND2
  281. SEGINI IND
  282. SEGINI IND22
  283. SEGINI VAL1
  284. SEGINI VAL2
  285. SEGINI SCMB
  286.  
  287. C INITIALISATION DU POINTEUR MATRICE2
  288. K3 = NSOMM
  289. SEGINI IPO2
  290. DO I = 1,K3
  291. K1 = NBMAX
  292. K2 = NBMAX + 1
  293. SEGINI MATR1
  294. IPO2.POINT(I) = MATR1
  295. SEGDES MATR1
  296. ENDDO
  297.  
  298. NFAC=MELEFL.NUM(/2)
  299.  
  300.  
  301. DO NLCF= 1, NFAC, 1
  302. c WRITE(6,*) 'NLCF= ',NLCF
  303. NGCF=MELEFL.NUM(2,NLCF)
  304. NGCF1=MELEFA.NUM(1,NLCF)
  305. NGCF2=MELEFP.NUM(3,NLCF)
  306. IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN
  307. WRITE(IOIMP,*)
  308. & 'Il ne faut pas jouer avec la table domaine!'
  309. CALL ERREUR(5)
  310. GOTO 9999
  311. ENDIF
  312. NGCG=MELEFL.NUM(1,NLCF)
  313. NGCD=MELEFL.NUM(3,NLCF)
  314. NLCG=MLECEN.LECT(NGCG)
  315. NLCD=MLECEN.LECT(NGCD)
  316.  
  317. NGS1=MELEFP.NUM(1,NLCF)
  318. NGS2=MELEFP.NUM(2,NLCF)
  319. NLS1=MLESOM.LECT(NGS1)
  320. NLS2=MLESOM.LECT(NGS2)
  321. SCNX=MPONOR.VPOCHA(NLCF,1)
  322. SCNY=MPONOR.VPOCHA(NLCF,2)
  323. SCN1X = SCNX
  324. SCN1Y = SCNY
  325. SURF=0.5D0*MPOSUR.VPOCHA(NLCF,1)
  326. SCNX=SCNX*SURF
  327. SCNY=SCNY*SURF
  328.  
  329.  
  330. C 3=IDIM+1
  331. ICELL=(3*(NGCG -1))+1
  332. XG=MCOORD.XCOOR(ICELL)
  333. YG=MCOORD.XCOOR(ICELL+1)
  334. ICELL=(3*(NGCD -1))+1
  335. XD=MCOORD.XCOOR(ICELL)
  336. YD=MCOORD.XCOOR(ICELL+1)
  337. ICELL=(3*(NGCF -1))+1
  338. XF=MCOORD.XCOOR(ICELL)
  339. YF=MCOORD.XCOOR(ICELL+1)
  340.  
  341. ICELL=(3*(NGS1 -1))+1
  342. XS1=MCOORD.XCOOR(ICELL)
  343. YS1=MCOORD.XCOOR(ICELL+1)
  344. ICELL=(3*(NGS2 -1))+1
  345. XS2=MCOORD.XCOOR(ICELL)
  346. YS2=MCOORD.XCOOR(ICELL+1)
  347.  
  348. XLONG = (((XS1-XS2)**2) + ((YS1-YS2)**2))
  349. XLONG = SQRT(XLONG)
  350.  
  351. AG1 = 0.0D0
  352. AD1 = 0.0D0
  353. AG2 = 0.0D0
  354. AD2 = 0.0D0
  355.  
  356. PSCAG1 = 0.0D0
  357. PSCAG2 = 0.0D0
  358. PSCAD1 = 0.0D0
  359. PSCAD2 = 0.0D0
  360.  
  361. IG1 = 1
  362. ID1 = 1
  363. IG2 = 1
  364. ID2 = 1
  365.  
  366.  
  367. MELTFA = IMELEM(NLCG)
  368. NBF = NBFACEL(NLCG)
  369.  
  370. IF (NLCG.GT.NMAI1) THEN
  371. NGAUX = NLCG - NMAI1
  372. ELSE
  373. NGAUX = NLCG
  374. ENDIF
  375. c WRITE(6,*) 'NLCG= ',NLCG
  376. c WRITE(6,*) 'NBF= ',NBFA
  377. c WRITE(6,*) 'MELTFA= ',MELTFA
  378. c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1)
  379. c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2)
  380. c WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2)
  381.  
  382. c SEGACT MELTFA
  383. DO J = 1,NBF
  384. N1 = MELTFA.NUM(J,NGAUX)
  385. NL1 = MLEFA.LECT(N1)
  386.  
  387. NSOM1 = MELEFP.NUM(1,NL1)
  388. NSOM2 = MELEFP.NUM(2,NL1)
  389.  
  390. IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN
  391.  
  392. ICELL=(3*(N1 -1))+1
  393. XF=MCOORD.XCOOR(ICELL)
  394. YF=MCOORD.XCOOR(ICELL+1)
  395. ICELL=(3*(NGS1 -1))+1
  396. XS1=MCOORD.XCOOR(ICELL)
  397. YS1=MCOORD.XCOOR(ICELL+1)
  398.  
  399.  
  400. VECXG1(IG1) = -(YF - YG)
  401. VECYG1(IG1) = (XF - XG)
  402. VX = (XG - XS1)
  403. VY = (YG - YS1)
  404. PSCA = (VX*VECXG1(IG1)) + (VY*VECYG1(IG1))
  405. IF (PSCA.LT.0.0D0) THEN
  406. VECXG1(IG1) = +(YF - YG)
  407. VECYG1(IG1) = -(XF - XG)
  408. ENDIF
  409.  
  410. c ON REPERE l'INDICE
  411. IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN
  412. INDG1 = IG1
  413. NG1 = N1
  414. ENDIF
  415.  
  416.  
  417. IG1 = IG1 + 1
  418.  
  419. c WRITE(6,*) 'NLCF= ',NLCF,'VECXG11= ',VECXG1(1)
  420. c WRITE(6,*) 'NLCF= ',NLCF,'VECYG11= ',VECYG1(1)
  421. c WRITE(6,*) 'NLCF= ',NLCF,'VECXG12= ',VECXG1(2)
  422. c WRITE(6,*) 'NLCF= ',NLCF,'VECYG12= ',VECYG1(2)
  423. c WRITE(6,*) 'NGCF= ',NGCF
  424. c WRITE(6,*) 'N1= ',N1,'XF= ',XF,'YF= ',YF
  425. c WRITE(6,*) 'N1= ',N1,'XG= ',XG,'YG= ',YG
  426. ENDIF
  427. IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN
  428.  
  429. ICELL=(3*(N1 -1))+1
  430. XF=MCOORD.XCOOR(ICELL)
  431. YF=MCOORD.XCOOR(ICELL+1)
  432. ICELL=(3*(NGS2 -1))+1
  433. XS2=MCOORD.XCOOR(ICELL)
  434. YS2=MCOORD.XCOOR(ICELL+1)
  435.  
  436. VECXG2(IG2) = -(YF - YG)
  437. VECYG2(IG2) = (XF - XG)
  438. VX = (XG - XS2)
  439. VY = (YG - YS2)
  440. PSCA = (VX*VECXG2(IG2)) + (VY*VECYG2(IG2))
  441. IF (PSCA.LT.0.0D0) THEN
  442. VECXG2(IG2) = +(YF - YG)
  443. VECYG2(IG2) = -(XF - XG)
  444. ENDIF
  445.  
  446. IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN
  447. INDG2 = IG2
  448. NG2 = N1
  449. ENDIF
  450. IG2 = IG2 + 1
  451.  
  452. ENDIF
  453. ENDDO
  454. c SEGDES MELTFA
  455.  
  456. MELTFA = IMELEM(NLCD)
  457. NBF = NBFACEL(NLCD)
  458. c WRITE(6,*) 'NLCD= ',NLCD
  459. c WRITE(6,*) 'NBF= ',NBF
  460. c WRITE(6,*) 'MELTFA= ',MELTFA
  461. c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1)
  462. c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2)
  463. IF (NLCD.GT.NMAI1) THEN
  464. NDAUX = NLCD -NMAI1
  465. ELSE
  466. NDAUX = NLCD
  467. ENDIF
  468. c SEGACT MELTFA
  469. DO J = 1,NBF
  470. N1 = MELTFA.NUM(J,NDAUX)
  471. NL1 = MLEFA.LECT(N1)
  472.  
  473. NSOM1 = MELEFP.NUM(1,NL1)
  474. NSOM2 = MELEFP.NUM(2,NL1)
  475.  
  476. IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN
  477.  
  478. ICELL=(3*(N1 -1))+1
  479. XF=MCOORD.XCOOR(ICELL)
  480. YF=MCOORD.XCOOR(ICELL+1)
  481. ICELL=(3*(NGS1 -1))+1
  482. XS1=MCOORD.XCOOR(ICELL)
  483. YS1=MCOORD.XCOOR(ICELL+1)
  484.  
  485.  
  486. VECXD1(ID1) = - (YF - YD)
  487. VECYD1(ID1) = (XF - XD)
  488. VX = (XD - XS1)
  489. VY = (YD - YS1)
  490. PSCA = (VX*VECXD1(ID1)) + (VY*VECYD1(ID1))
  491. IF (PSCA.LT.0.0D0) THEN
  492. VECXD1(ID1) = +(YF - YD)
  493. VECYD1(ID1) = -(XF - XD)
  494. ENDIF
  495.  
  496. IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN
  497. INDD1 = ID1
  498. ND1 = N1
  499. ENDIF
  500.  
  501. ID1 = ID1 + 1
  502.  
  503. ENDIF
  504. IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN
  505.  
  506. ICELL=(3*(N1 -1))+1
  507. XF=MCOORD.XCOOR(ICELL)
  508. YF=MCOORD.XCOOR(ICELL+1)
  509. ICELL=(3*(NGS2 -1))+1
  510. XS2=MCOORD.XCOOR(ICELL)
  511. YS2=MCOORD.XCOOR(ICELL+1)
  512.  
  513.  
  514. VECXD2(ID2) = - (YF - YD)
  515. VECYD2(ID2) = (XF - XD)
  516. VX = (XD - XS2)
  517. VY = (YD - YS2)
  518. PSCA = (VX*VECXD2(ID2)) + (VY*VECYD2(ID2))
  519. IF (PSCA.LT.0.0D0) THEN
  520. VECXD2(ID2) = +(YF - YD)
  521. VECYD2(ID2) = -(XF - XD)
  522. ENDIF
  523.  
  524. IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN
  525. INDD2 = ID2
  526. ND2 = N1
  527. ENDIF
  528. ID2 = ID2 + 1
  529.  
  530. ENDIF
  531. ENDDO
  532. c SEGDES MELTFA
  533. AG1=0.5D0*ABS( ( (VECXG1(1)*VECYG1(2)) -
  534. & (VECYG1(1))*VECXG1(2)) )
  535.  
  536. AG2=0.5D0*ABS( ( (VECXG2(1)*VECYG2(2)) -
  537. & (VECYG2(1))*VECXG2(2)) )
  538.  
  539. AD1=0.5D0*ABS( ( (VECXD1(1)*VECYD1(2)) -
  540. & (VECYD1(1))*VECXD1(2)) )
  541.  
  542.  
  543. AD2=0.5D0*ABS( ( (VECXD2(1)*VECYD2(2)) -
  544. & (VECYD2(1))*VECXD2(2)) )
  545.  
  546. c WRITE(6,*) 'NLCF=',NLCF
  547. c WRITE(6,*) 'NLCD=',NLCD
  548. c WRITE(6,*) 'NLCG=',NLCG
  549. c WRite(6,*) 'AG1=',AG1
  550. c WRite(6,*) 'AG2=',AG2
  551. c WRite(6,*) 'AD1=',AD1
  552. c WRite(6,*) 'AD2=',AD2
  553. c WRITE(6,*) 'NLCF= ',NLCF,'VECXG11= ',VECXG1(1)
  554. c WRITE(6,*) 'NLCF= ',NLCF,'VECYG11= ',VECYG1(1)
  555. c WRITE(6,*) 'NLCF= ',NLCF,'VECXG12= ',VECXG1(2)
  556. c WRITE(6,*) 'NLCF= ',NLCF,'VECYG12= ',VECYG1(2)
  557. c WRite(6,*) 'PSCAG1=',PSCAG1
  558. c WRite(6,*) 'PSCAG2=',PSCAG2
  559. c WRite(6,*) 'PSCAD1=',PSCAD1
  560. c WRite(6,*) 'PSCAD2=',PSCAD2
  561. c WRite(6,*) 'COEF1D=',COEF1D
  562. c WRite(6,*) 'COEF2D=',COEF2D
  563. c WRite(6,*) 'BETA1GD=',BETA1GD
  564. c WRite(6,*) 'BETA2GD=',BETA2GD
  565. c WRite(6,*) 'INDD2=',INDD2
  566.  
  567. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  568. IF (ICHTE.EQ.0) THEN
  569. COEF1 = ( (VECXG1(INDG1)*SCN1X) + (VECYG1(INDG1)*SCN1Y) )
  570. & / AG1
  571. IAUX = 3 - INDG1
  572. COEF2 = ( (VECXG1(IAUX)*SCN1X) + (VECYG1(IAUX)*SCN1Y) )
  573. & / AG1
  574.  
  575. COEF3 = ( (VECXD1(INDD1)*SCN1X) + (VECYD1(INDD1)*SCN1Y) )
  576. & / AD1
  577. IAUX = 3 - INDD1
  578. COEF4 = ( (VECXD1(IAUX)*SCN1X) + (VECYD1(IAUX)*SCN1Y) )
  579. & / AD1
  580. ELSE
  581. c WRITE(6,*) 'NLCG= ',NLCG,'NLCG2= ',NLCG2
  582. c WRITE(6,*) 'NLCD= ',NLCD,'NLCD2= ',NLCD2
  583. IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN
  584. c LE TENSEUR EST ANISOTROPE
  585. K11G = MPOTEN.VPOCHA(NLCG,1)
  586. K22G = MPOTEN.VPOCHA(NLCG,2)
  587. K21G = MPOTEN.VPOCHA(NLCG,3)
  588.  
  589. K11D = MPOTEN.VPOCHA(NLCD,1)
  590. K22D = MPOTEN.VPOCHA(NLCD,2)
  591. K21D = MPOTEN.VPOCHA(NLCD,3)
  592. ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  593. c LE TENSEUR EST DIAGONAL
  594. K11G = MPOTEN.VPOCHA(NLCG,1)
  595. K22G = K11G
  596. K21G = 0.0D0
  597. K11D = MPOTEN.VPOCHA(NLCD,1)
  598. K22D = K11D
  599. K21D = 0.0D0
  600. ELSE
  601. WRITE(6,*) 'TENSEUR NON PREVU'
  602. STOP
  603. ENDIF
  604. c xmink11 = min(K11G,xmink11)
  605. c xmink11 = min(K11D,xmink11)
  606. c xmaxk11 = max(K11G,xmaxk11)
  607. c xmaxk11 = max(K11D,xmaxk11)
  608. c xmink22 = min(K22G,xmink22)
  609. c xmink22 = min(K22D,xmink22)
  610. c xmaxk22 = max(K22G,xmaxk22)
  611. c xmaxk22 = max(K22D,xmaxk22)
  612. c WRITE(6,*) 'NLCF= ',NLCF
  613. c WRITE(6,*) 'NLCG= ',NLCG, 'NLCD= ',NLCD
  614. c WRite(6,*) 'K11G=',K11G,'K22G= ',K22G,'K21G=',K21G
  615. c WRite(6,*) 'K11D=',K11D,'K22D= ',K22D,'K21D=',K21D
  616. c ON EST ICI
  617.  
  618. c PRODUIT TENSEUR VECTEUR
  619. IAUX = 3 - INDD1
  620. XLONGD = (VECXD1(IAUX)*VECXD1(IAUX)) +
  621. & (VECYD1(IAUX)*VECYD1(IAUX))
  622. XLONGD = XLONGD**0.5
  623. IAUX = 3 - INDG1
  624. XLONGG = (VECXG1(IAUX)*VECXG1(IAUX)) +
  625. & (VECYG1(IAUX)*VECYG1(IAUX))
  626. XLONGG = XLONGG**0.5
  627. PSCAGX = (K11G*(VECXG1(INDG1)/AG1)) + (K21G*(VECYG1(INDG1)/AG1))
  628. PSCAGY = (K21G*(VECXG1(INDG1))/AG1) + (K22G*(VECYG1(INDG1)/AG1))
  629. COEF1 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  630.  
  631. IAUX = 3 - INDG1
  632. PSCAGX = (K11G*(VECXG1(IAUX)/AG1)) + (K21G*(VECYG1(IAUX)/AG1))
  633. PSCAGY = (K21G*(VECXG1(IAUX)/AG1)) + (K22G*(VECYG1(IAUX)/AG1))
  634. COEF2 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  635.  
  636. PSCADX = (K11D*(VECXD1(INDD1)/AD1)) + (K21D*(VECYD1(INDD1)/AD1))
  637. PSCADY = (K21D*(VECXD1(INDD1)/AD1)) + (K22D*(VECYD1(INDD1)/AD1))
  638. COEF3 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  639.  
  640. IAUX = 3 - INDD1
  641. PSCADX = (K11D*(VECXD1(IAUX)/AD1)) + (K21D*(VECYD1(IAUX)/AD1))
  642. PSCADY = (K21D*(VECXD1(IAUX)/AD1)) + (K22D*(VECYD1(IAUX)/AD1))
  643. COEF4 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  644.  
  645. ENDIF
  646.  
  647. c WRite(6,*) 'COEF1=',COEF1
  648. c WRite(6,*) 'COEF2=',COEF2
  649. c WRite(6,*) 'COEF3=',COEF3
  650. c WRite(6,*) 'COEF4=',COEF4
  651.  
  652. MARQ = 0
  653. DO I5 = 1,INDLI.ID(NLS1)
  654. INDAUX = IND2.NUME(I5,NLS1)
  655. IF (INDAUX.EQ.NGCF) THEN
  656. MARQ = 1
  657. IAFF = I5
  658. GOTO 4
  659. ENDIF
  660. ENDDO
  661. 4 CONTINUE
  662.  
  663.  
  664. IF (MARQ.EQ.0) THEN
  665. INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  666. ICOU = INDLI.ID(NLS1)
  667. IND2.NUME(ICOU,NLS1) = NGCF
  668. ELSE
  669. ICOU = IAFF
  670. ENDIF
  671.  
  672.  
  673. COEF = (COEF1 - COEF3)
  674. MATR1 = IPO2.POINT(NLS1)
  675. SEGACT MATR1 *MOD
  676. MATR1.MAT2(ICOU,ICOU) = COEF
  677.  
  678. MARQ = 0
  679. DO I5 = 1,INDLI.ID(NLS1)
  680. INDAUX = IND2.NUME(I5,NLS1)
  681. IF (INDAUX.EQ.NG1) THEN
  682. MARQ = 1
  683. IAFF = I5
  684. GOTO 5
  685. ENDIF
  686. ENDDO
  687. 5 CONTINUE
  688.  
  689.  
  690. IF (MARQ.EQ.0) THEN
  691. INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  692. ICOUCO = INDLI.ID(NLS1)
  693. IND2.NUME(ICOUCO,NLS1) = NG1
  694. ELSE
  695. ICOUCO = IAFF
  696. ENDIF
  697. ICOUG = ICOUCO
  698.  
  699.  
  700. MATR1.MAT2(ICOU,ICOUCO) = COEF2
  701.  
  702.  
  703. MARQ = 0
  704. DO I5 = 1,INDLI.ID(NLS1)
  705. INDAUX = IND2.NUME(I5,NLS1)
  706. IF (INDAUX.EQ.ND1) THEN
  707. MARQ = 1
  708. IAFF = I5
  709. GOTO 6
  710. ENDIF
  711. ENDDO
  712. 6 CONTINUE
  713.  
  714.  
  715. IF (MARQ.EQ.0) THEN
  716. INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  717. ICOUCO = INDLI.ID(NLS1)
  718. IND2.NUME(ICOUCO,NLS1) = ND1
  719. ELSE
  720. ICOUCO = IAFF
  721. ENDIF
  722. ICOUD = ICOUCO
  723.  
  724.  
  725.  
  726. MATR1.MAT2(ICOU,ICOUCO) = -COEF4
  727.  
  728. SCMB.MAT(ICOU,NLS1) =
  729. & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)) -
  730. & ((COEF3+COEF4)*MPOCHP.VPOCHA(NLCD,1)))
  731.  
  732.  
  733.  
  734.  
  735. * COEF POUR INVERSER LA MATRICE
  736.  
  737. * ON CORRIGE ICI
  738. VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2)
  739. VAL2.MAT(ICOU,NLS1) = - ((COEF3 + COEF4))
  740. IND.NUME(ICOU,NLS1) = NGCG
  741. IND22.NUME(ICOU,NLS1) = NGCD
  742.  
  743. * CONDITION AUX LIMITE DE DIRICICHLET
  744. IF (NGCG.EQ.NGCD) THEN
  745. NLFCL=MLENCL.LECT(NGCF)
  746. IF (NLFCL.GT.0) THEN
  747. COEF = COEF1
  748. MATR1.MAT2(ICOU,ICOU) = COEF
  749. MATR1.MAT2(ICOU,ICOUG) = 0.0D0
  750. MATR1.MAT2(ICOU,ICOUD) = 0.0D0
  751. SCMB.MAT(ICOU,NLS1) = COEF*MPOVCL.VPOCHA(NLFCL,1)
  752. VAL1.MAT(ICOU,NLS1) = COEF
  753. VAL2.MAT(ICOU,NLS1) = 0.0D0
  754. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  755. IND.NUME(ICOU,NLS1) = NGCF
  756. IND22.NUME(ICOU,NLS1) = NGCD
  757. ELSE
  758. NLFNE=MLENNE.LECT(NGCF)
  759.  
  760. c CONDITION DE FLUX
  761. IF (NLFNE.GT.0) THEN
  762. QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  763. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  764. QIMPS = (QIMPX)
  765.  
  766. COEF = COEF1
  767. MATR1.MAT2(ICOU,ICOU) = COEF
  768. MATR1.MAT2(ICOU,ICOUG) = COEF2
  769.  
  770. SCMB.MAT(ICOU,NLS1) = (
  771. & ((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) + (2.D0*QIMPS)
  772. VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2)
  773. VAL2.MAT(ICOU,NLS1) = 2.D0
  774. IND.NUME(ICOU,NLS1) = NGCG
  775. IND22.NUME(ICOU,NLS1) = NGCF
  776.  
  777. ELSE
  778. c CONDITION MIXTE
  779. NLFMI=MLENMI.LECT(NGCF)
  780. IF (NLFMI.GT.0) THEN
  781. XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  782. XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  783. QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  784. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  785. QIMPS = (QIMPX)
  786.  
  787. c WRITE(6,*) 'NLCF= ',NLCF
  788. c WRITE(6,*) 'NGCF= ',NGCF
  789. c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  790. c WRITE(6,*) 'QIMPX= ',QIMPX,'QIMPY= ',QIMPY
  791. COEF = COEF1
  792. MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) -
  793. & (2.D0*XLAMBDA2)
  794. MATR1.MAT2(ICOU,ICOUG) = (XLAMBDA1*COEF2)
  795. SCMB.MAT(ICOU,NLS1) =
  796. & (XLAMBDA1*((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  797. & + (2.D0*QIMPS)
  798. VAL1.MAT(ICOU,NLS1) = XLAMBDA1*(COEF1 + COEF2)
  799. VAL2.MAT(ICOU,NLS1) = 2.D0
  800. IND.NUME(ICOU,NLS1) = NGCG
  801. IND22.NUME(ICOU,NLS1) = NGCF
  802. ELSE
  803. C PAR DEFAUT FLUX NUL
  804. QIMPS = 0
  805. COEF = COEF1
  806. MATR1.MAT2(ICOU,ICOU) = COEF
  807. MATR1.MAT2(ICOU,ICOUG) = COEF2
  808. SCMB.MAT(ICOU,NLS1) =
  809. & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  810. VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2)
  811. VAL2.MAT(ICOU,NLS1) = 0.D0
  812. IND.NUME(ICOU,NLS1) = NGCG
  813. IND22.NUME(ICOU,NLS1) = NGCD
  814. ENDIF
  815.  
  816. ENDIF
  817.  
  818. ENDIF
  819. ENDIF
  820.  
  821. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  822. c & 'IND= ',IND.NUME(ICOU,NLS1),
  823. c & 'IND22= ',IND22.NUME(ICOU,NLS1),
  824. c & 'SCMB', SCMB.MAT(ICOU,NLS1),
  825. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  826. c & 'ICOUG= ',ICOUG,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG,NLS1),
  827. c & 'ICOUD= ',ICOUD,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD,NLS1)
  828. c WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',
  829. c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  830. c & 'HD= ',MPOCHP.VPOCHA(NLCD,1)
  831.  
  832. SEGDES MATR1 *MOD
  833.  
  834. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS2
  835.  
  836. IF (ICHTE.EQ.0) THEN
  837. COEF1 = ( (VECXG2(INDG2)*SCN1X) + (VECYG2(INDG2)*SCN1Y) )
  838. & / AG2
  839. IAUX = 3 - INDG2
  840. COEF2 = ( (VECXG2(IAUX)*SCN1X) + (VECYG2(IAUX)*SCN1Y) )
  841. & / AG2
  842.  
  843. COEF3 = ( (VECXD2(INDD2)*SCN1X) + (VECYD2(INDD2)*SCN1Y) )
  844. & / AD2
  845. IAUX = 3 - INDD2
  846. COEF4 = ( (VECXD2(IAUX)*SCN1X) + (VECYD2(IAUX)*SCN1Y) )
  847. & / AD2
  848. ELSE
  849.  
  850. IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN
  851. c LE TENSEUR EST ANISOTROPE
  852. K11G = MPOTEN.VPOCHA(NLCG,1)
  853. K22G = MPOTEN.VPOCHA(NLCG,2)
  854. K21G = MPOTEN.VPOCHA(NLCG,3)
  855.  
  856. K11D = MPOTEN.VPOCHA(NLCD,1)
  857. K22D = MPOTEN.VPOCHA(NLCD,2)
  858. K21D = MPOTEN.VPOCHA(NLCD,3)
  859. ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  860. c LE TENSEUR EST DIAGONAL
  861. K11G = MPOTEN.VPOCHA(NLCG,1)
  862. K22G = K11G
  863. K21G = 0.0D0
  864. K11D = MPOTEN.VPOCHA(NLCD,1)
  865. K22D = K11D
  866. K21D = 0.0D0
  867. ELSE
  868. WRITE(6,*) 'TENSEUR NON PREVU'
  869. STOP
  870. ENDIF
  871.  
  872. c PRODUIT TENSEUR VECTEUR
  873. IAUX = 3 - INDD1
  874. XLONGD = (VECXD1(IAUX)*VECXD1(IAUX)) +
  875. & (VECYD1(IAUX)*VECYD1(IAUX))
  876. XLONGD = XLONGD**0.5
  877. IAUX = 3 - INDG1
  878. XLONGG = (VECXG1(IAUX)*VECXG1(IAUX)) +
  879. & (VECYG1(IAUX)*VECYG1(IAUX))
  880. XLONGG = XLONGG**0.5
  881.  
  882. PSCAGX = (K11G*(VECXG2(INDG2)/AG2)) + (K21G*(VECYG2(INDG2)/AG2))
  883. PSCAGY = (K21G*(VECXG2(INDG2))/AG2) + (K22G*(VECYG2(INDG2)/AG2))
  884. COEF1 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  885.  
  886. IAUX = 3 - INDG2
  887. PSCAGX = (K11G*(VECXG2(IAUX)/AG2)) + (K21G*(VECYG2(IAUX)/AG2))
  888. PSCAGY = (K21G*(VECXG2(IAUX)/AG2)) + (K22G*(VECYG2(IAUX)/AG2))
  889. COEF2 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  890.  
  891. PSCADX = (K11D*(VECXD2(INDD2)/AD2)) + (K21D*(VECYD2(INDD2)/AD2))
  892. PSCADY = (K21D*(VECXD2(INDD2)/AD2)) + (K22D*(VECYD2(INDD2)/AD2))
  893. COEF3 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  894.  
  895. IAUX = 3 - INDD2
  896. PSCADX = (K11D*(VECXD2(IAUX)/AD2)) + (K21D*(VECYD2(IAUX)/AD2))
  897. PSCADY = (K21D*(VECXD2(IAUX)/AD2)) + (K22D*(VECYD2(IAUX)/AD2))
  898. COEF4 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  899. ENDIF
  900.  
  901. MARQ = 0
  902. DO I5 = 1,INDLI.ID(NLS2)
  903. INDAUX = IND2.NUME(I5,NLS2)
  904. IF (INDAUX.EQ.NGCF) THEN
  905. MARQ = 1
  906. IAFF = I5
  907. GOTO 41
  908. ENDIF
  909. ENDDO
  910. 41 CONTINUE
  911.  
  912.  
  913. IF (MARQ.EQ.0) THEN
  914. INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  915. ICOU = INDLI.ID(NLS2)
  916. IND2.NUME(ICOU,NLS2) = NGCF
  917. ELSE
  918. ICOU = IAFF
  919. ENDIF
  920.  
  921. COEF = (COEF1 - COEF3)
  922.  
  923. MATR1 = IPO2.POINT(NLS2)
  924. SEGACT MATR1 *MOD
  925. MATR1.MAT2(ICOU,ICOU) = COEF
  926.  
  927. MARQ = 0
  928. DO I5 = 1,INDLI.ID(NLS2)
  929. INDAUX = IND2.NUME(I5,NLS2)
  930. IF (INDAUX.EQ.NG2) THEN
  931. MARQ = 1
  932. IAFF = I5
  933. GOTO 51
  934. ENDIF
  935. ENDDO
  936. 51 CONTINUE
  937.  
  938.  
  939. IF (MARQ.EQ.0) THEN
  940. INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  941. ICOUCO = INDLI.ID(NLS2)
  942. IND2.NUME(ICOUCO,NLS2) = NG2
  943. ELSE
  944. ICOUCO = IAFF
  945. ENDIF
  946. ICOUG = ICOUCO
  947.  
  948.  
  949. MATR1.MAT2(ICOU,ICOUCO) = COEF2
  950.  
  951.  
  952. MARQ = 0
  953. DO I5 = 1,INDLI.ID(NLS2)
  954. INDAUX = IND2.NUME(I5,NLS2)
  955. IF (INDAUX.EQ.ND2) THEN
  956. MARQ = 1
  957. IAFF = I5
  958. GOTO 61
  959. ENDIF
  960. ENDDO
  961. 61 CONTINUE
  962.  
  963.  
  964. IF (MARQ.EQ.0) THEN
  965. INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  966. ICOUCO = INDLI.ID(NLS2)
  967. IND2.NUME(ICOUCO,NLS2) = ND2
  968. ELSE
  969. ICOUCO = IAFF
  970. ENDIF
  971. ICOUD = ICOUCO
  972.  
  973.  
  974.  
  975. MATR1.MAT2(ICOU,ICOUCO) = -COEF4
  976.  
  977. SCMB.MAT(ICOU,NLS2) =(
  978. & ((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)) -
  979. & ((COEF3+COEF4)*MPOCHP.VPOCHA(NLCD,1)))
  980.  
  981. VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2)
  982. VAL2.MAT(ICOU,NLS2) = - ((COEF3 + COEF4))
  983. IND.NUME(ICOU,NLS2) = NGCG
  984. IND22.NUME(ICOU,NLS2) = NGCD
  985.  
  986. * CONDITION AUX LIMITE DE DIRICICHLET
  987. IF (NGCG.EQ.NGCD) THEN
  988. NLFCL=MLENCL.LECT(NGCF)
  989.  
  990. IF (NLFCL.GT.0) THEN
  991. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  992. c WRITE(6,*) 'CLIM= ', MPOVCL.VPOCHA(NLFCL,1)
  993. COEF = MAX(ABS(COEF1),ABS(COEF2))
  994. c WRITE(6,*) 'COEF= ',COEF
  995. c WRITE(6,*) 'COEF1= ',COEF1
  996. c WRITE(6,*) 'COEF2= ',COEF2
  997. MATR1.MAT2(ICOU,ICOU) = COEF
  998. MATR1.MAT2(ICOU,ICOUG) = 0.0D0
  999. MATR1.MAT2(ICOU,ICOUD) = 0.0D0
  1000.  
  1001. SCMB.MAT(ICOU,NLS2) = (COEF*MPOVCL.VPOCHA(NLFCL,1))
  1002. VAL1.MAT(ICOU,NLS2) = COEF
  1003. VAL2.MAT(ICOU,NLS2) = 0.0D0
  1004. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  1005. IND.NUME(ICOU,NLS2) = NGCF
  1006. IND22.NUME(ICOU,NLS2) = NGCD
  1007. ELSE
  1008. c CONDITION DE FLUX
  1009. NLFNE=MLENNE.LECT(NGCF)
  1010.  
  1011. IF (NLFNE.GT.0) THEN
  1012. QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  1013. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1014. QIMPS = (QIMPX)
  1015.  
  1016. COEF = COEF1
  1017. MATR1.MAT2(ICOU,ICOU) = COEF
  1018. MATR1.MAT2(ICOU,ICOUG) = COEF2
  1019. SCMB.MAT(ICOU,NLS2) =
  1020. & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  1021. & + (2.D0*QIMPS)
  1022. VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2)
  1023. VAL2.MAT(ICOU,NLS2) = 2.D0
  1024. IND.NUME(ICOU,NLS2) = NGCG
  1025. IND22.NUME(ICOU,NLS2) = NGCF
  1026. ELSE
  1027. c CONDITION MIXTE
  1028. NLFMI=MLENMI.LECT(NGCF)
  1029. IF (NLFMI.GT.0) THEN
  1030. XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  1031. XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  1032. QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  1033. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1034. QIMPS = (QIMPX)
  1035. c WRITE(6,*) 'QIMPX= ',QIMPX,'QIMPY= ',QIMPY
  1036. c
  1037. COEF = COEF1
  1038. c WRITE(6,*) 'NGCF= ',NGCF
  1039. c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  1040. c WRITE(6,*) 'COEF= ',COEF
  1041. MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) -
  1042. & (2.D0*XLAMBDA2)
  1043. MATR1.MAT2(ICOU,ICOUG) = (XLAMBDA1*COEF2)
  1044. SCMB.MAT(ICOU,NLS2) =
  1045. & (XLAMBDA1*((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  1046. & + (2.D0*QIMPS)
  1047. VAL1.MAT(ICOU,NLS2) = XLAMBDA1*(COEF1 + COEF2)
  1048. VAL2.MAT(ICOU,NLS2) = 2.D0
  1049. IND.NUME(ICOU,NLS2) = NGCG
  1050. IND22.NUME(ICOU,NLS2) = NGCF
  1051. ELSE
  1052. C PAR DEFAUT FLUX NUL
  1053. QIMPS = 0
  1054. COEF = COEF1
  1055. MATR1.MAT2(ICOU,ICOU) = COEF
  1056. MATR1.MAT2(ICOU,ICOUG) = COEF2
  1057. SCMB.MAT(ICOU,NLS2) =
  1058. & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  1059. VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2)
  1060. VAL2.MAT(ICOU,NLS2) = 0.D0
  1061. IND.NUME(ICOU,NLS2) = NGCG
  1062. IND22.NUME(ICOU,NLS2) = NGCD
  1063. ENDIF
  1064.  
  1065. ENDIF
  1066.  
  1067. ENDIF
  1068. ENDIF
  1069.  
  1070. SEGDES MATR1 *MOD
  1071. c WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU,
  1072. c & 'IND= ',IND.NUME(ICOU,NLS2),
  1073. c & 'IND22= ',IND22.NUME(ICOU,NLS2)
  1074. c WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU,'SCMB', SCMB.MAT(NLS2,ICOU)
  1075. c WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',
  1076. c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  1077. c & 'HD= ',MPOCHP.VPOCHA(NLCD,1)
  1078.  
  1079. c WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU,
  1080. c & 'IND= ',IND.NUME(ICOU,NLS2),
  1081. c & 'IND22= ',IND22.NUME(ICOU,NLS2),
  1082. c & 'SCMB', SCMB.MAT(ICOU,NLS2),
  1083. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS2),
  1084. c & 'ICOUG= ',ICOUG,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG,NLS2),
  1085. c & 'ICOUD= ',ICOUD,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD,NLS2)
  1086. c WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',
  1087. c DO I=1,INDLI.ID(NLS1)
  1088. c DO J = 1,INDLI.ID(NLS1)
  1089. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J,NLS1)
  1090. c WRITE(6,*) 'NLS2= ',NLS2,'I=',I,'J=',J,MATR1.MAT2(I,J,NLS2)
  1091. c ENDDO
  1092. c ENDDO
  1093.  
  1094.  
  1095. ENDDO
  1096. c DO J= 1,INDLI.ID(NLS1)
  1097. c WRITE(6,*) 'MELVA1=',MELVA1.VELCHE(J,NLCF)
  1098. c WRITE(6,*) 'MELVA2=',MELVA1.VELCHE(J,NLCF)
  1099. c WRITE(6,*) 'MELEME=',MELEME.NUM(J,NLCF)
  1100. c ENDDO
  1101.  
  1102. MELTFA = MAUX
  1103. IF (NBSO.EQ.2) THEN
  1104. SEGDES IPT1
  1105. SEGDES IPT2
  1106. ENDIF
  1107.  
  1108.  
  1109. 9999 CONTINUE
  1110. RETURN
  1111. END
  1112.  
  1113.  
  1114.  
  1115.  
  1116.  
  1117.  
  1118.  
  1119.  
  1120.  
  1121.  
  1122.  
  1123.  
  1124.  
  1125.  
  1126.  

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