Télécharger norv3.eso

Retour à la liste

Numérotation des lignes :

  1. C NORV3 SOURCE PV 09/03/12 21:29:42 6325
  2. SUBROUTINE NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI,
  3. & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : NORV1
  10. C
  11. C DESCRIPTION : Appelle par NORV
  12. C
  13. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  14. C
  15. C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS
  16. C
  17. C************************************************************************
  18. C
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8 (a-h,o-z)
  21. -INC SMLENTI
  22. -INC SMELEME
  23. -INC SMCHPOI
  24. -INC CCOPTIO
  25. -INC SMCOORD
  26. -INC SMLREEL
  27. POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  28. & MELTFA.MELEME
  29. POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  30. & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  31. & MPOGRA.MPOVAL,MPOTEN.MPOVAL
  32. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  33. & MLEFA.MLENTI
  34. -INC SMCHAML
  35. INTEGER NBNN,NBREF
  36.  
  37.  
  38.  
  39. C
  40. C**** Variables de COOPTIO
  41. C
  42. C
  43. C**** Variables de COOPTIO
  44. C
  45. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  46. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  47. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  48. C & ,IECHO, IIMPI, IOSPI
  49. C & ,IDIM
  50. C & ,MCOORD
  51. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  52. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  53. C & ,NORINC,NORVAL,NORIND,NORVAD
  54. C & ,NUCROU, IPSAUV
  55.  
  56. C**** Variable de SMLENTI, SMCHPOI
  57. C
  58. INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  59. C
  60. C**** Les includes
  61. C
  62. INTEGER I1,ICOMP,ICOMGR,IGEOM
  63. & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  64. & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF
  65. & ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  66. & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  67. & ,NLS1,NLS2,NLFCL
  68. & ,ISOUS,IELEM,INOEUD,ICELL
  69. INTEGER ICEN2
  70. REAL*8 SCNX,SCNY,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  71. & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  72. & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  73. & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  74. & TRD1,TRD2,TRG,TRD,VALAUX
  75. REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  76. & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,VX,VY,COEF1X,COEF2X,
  77. & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  78. & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22
  79.  
  80. REAL*8 VECXG1(2),VECYG1(2)
  81. REAL*8 VECXG2(2),VECYG2(2)
  82. REAL*8 VECXD1(2),VECYD1(2)
  83. REAL*8 VECXD2(2),VECYD2(2)
  84. REAL*8 EPS
  85. INTEGER ICRIT
  86. CHARACTER*(4) NOMCOM(18)
  87. CHARACTER*8 TYPE
  88. C
  89. DATA NOMCOM /'P1DX','P1DY',
  90. & 'P2DX','P2DY',
  91. & 'P3DX','P3DY',
  92. & 'P4DX','P4DY',
  93. & 'P5DX','P5DY',
  94. & 'P6DX','P6DY',
  95. & 'P7DX','P7DY',
  96. & 'P8DX','P8DY',
  97. & 'P9DX','P9DY'/
  98.  
  99. INTEGER NDIM
  100. SEGMENT MMAT1
  101. REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  102. INTEGER IC(NDIM)
  103. ENDSEGMENT
  104.  
  105. INTEGER K1,K2
  106. SEGMENT INDICE
  107. INTEGER NUME(K1,K2)
  108. ENDSEGMENT
  109. POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  110.  
  111. SEGMENT MATRICE
  112. REAL*8 MAT(K1,K2)
  113. ENDSEGMENT
  114. POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  115.  
  116. INTEGER K3
  117. SEGMENT POINT2
  118. INTEGER POINT(K3)
  119. ENDSEGMENT
  120. POINTEUR IPO2.POINT2
  121.  
  122. SEGMENT MATRICE2
  123. REAL*8 MAT2(K1,K2)
  124. ENDSEGMENT
  125. POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  126.  
  127.  
  128. SEGMENT POINT3
  129. INTEGER POINT33(K3)
  130. ENDSEGMENT
  131. POINTEUR IPO3.POINT3
  132.  
  133. SEGMENT INDICE3
  134. INTEGER NU(K1,K2)
  135. ENDSEGMENT
  136. POINTEUR INDIC.INDICE3
  137.  
  138.  
  139.  
  140.  
  141. SEGMENT REP
  142. INTEGER ID(K3)
  143. ENDSEGMENT
  144. POINTEUR TAB.REP,INDLI.REP
  145.  
  146.  
  147. K3 = NSOMM
  148. SEGINI IPO3
  149. c SEGINI VAUX
  150.  
  151.  
  152.  
  153.  
  154.  
  155. c WRITE(6,*) 'DANS NORV3'
  156. c WRITE(6,*) 'NBMAX= ',NBMAX
  157.  
  158. * ON EST ICI
  159. c INVERSION DE CHAQUE PETITE MATRICE
  160. EPS = 1.e-30
  161. XINF = 1.e+30
  162. NMOY = 0
  163. DO NLS1=1,NSOMM,1
  164. NMOY = NMOY + (INDLI.ID(NLS1)*INDLI.ID(NLS1))
  165. NDIM = INDLI.ID(NLS1)
  166. c WRITE(6,*) 'NLS1= ',NLS1,'NDIM = ', NDIM
  167. K1 = NBMAX
  168. K2 = (NBMAX+1)
  169. SEGINI MMAT1
  170.  
  171. K1 = NBMAX
  172. K2 = NBMAX + 1
  173. SEGINI INDIC
  174. IPO3.POINT33(NLS1) = INDIC
  175.  
  176. C ON EST ICI
  177. MATR1 = IPO2.POINT(NLS1)
  178. SEGACT MATR1 *MOD
  179.  
  180. DO I=1,INDLI.ID(NLS1)
  181. DO J = 1,INDLI.ID(NLS1)
  182. PM(I,J) = MATR1.MAT2(I,J)
  183. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,PM(I,J)
  184. ENDDO
  185. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'SCMB', SCMB.MAT(I,NLS1)
  186. ENDDO
  187. c WRITE(6,*) 'NLS1= ',NLS1,'EPS= ',EPS
  188. CALL INVER(PM,NDIM,ICRIT,PM1,IC,EPS)
  189. c WRITE(6,*) 'NLS1= ',NLS1,'EPS= ',EPS
  190. c WRITE(6,*) 'NLS1= ',NLS1,'ICRIT= ',ICRIT
  191. IF (ICRIT.EQ.1) THEN
  192. WRITE(6,*) 'MATRICE PEUT ETRE NON INVERSIBLE'
  193. WRITE(6,*) 'NLS1= ',NLS1
  194. c DO I=1,INDLI.ID(NLS1)
  195. c DO J = 1,INDLI.ID(NLS1)
  196. c PM(I,J) = 0.0
  197. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'NOEUD2= ',
  198. c & MATR1.MAT2(I,J)
  199. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'PM= ',PM(I,J)
  200. c ENDDO
  201. c ENDDO
  202. ENDIF
  203.  
  204. ITROUVE = 0
  205. DO I=1,INDLI.ID(NLS1)
  206. DO J = 1,INDLI.ID(NLS1)
  207. IF (PM(I,J).GT.XINF) THEN
  208. ITROUVE = 1
  209. GOTO 444
  210. ENDIF
  211. ENDDO
  212. ENDDO
  213. 444 CONTINUE
  214.  
  215. IF (ITROUVE.EQ.1) THEN
  216. WRITE(6,*) 'PM EST TRES GRAND : LE CONDITIONNEMNENT EST PEUT
  217. & ETRE MAUVAIS'
  218. c DO I=1,INDLI.ID(NLS1)
  219. c DO J = 1,INDLI.ID(NLS1)
  220. c PM(I,J) = 0.0D0
  221. c ENDDO
  222. c ENDDO
  223. ENDIF
  224.  
  225.  
  226. c WRITE(6,*) 'NLS1= ',NLS1,'INDLI(NLS1)=',INDLI.ID(NLS1)
  227. DO I = 1,INDLI.ID(NLS1)
  228. XSOL(I) = 0.0D0
  229. DO J = 1,INDLI.ID(NLS1)
  230. c WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'SCMB', SCMB.MAT(J,NLS1)
  231. c WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'SCMB', SCMB.MAT(J,NLS1)
  232. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'PM= ',PM(I,J)
  233. XSOL(I) = XSOL(I) + (SCMB.MAT(J,NLS1)*PM(I,J))
  234. ENDDO
  235. ENDDO
  236.  
  237. DO J = 1,INDLI.ID(NLS1)
  238. SCMB.MAT(J,NLS1) = XSOL(J)
  239. c WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'XSOL',XSOL(J)
  240. ENDDO
  241.  
  242. DO IAUX = 1,INDLI.ID(NLS1)
  243.  
  244. ICON = 0
  245. DO JAUX = 1,INDLI.ID(NLS1)
  246. MATR1.MAT2(IAUX,JAUX) = 0.0D0
  247. VALAUX = PM(IAUX,JAUX) *
  248. & (VAL1.MAT(JAUX,NLS1))
  249. NTEST = IND.NUME(JAUX,NLS1)
  250. IF (NTEST.NE.0) THEN
  251. c WRITE(6,*) 'NLS1= ',NLS1, 'IND=',IND.NUME(JAUX,NLS1)
  252. c WRITE(6,*) 'NLS1= ',NLS1, 'VAL1=',VAL1.MAT(JAUX,NLS1)
  253. c WRITE(6,*) 'NLS1= ',NLS1, 'IND=',IND22.NUME(JAUX,NLS1)
  254. c WRITE(6,*) 'NLS1= ',NLS1, 'VAL2=',VAL2.MAT(JAUX,NLS1)
  255.  
  256. c RECHERCHE DE NTEST
  257.  
  258. DO IAUX2=1,INDLI.ID(NLS1)
  259. J1 = INDIC.NU(IAUX,IAUX2)
  260. J2 = NTEST
  261. IF (J1.EQ.J2) THEN
  262. ITEST = IAUX2
  263. GOTO 533
  264. ENDIF
  265. ENDDO
  266. ICON = ICON +1
  267. ITEST = ICON
  268. IF (ITEST.GT.K2) THEN
  269. WRITE(6,*) 'K2 TROP PETIT'
  270. CALL ERREUR(5)
  271. ENDIF
  272.  
  273. 533 CONTINUE
  274. INDIC.NU(IAUX,ITEST) = NTEST
  275. MATR1.MAT2(IAUX,ITEST) = MATR1.MAT2(IAUX,ITEST)
  276. & + VALAUX
  277. ENDIF
  278.  
  279. ENDDO
  280. c ENDDO
  281.  
  282. C MEME CHOSE POUR VAL2
  283. c DO IAUX = 1,INDLI.ID(NLS1)
  284.  
  285. DO JAUX = 1,INDLI.ID(NLS1)
  286. VALAUX = PM(IAUX,JAUX) *
  287. & (VAL2.MAT(JAUX,NLS1))
  288. NTEST = IND22.NUME(JAUX,NLS1)
  289.  
  290. c RECHERCHE DE NTEST
  291.  
  292. IF (NTEST.NE.0) THEN
  293. DO IAUX2 = 1,ICON
  294. J1 = INDIC.NU(IAUX,IAUX2)
  295. J2 = NTEST
  296. IF (J1.EQ.J2) THEN
  297. ITEST = IAUX2
  298. GOTO 633
  299. ENDIF
  300. ENDDO
  301. ICON = ICON +1
  302. ITEST = ICON
  303. IF (ITEST.GT.K2) THEN
  304. WRITE(6,*) 'K2 TROP PETIT'
  305. CALL ERREUR(5)
  306. ENDIF
  307.  
  308. 633 CONTINUE
  309. INDIC.NU(IAUX,ITEST) = NTEST
  310. MATR1.MAT2(IAUX,ITEST) = MATR1.MAT2(IAUX,ITEST)
  311. & + VALAUX
  312. ENDIF
  313.  
  314. ENDDO
  315. ENDDO
  316. TAB.ID(NLS1) = ICON
  317. c DO IAUX = 1,INDLI.ID(NLS1)
  318. cc DO IAUX2 = 1,TAB.ID(NLS1)
  319. c WRITE(6,*) 'NLS1= ',NLS1,'IAUX= ',IAUX ,'IAUX2= ',
  320. c & IAUX2,'VAUX',MATR1.MAT2(IAUX,IAUX2)
  321. c & ,'IND3= ',INDIC.NU(IAUX,IAUX2)
  322. c ENDDO
  323. c ENDDO
  324. c WRITE(6,*) 'ICON= ',ICON
  325.  
  326. SEGDES INDIC
  327. SEGDES MATR1
  328. SEGSUP MMAT1
  329. ENDDO
  330. NMOY = NMOY/(1.D0*NSOMM)
  331. c WRITE(6,*) 'NMOY1= ',(NMOY)
  332. c SEGSUP NOEUD2
  333. SEGSUP VAL1
  334. SEGSUP VAL2
  335. SEGSUP IND
  336. SEGSUP IND22
  337.  
  338.  
  339.  
  340. 9999 CONTINUE
  341. RETURN
  342. END
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  

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