Télécharger divufn.eso

Retour à la liste

Numérotation des lignes :

  1. C DIVUFN SOURCE PV 09/03/12 21:19:22 6325
  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 IFOMOD : 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. -INC CCOPTIO
  46. -INC SMELEME
  47. -INC SMCHPOI
  48. -INC SMCHAML
  49. -INC SMCOORD
  50. *
  51. SEGMENT ICCPR
  52. INTEGER ICPR(NNGOT)
  53. ENDSEGMENT
  54.  
  55. SEGMENT ICCPR1
  56. INTEGER ICPR1(NNGOT)
  57. ENDSEGMENT
  58.  
  59.  
  60. C
  61. C= INITIALISATIONS
  62. C
  63. MCHPO1 = IRE1
  64. MCHELM = IRE2
  65. IPT1 = IPFACE
  66.  
  67. NNGOT = XCOOR(/1)/(IDIM+1)
  68. SEGINI ICCPR1
  69.  
  70. *
  71. *= Creation des tableaux ICPR et INUI pour le maillage IPT1 des FACES
  72. *
  73. * WRITE(6,*) 'AVANT SEGACT'
  74. SEGACT IPT1
  75. * WRITE(6,*) 'ON A PASSE LE PREMER SEGACT'
  76. N2 = IPT1.NUM(/2)
  77. IK = 0
  78. DO 109 I2=1,N2
  79. K = IPT1.NUM(1,I2)
  80. IF (ICPR1(K).EQ.0) THEN
  81. IK = IK + 1
  82. ICPR1(K) = IK
  83. ENDIF
  84. 109 CONTINUE
  85. SEGDES IPT1
  86.  
  87. * WRITE(6,*) 'APRES SEDDES IPT1'
  88. C
  89. C- Récupération du pointeur MPOVAL des flux
  90. C
  91. SEGACT MCHPO1
  92. MSOUP1 = MCHPO1.IPCHP(1)
  93. SEGACT MSOUP1
  94. MPOVA1 = MSOUP1.IPOVAL
  95. SEGDES MSOUP1
  96. SEGDES MCHPO1
  97.  
  98. * WRITE(6,*) 'APRES RECUPERATION DU FLUX'
  99. C
  100. C DEFINITION DU CHPOIN RESULTAT
  101. C
  102. NAT=1
  103. NSOUPO=1
  104. SEGINI MCHPOI
  105. * WRITE(6,*) 'MCHPOI'
  106. IPFONC=MCHPOI
  107. IFOPOI = IFOMOD
  108. JATTRI(1)=2
  109. NC=1
  110. SEGINI MSOUPO
  111. * WRITE(6,*) 'MSOUPO'
  112. NOCOMP(1)='SCAL'
  113. IPCHP(1)=MSOUPO
  114. IGEOC=IPFACE
  115. IPT1=IPFACE
  116. SEGACT IPT1
  117. N=IPT1.NUM(/2)
  118. SEGINI MPOVAL
  119. IPOVAL=MPOVAL
  120. NOHARM(1)=NIFOUR
  121. * SEGDES MCHPOI
  122. * SEGDES MSOUPO
  123. * SEGDES IPT1
  124. * WRITE(6,*) 'DEFINITION DU CHAMPOIN'
  125. C
  126. IPT3=IFACEL
  127. SEGACT IPT3
  128. NBFACE=IPT3.NUM(/2)
  129. MCHPO2=ICHP2
  130. SEGACT MCHPO2
  131. MSOUP2=MCHPO2.IPCHP(1)
  132. SEGACT MSOUP2
  133. MPOVA2=MSOUP2.IPOVAL
  134. SEGACT MPOVA2
  135. NPCENT=MPOVA2.VPOCHA(/1)
  136. IPT2=MSOUP2.IGEOC
  137. SEGACT IPT2
  138. C On sait que le support de MCHPO2 est le maillage IPCENT (déja vérifié)
  139. NNGOT=XCOOR(/1)/(IDIM+1)
  140. SEGINI ICCPR
  141. DO 10 I=1,NPCENT
  142. K=IPT2.NUM(1,I)
  143. ICPR(K)=I
  144. 10 CONTINUE
  145.  
  146.  
  147. * WRITE(6,*) 'BOUCLE SUR LES ELEMENTS'
  148. C
  149. C------------------------------------------------
  150. C= Boucle sur les ZONES ELEMENTAIRES du MCHAML
  151. C------------------------------------------------
  152. C
  153. ITELEM = 0
  154. SEGACT MCHELM
  155. SEGACT MPOVA1
  156. NRIGEL = IMACHE(/1)
  157. DO 409 IRI=1,NRIGEL
  158. C
  159. C Recuperation du MELEME et activation
  160. C
  161. MELEME = IMACHE(IRI)
  162. SEGACT MELEME
  163. N1 = NUM(/1)
  164. N2 = NUM(/2)
  165. C
  166. C Récupération du pointeur MELVAL du MCHAML d'orientation
  167. C
  168. MCHAML = ICHAML(IRI)
  169. SEGACT MCHAML
  170. MELVAL = IELVAL(1)
  171. SEGDES MCHAML
  172. SEGACT MELVAL
  173. C
  174. C------------------------------
  175. C= Boucle 30 sur les ELEMENTs.
  176. C------------------------------
  177. C
  178. C CALCUL DE f(THETA) DECENTRE
  179. DO 309 I2=1,N2
  180. ITELEM = ITELEM + 1
  181. DO 209 IN=1,N1
  182. VALIN1 = MPOVA1.VPOCHA(ICPR1(NUM(IN,I2)),1)*VELCHE(IN,I2)
  183. IFACE = ICPR1(NUM(IN,I2))
  184. IP = ICPR(IPT3.NUM(1,IFACE))
  185. ID = ICPR(IPT3.NUM(3,IFACE))
  186. * write(6,*) 'I2=',I2,'IP=',IP, 'ID=', ID
  187. IF (ID.EQ.I2) THEN
  188. ID = IP
  189. IP = I2
  190. ENDIF
  191. IF (VALIN1.LT.0) THEN
  192. VPOCHA(IFACE,1) = MPOVA2.VPOCHA(IP,1)
  193. ELSE
  194. VPOCHA(IFACE,1) = MPOVA2.VPOCHA(ID,1)
  195. ENDIF
  196. 209 CONTINUE
  197. 309 CONTINUE
  198. SEGDES MELVAL, MELEME
  199. 409 CONTINUE
  200.  
  201.  
  202. IF(ICLIM.NE.0)THEN
  203. MCHPO4=ICLIM
  204. SEGACT MCHPO4
  205. NSOUP4=MCHPO4.IPCHP(/1)
  206. CALL INITI(ICPR,NNGOT,0)
  207. IPT4=IPFACE
  208. DO 30 I=1,NBFACE
  209. K=IPT4.NUM(1,I)
  210. ICPR(K)=I
  211. 30 CONTINUE
  212. DO 40 I=1,NSOUP4
  213. MSOUP4=MCHPO4.IPCHP(I)
  214. SEGACT MSOUP4
  215. IPT5=MSOUP4.IGEOC
  216. MPOVA5=MSOUP4.IPOVAL
  217. SEGACT IPT5,MPOVA5
  218. NBP5=IPT5.NUM(/2)
  219. DO 50 J=1,NBP5
  220. NUMP=IPT5.NUM(1,J)
  221. VPOCHA(ICPR(NUMP),1)=MPOVA5.VPOCHA(J,1)
  222. 50 CONTINUE
  223. SEGDES IPT5,MPOVA5,MSOUP4
  224. 40 CONTINUE
  225. SEGDES MCHPO4,IPT2
  226.  
  227. ENDIF
  228.  
  229.  
  230. SEGDES MCHELM
  231. SEGDES MPOVA1
  232. SEGDES MPOVAL
  233.  
  234. SEGSUP ICCPR
  235. SEGSUP ICCPR1
  236. C
  237. RETURN
  238. END
  239.  
  240.  
  241.  
  242.  
  243.  

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