Télécharger norv5.eso

Retour à la liste

Numérotation des lignes :

  1. C NORV5 SOURCE KK2000 14/04/10 21:15:25 8032
  2. SUBROUTINE NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,
  3. & MLECEN,MLEFA,MPOCHP,MLENCL,MPOVCL,
  4. & MLENNE,MPOVNE,MLENMI,MPOVMI,
  5. & LOGBOR,LOGCCL,LOGCOE)
  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.  
  24. -INC CCOPTIO
  25. -INC SMLENTI
  26. -INC SMELEME
  27. -INC SMCHPOI
  28. -INC SMCOORD
  29. -INC SMLREEL
  30. -INC SMCHAML
  31.  
  32. POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  33. & MELTFA.MELEME
  34. POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  35. & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  36. & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL
  37. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  38. & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,
  39. & MLEFA2.MLENTI
  40. INTEGER NBNN,NBREF
  41.  
  42.  
  43. C**** Variable de SMLENTI, SMCHPOI
  44. C
  45. INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  46. C
  47. C**** Les includes
  48. C
  49. INTEGER I1,ICOMP,ICOMGR,IGEOM
  50. & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  51. & ,ISURF,IMAIL,ICHPO,ICHCL,ICHNE,ICHGRA,ICOEFF
  52. & ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  53. & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  54. & ,NLS1,NLS2,NLFCL
  55. & ,ISOUS,IELEM,INOEUD,ICELL
  56. INTEGER ICEN2
  57. REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  58. & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  59. & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  60. & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  61. & TRD1,TRD2,TRG,TRD
  62. REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  63. & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,COEF1X,COEF2X,
  64. & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  65. & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22
  66. & QIMPX,QIMPY,QIMPZ
  67.  
  68. REAL*8 EPS
  69. INTEGER ICRIT
  70. CHARACTER*8 TYPE
  71. INTEGER LOGBOR,LOGCOE,LOGCCL
  72. C
  73. MCHELM = ICOEFF
  74. SEGACT MCHELM
  75. NBSOUS=MCHELM.IMACHE(/1)
  76.  
  77.  
  78. IF (LOGBOR.EQ.0) THEN
  79. DO ISOUS=1,NBSOUS,1
  80. MELEME=MCHELM.IMACHE(ISOUS)
  81. MCHAM1=MCHELM.ICHAML(ISOUS)
  82. SEGACT MELEME
  83. SEGACT MCHAM1
  84. MELVA1=MCHAM1.IELVAL(1)
  85. SEGACT MELVA1
  86. C
  87. NBNN=MELEME.NUM(/1)
  88. NFAC=MELEME.NUM(/2)
  89. C
  90. DO IELEM = 1,NFAC
  91. NGF=MELEME.NUM(1,IELEM)
  92. NLCF=MLEFA.LECT(NGF)
  93. MPOGRA.VPOCHA(NLCF,1) = 0.D0
  94. C NGCF=MELEFL.NUM(2,NLCF)
  95. DO IVOI=2,NBNN
  96. ICENT = MELEME.NUM(IVOI,IELEM)
  97. ICEN = MLECEN.LECT(ICENT)
  98. VAL = 0.0D0
  99. IF (ICEN.EQ.0) THEN
  100. c WRITE(6,*) 'INTERIEUR'
  101. c VAL = MPOCHP.VPOCHA(ICEN,1)
  102. c ELSE
  103. ICENL = MLENCL.LECT(ICENT)
  104. IF (ICENL.GT.0) THEN
  105. c WRITE(6,*) 'DIRICHLET'
  106. VAL = MPOVCL.VPOCHA(ICENL,1)
  107. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL
  108. ELSE
  109. C CONDITIONS DE FLUX
  110. c WRITE(6,*) 'FLUX'
  111. ICENNE = MLENNE.LECT(ICENT)
  112. IF (ICENNE.GT.0) THEN
  113. QIMPX = MPOVNE.VPOCHA(ICENNE,1)
  114. VAL = (QIMPX)
  115. ELSE
  116. ICENMI = MLENMI.LECT(ICENT)
  117. IF (ICENMI .EQ.0) THEN
  118. WRITE(IOIMP,*)
  119. & 'PROBLEME DANS LES CONDITIONS AUX LIMITES'
  120.  
  121. ELSE
  122. QIMPX = MPOVMI.VPOCHA(ICENMI,3)
  123. VAL = (QIMPX)
  124.  
  125. ENDIF
  126. ENDIF
  127. ENDIF
  128.  
  129.  
  130. c WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL
  131. c WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF),
  132. c & 'COEF1 = ',COEF1
  133.  
  134. COEF1 = MELVA1.VELCHE(IVOI,IELEM)
  135. MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) +
  136. & (COEF1 * VAL)
  137. ENDIF
  138. ENDDO
  139. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  140. c WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1)
  141. c WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2)
  142. c WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3)
  143. c ENDIF
  144. ENDDO
  145. ENDDO
  146.  
  147. C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT
  148.  
  149.  
  150. ELSEIF (LOGCOE.EQ.0) THEN
  151. DO ISOUS=1,NBSOUS,1
  152. MELEME=MCHELM.IMACHE(ISOUS)
  153. MCHAM1=MCHELM.ICHAML(ISOUS)
  154. SEGACT MELEME
  155. SEGACT MCHAM1
  156. MELVA1=MCHAM1.IELVAL(1)
  157. SEGACT MELVA1
  158. C
  159. NBNN=MELEME.NUM(/1)
  160. NFAC=MELEME.NUM(/2)
  161. C
  162. DO IELEM = 1,NFAC
  163. NGF=MELEME.NUM(1,IELEM)
  164. NLCF=MLEFA.LECT(NGF)
  165. MPOGRA.VPOCHA(NLCF,1) = 0.D0
  166. C NGCF=MELEFL.NUM(2,NLCF)
  167. NGCG=MELEFL.NUM(1,NLCF)
  168. NGCD=MELEFL.NUM(3,NLCF)
  169. c IF (NGCG.EQ.NGCD) THEN
  170. DO IVOI=2,NBNN
  171. ICENT = MELEME.NUM(IVOI,IELEM)
  172. c WRITE(6,*) 'ISOUS= ',ISOUS
  173. c WRITE(6,*) 'IELEM= ',IELEM,'IVOI= ',IVOI
  174. c WRITE(6,*) 'ICENT= ',ICENT
  175. ICEN = MLECEN.LECT(ICENT)
  176. VAL = 0.0D0
  177. IF (ICEN.NE.0) THEN
  178. c WRITE(6,*) 'INTERIEUR'
  179. VAL = MPOCHP.VPOCHA(ICEN,1)
  180. ELSE
  181. ICENL = MLENCL.LECT(ICENT)
  182. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL
  183. IF (ICENL.GT.0) THEN
  184. c WRITE(6,*) 'DIRICHLET'
  185. VAL = MPOVCL.VPOCHA(ICENL,1)
  186. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL
  187. ELSE
  188. C CONDITIONS DE FLUX
  189. c WRITE(6,*) 'FLUX'
  190. ICENNE = MLENNE.LECT(ICENT)
  191. IF (ICENNE.GT.0) THEN
  192. c WRITE(6,*) 'NLCF= ',NLCF,'SCN1X= ',SCN1X
  193. c WRITE(6,*) 'NLCF= ',NLCF,'SCN1Y= ',SCN1Y
  194. QIMPX = MPOVNE.VPOCHA(ICENNE,1)
  195. c WRITE(6,*) 'NLCF= ',NLCF,'QIMPX= ',QIMPX
  196. c WRITE(6,*) 'NLCF= ',NLCF,'QIMPY= ',QIMPY
  197. VAL = (QIMPX)
  198. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENT,'VAL= ',VAL
  199. ELSE
  200. ICENMI = MLENMI.LECT(ICENT)
  201. IF (ICENMI .EQ.0) THEN
  202. WRITE(IOIMP,*)
  203. & 'PROBLEME DANS LES CONDITIONS AUX LIMITES'
  204.  
  205. ELSE
  206. QIMPX = MPOVMI.VPOCHA(ICENMI,3)
  207. VAL = (QIMPX)
  208.  
  209. ENDIF
  210. ENDIF
  211. ENDIF
  212.  
  213. ENDIF
  214.  
  215. c WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL
  216. c WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF),
  217. c & 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',COEF3
  218.  
  219. COEF1 = MELVA1.VELCHE(IVOI,IELEM)
  220. MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) +
  221. & (COEF1 * VAL)
  222. ENDDO
  223. C ENDIF
  224. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  225. c WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1)
  226. c WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2)
  227. c WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3)
  228. ENDDO
  229. ENDDO
  230. ELSEIF (LOGCCL.EQ.0) THEN
  231.  
  232.  
  233. DO ISOUS=1,NBSOUS,1
  234. MELEME=MCHELM.IMACHE(ISOUS)
  235. MCHAM1=MCHELM.ICHAML(ISOUS)
  236. SEGACT MELEME
  237. SEGACT MCHAM1
  238. MELVA1=MCHAM1.IELVAL(1)
  239. SEGACT MELVA1
  240. C
  241. NBNN=MELEME.NUM(/1)
  242. NFAC=MELEME.NUM(/2)
  243. C
  244. DO IELEM = 1,NFAC
  245. NGF=MELEME.NUM(1,IELEM)
  246. NLCF=MLEFA.LECT(NGF)
  247. MPOGRA.VPOCHA(NLCF,1) = 0.D0
  248. C NGCF=MELEFL.NUM(2,NLCF)
  249. NGCG=MELEFL.NUM(1,NLCF)
  250. NGCD=MELEFL.NUM(3,NLCF)
  251. IF (NGCG.EQ.NGCD) THEN
  252. DO IVOI=2,MELEME.NUM(/1)
  253. ICENT = MELEME.NUM(IVOI,IELEM)
  254. ICEN = MLECEN.LECT(ICENT)
  255. VAL = 0.0D0
  256. IF (ICEN.NE.0) THEN
  257. c WRITE(6,*) 'INTERIEUR'
  258. VAL = MPOCHP.VPOCHA(ICEN,1)
  259. ELSE
  260. ICENL = MLENCL.LECT(ICENT)
  261. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL
  262. IF (ICENL.GT.0) THEN
  263. c WRITE(6,*) 'DIRICHLET'
  264. VAL = MPOVCL.VPOCHA(ICENL,1)
  265. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL
  266. ELSE
  267. C CONDITIONS DE FLUX
  268. c WRITE(6,*) 'FLUX'
  269. ICENNE = MLENNE.LECT(ICENT)
  270. IF (ICENNE.GT.0) THEN
  271. c WRITE(6,*) 'NLCF= ',NLCF,'SCN1X= ',SCN1X
  272. c WRITE(6,*) 'NLCF= ',NLCF,'SCN1Y= ',SCN1Y
  273. QIMPX = MPOVNE.VPOCHA(ICENNE,1)
  274. c WRITE(6,*) 'NLCF= ',NLCF,'QIMPX= ',QIMPX
  275. c WRITE(6,*) 'NLCF= ',NLCF,'QIMPY= ',QIMPY
  276. VAL = (QIMPX)
  277. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENT,'VAL= ',VAL
  278. ELSE
  279. ICENMI = MLENMI.LECT(ICENT)
  280. IF (ICENMI .EQ.0) THEN
  281. WRITE(IOIMP,*)
  282. & 'PROBLEME DANS LES CONDITIONS AUX LIMITES'
  283.  
  284. ELSE
  285. QIMPX = MPOVMI.VPOCHA(ICENMI,3)
  286. VAL = (QIMPX)
  287.  
  288. ENDIF
  289. ENDIF
  290. ENDIF
  291.  
  292. ENDIF
  293.  
  294. c WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL
  295. c WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF),
  296. c & 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',COEF3
  297.  
  298. COEF1 = MELVA1.VELCHE(IVOI,IELEM)
  299. MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) +
  300. & (COEF1 * VAL)
  301. ENDDO
  302. ENDIF
  303. c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  304. c WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1)
  305. c WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2)
  306. c WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3)
  307. ENDDO
  308. ENDDO
  309. ENDIF
  310. SEGDES MCHAM1
  311. SEGDES MELVA1
  312. SEGDES MELEME
  313. SEGDES MCHELM
  314. SEGDES MPOGRA
  315.  
  316.  
  317. C
  318.  
  319.  
  320.  
  321.  
  322. RETURN
  323. END
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  

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