Télécharger divufn.eso

Retour à la liste

Numérotation des lignes :

divufn
  1. C DIVUFN SOURCE FANDEUR 22/01/03 21:15:12 11136
  2. SUBROUTINE DIVUFN(ICHP2,ICLIM,IPFACE,IFACEL,IRE1,IRE2,IPFONC)
  3. C-----------------------------------------------------------------------
  4. C-----------------------------------------------------------------------
  5.  
  6. C-----------------------------------------------------------------------
  7. C Calcul d'un flux decentre.
  8. C Le CHAMPOINT résultat est de support FACE.
  9. C-----------------------------------------------------------------------
  10. C
  11. C---------------------------
  12. C Parametres Entree/Sortie :
  13. C---------------------------
  14.  
  15. C E/ ICHP2 : CHPOIN DES VALEURS F(THETA)
  16. C E/ ICLIM : CHPOIN DES CONDITIONS AUX LIMITES IMPOSEES
  17. C E/ IPFACE : MELEME DES POINTS FACE
  18. C E/ IFACEL : MELEME DES POINTS FACE POUR LES C.L.
  19. C E/ IRE1 : Champoint de type FLUX
  20. C E/ IRE2 : Mchaml des orientation de normale (1=out,-1=in)
  21. C S/ IPFONC : CHAMPOIN RESULTAT DES F(\THETA) DECENTRE
  22. C
  23. C----------------------
  24. C Tableaux de travail :
  25. C----------------------
  26. C
  27. C
  28. C----------------------
  29. C Variables en COMMON :
  30. C----------------------
  31. C
  32. C IFOUR : cf CCOPTIO.INC
  33. C
  34. C-----------------------------------------------------------------------
  35. C
  36. C Langage : ESOPE + FORTRAN77
  37. C
  38. C Auteurs : C. LE POTIER ET F. AURIOL 20/00
  39. C
  40. C-----------------------------------------------------------------------
  41.  
  42. IMPLICIT INTEGER(I-N)
  43. IMPLICIT REAL*8 (A-H,O-Z)
  44. *
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC SMELEME
  49. -INC SMCHPOI
  50. -INC SMCHAML
  51. -INC SMCOORD
  52. *
  53. SEGMENT ICCPR
  54. INTEGER ICPR(NNGOT)
  55. ENDSEGMENT
  56.  
  57. SEGMENT ICCPR1
  58. INTEGER ICPR1(NNGOT)
  59. ENDSEGMENT
  60.  
  61.  
  62. C
  63. C= INITIALISATIONS
  64. C
  65. MCHPO1 = IRE1
  66. MCHELM = IRE2
  67. IPT1 = IPFACE
  68.  
  69. NNGOT = nbpts
  70. SEGINI ICCPR1
  71.  
  72. *
  73. *= Creation des tableaux ICPR et INUI pour le maillage IPT1 des FACES
  74. *
  75. * WRITE(6,*) 'AVANT SEGACT'
  76. SEGACT IPT1
  77. * WRITE(6,*) 'ON A PASSE LE PREMER SEGACT'
  78. N2 = IPT1.NUM(/2)
  79. IK = 0
  80. DO 109 I2=1,N2
  81. K = IPT1.NUM(1,I2)
  82. IF (ICPR1(K).EQ.0) THEN
  83. IK = IK + 1
  84. ICPR1(K) = IK
  85. ENDIF
  86. 109 CONTINUE
  87. SEGDES IPT1
  88.  
  89. * WRITE(6,*) 'APRES SEDDES IPT1'
  90. C
  91. C- Récupération du pointeur MPOVAL des flux
  92. C
  93. SEGACT MCHPO1
  94. MSOUP1 = MCHPO1.IPCHP(1)
  95. SEGACT MSOUP1
  96. MPOVA1 = MSOUP1.IPOVAL
  97. SEGDES MSOUP1
  98. SEGDES MCHPO1
  99.  
  100. * WRITE(6,*) 'APRES RECUPERATION DU FLUX'
  101. C
  102. C DEFINITION DU CHPOIN RESULTAT
  103. C
  104. NAT=1
  105. NSOUPO=1
  106. SEGINI MCHPOI
  107. * WRITE(6,*) 'MCHPOI'
  108. IPFONC=MCHPOI
  109. IFOPOI = IFOUR
  110. JATTRI(1)=2
  111. NC=1
  112. SEGINI MSOUPO
  113. * WRITE(6,*) 'MSOUPO'
  114. NOCOMP(1)='SCAL'
  115. IPCHP(1)=MSOUPO
  116. IGEOC=IPFACE
  117. IPT1=IPFACE
  118. SEGACT IPT1
  119. N=IPT1.NUM(/2)
  120. SEGINI MPOVAL
  121. IPOVAL=MPOVAL
  122. NOHARM(1)=NIFOUR
  123. * SEGDES MCHPOI
  124. * SEGDES MSOUPO
  125. * SEGDES IPT1
  126. * WRITE(6,*) 'DEFINITION DU CHAMPOIN'
  127. C
  128. IPT3=IFACEL
  129. SEGACT IPT3
  130. NBFACE=IPT3.NUM(/2)
  131. MCHPO2=ICHP2
  132. SEGACT MCHPO2
  133. MSOUP2=MCHPO2.IPCHP(1)
  134. SEGACT MSOUP2
  135. MPOVA2=MSOUP2.IPOVAL
  136. SEGACT MPOVA2
  137. NPCENT=MPOVA2.VPOCHA(/1)
  138. IPT2=MSOUP2.IGEOC
  139. SEGACT IPT2
  140. C On sait que le support de MCHPO2 est le maillage IPCENT (déja vérifié)
  141. NNGOT=nbpts
  142. SEGINI ICCPR
  143. DO 10 I=1,NPCENT
  144. K=IPT2.NUM(1,I)
  145. ICPR(K)=I
  146. 10 CONTINUE
  147.  
  148.  
  149. * WRITE(6,*) 'BOUCLE SUR LES ELEMENTS'
  150. C
  151. C------------------------------------------------
  152. C= Boucle sur les ZONES ELEMENTAIRES du MCHAML
  153. C------------------------------------------------
  154. C
  155. ITELEM = 0
  156. SEGACT MCHELM
  157. SEGACT MPOVA1
  158. NRIGEL = IMACHE(/1)
  159. DO 409 IRI=1,NRIGEL
  160. C
  161. C Recuperation du MELEME et activation
  162. C
  163. MELEME = IMACHE(IRI)
  164. SEGACT MELEME
  165. N1 = NUM(/1)
  166. N2 = NUM(/2)
  167. C
  168. C Récupération du pointeur MELVAL du MCHAML d'orientation
  169. C
  170. MCHAML = ICHAML(IRI)
  171. SEGACT MCHAML
  172. MELVAL = IELVAL(1)
  173. SEGDES MCHAML
  174. SEGACT MELVAL
  175. C
  176. C------------------------------
  177. C= Boucle 30 sur les ELEMENTs.
  178. C------------------------------
  179. C
  180. C CALCUL DE f(THETA) DECENTRE
  181. DO 309 I2=1,N2
  182. ITELEM = ITELEM + 1
  183. DO 209 IN=1,N1
  184. VALIN1 = MPOVA1.VPOCHA(ICPR1(NUM(IN,I2)),1)*VELCHE(IN,I2)
  185. IFACE = ICPR1(NUM(IN,I2))
  186. IP = ICPR(IPT3.NUM(1,IFACE))
  187. ID = ICPR(IPT3.NUM(3,IFACE))
  188. * write(6,*) 'I2=',I2,'IP=',IP, 'ID=', ID
  189. IF (ID.EQ.I2) THEN
  190. ID = IP
  191. IP = I2
  192. ENDIF
  193. IF (VALIN1.LT.0) THEN
  194. VPOCHA(IFACE,1) = MPOVA2.VPOCHA(IP,1)
  195. ELSE
  196. VPOCHA(IFACE,1) = MPOVA2.VPOCHA(ID,1)
  197. ENDIF
  198. 209 CONTINUE
  199. 309 CONTINUE
  200. SEGDES MELVAL, MELEME
  201. 409 CONTINUE
  202.  
  203.  
  204. IF(ICLIM.NE.0)THEN
  205. MCHPO4=ICLIM
  206. SEGACT MCHPO4
  207. NSOUP4=MCHPO4.IPCHP(/1)
  208. CALL INITI(ICPR,NNGOT,0)
  209. IPT4=IPFACE
  210. DO 30 I=1,NBFACE
  211. K=IPT4.NUM(1,I)
  212. ICPR(K)=I
  213. 30 CONTINUE
  214. DO 40 I=1,NSOUP4
  215. MSOUP4=MCHPO4.IPCHP(I)
  216. SEGACT MSOUP4
  217. IPT5=MSOUP4.IGEOC
  218. MPOVA5=MSOUP4.IPOVAL
  219. SEGACT IPT5,MPOVA5
  220. NBP5=IPT5.NUM(/2)
  221. DO 50 J=1,NBP5
  222. NUMP=IPT5.NUM(1,J)
  223. VPOCHA(ICPR(NUMP),1)=MPOVA5.VPOCHA(J,1)
  224. 50 CONTINUE
  225. SEGDES IPT5,MPOVA5,MSOUP4
  226. 40 CONTINUE
  227. SEGDES MCHPO4,IPT2
  228.  
  229. ENDIF
  230.  
  231.  
  232. SEGDES MCHELM
  233. SEGDES MPOVA1
  234. SEGDES MPOVAL
  235.  
  236. SEGSUP ICCPR
  237. SEGSUP ICCPR1
  238. C
  239. RETURN
  240. END
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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