Télécharger konsf1.eso

Retour à la liste

Numérotation des lignes :

konsf1
  1. C KONSF1 SOURCE CB215821 20/11/25 13:32:39 10792
  2. SUBROUTINE KONSF1(INDMET,ISF,IVN,INORM,ICHPSU,ICHPDI,
  3. & MELEMC,MELEMF,MELEFE,ICHFLU,DT,LOGAN,
  4. & MESERR)
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : KONSF1
  10. C
  11. C DESCRIPTION : Voir KONV14
  12. C
  13. C Cas 2D/3D
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, DM2S/SFME
  18. C
  19. C************************************************************************
  20. C
  21. C APPELES (Outils
  22. C CASTEM) : KRIPAD, LICHT
  23. C
  24. C APPELES (Calcul) :
  25. C
  26. C************************************************************************
  27. C
  28. C ENTREES
  29. C
  30. C 1) PARAMETRES
  31. C
  32. C INDMET : 1 UPWIND
  33. C
  34. C 2 CENTERED
  35. C
  36. C 2) Pointeurs des MCHAMLs/CHPOINTs
  37. C
  38. C ISF : MCHAML sur "FACEL" contenant les scalaires passifs
  39. C ("gauche" et "droite");
  40. C
  41. C IVN : CHPOINTs sur "FACE" (vitesse aux faces)
  42. C
  43. C 3) Pointeurs de CHPOINTs de la table DOMAINE
  44. C
  45. C INORM : CHPOINT "FACE" contenant les normales aux faces
  46. C
  47. C ICHPSU : CHPOINT "FACE" contenant la surface des faces
  48. C
  49. C ICHPDI : CHPOINT "CENTRE" contenant le diametre minimum
  50. C de chaque element
  51. C
  52. C
  53. C 4) Pointeurs de MELEME de la table DOMAINE
  54. C
  55. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  56. C
  57. C MELEMF : MELEME 'FACE' du SPG des FACES
  58. C
  59. C MELEFE : MELEME 'FACEL' du connectivité FACES -> ELEM
  60. C
  61. C SORTIES
  62. C
  63. C ICHFLU : pointeurs de CHPOINTs "FACE" des flux aux interfaces:
  64. C
  65. C DT : pas de temps pour le respect de la CFL-like condition
  66. C DT < DIAMMIN /2 /max(Lambda_i)
  67. C En maillage regulier cette condition garantie la
  68. C non-interaction des ondes
  69. C
  70. C LOGAN : (LOGICAL): si .TRUE. une anomalie à été detectée
  71. C
  72. C MESERR : pour l'ecriture des messages d'erreurs
  73. C
  74. C************************************************************************
  75. C
  76. C HISTORIQUE (Anomalies et modifications éventuelles)
  77. C
  78. C HISTORIQUE : créée le 29.11.01
  79. C
  80. C************************************************************************
  81. C
  82. C
  83. C**** Variables de COOPTIO
  84. C
  85. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  86. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  87. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  88. C & ,IECHO, IIMPI, IOSPI
  89. C & ,IDIM
  90. C & ,MCOORD
  91. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  92. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  93. C & ,NORINC,NORVAL,NORIND,NORVAD
  94. C & ,NUCROU, IPSAUV
  95. C
  96. IMPLICIT INTEGER(I-N)
  97. INTEGER INDMET, ISF, IVN, INORM
  98. & ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
  99. & ,IGEOMC,IGEOMF
  100. & ,ICHFLU
  101. & ,NFAC
  102. & ,NLCF, NGCEG, NGCED, NLCEG, NLCED
  103. & ,NGCF, NLCF1, NSCA, ISCA
  104. REAL*8 DT, UNSDT, UX, UY, UZ, UN
  105. & , SURF,CNX, CNY, CNZ
  106. & , CELL, DIAM
  107. LOGICAL LOGAN
  108. CHARACTER*(40) MESERR
  109. CHARACTER*(8) TYPE
  110. C
  111. C**** LES INCLUDES
  112. C
  113.  
  114. -INC PPARAM
  115. -INC CCOPTIO
  116. -INC SMCHAML
  117. -INC SMCHPOI
  118. POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
  119. & , MPOFLU.MPOVAL, MPNORM.MPOVAL, MPOVIT.MPOVAL
  120. -INC SMELEME
  121. -INC SMLMOTS
  122. -INC SMLENTI
  123. C
  124. C**** Les flux aux interface dans le repaire (n,t)
  125. C
  126. INTEGER NFLU
  127. SEGMENT IFLUX
  128. REAL*8 FLUX(NFLU)
  129. ENDSEGMENT
  130. C
  131. C**** Scalaires
  132. C
  133. MCHEL1 = ISF
  134. SEGACT MCHEL1
  135. MCHAM1 = MCHEL1.ICHAML(1)
  136. SEGDES MCHEL1
  137. SEGACT MCHAM1
  138. NSCA= MCHAM1.IELVAL(/1)
  139. DO ISCA=1,NSCA,1
  140. MELVAL=MCHAM1.IELVAL(ISCA)
  141. SEGACT MELVAL
  142. ENDDO
  143. C
  144. C**** La vitesse
  145. C
  146. CALL LICHT(IVN,MPOVIT,TYPE,IGEOMC)
  147. IF(IERR.NE.0)GOTO 9999
  148. C SEGACT MPOVIT
  149. C
  150. C**** Le flux à l'interface
  151. C
  152. NFLU=NSCA
  153. SEGINI IFLUX
  154. C
  155. C**** Lecture des MELEMEs
  156. C
  157. C 'CENTRE', 'FACEL'
  158. C
  159. IPT2 = MELEFE
  160. SEGACT IPT2
  161. NFAC = IPT2.NUM(/2)
  162. C
  163. C**** KRIPAD pour la correspondance global/local de centre
  164. C
  165. CALL KRIPAD(MELEMC,MLENT1)
  166. IF(IERR.NE.0)GOTO 9999
  167. C
  168. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  169. C
  170. C Si i est le numero global d'un noeud de ICEN,
  171. C MLENT1.LECT(i) contient sa position, i.e.
  172. C
  173. C I = numero global du noeud centre
  174. C MLENT1.LECT(i) = numero local du noeud centre
  175. C
  176. C MLENT1 déjà activé, i.e.
  177. C
  178. C SEGACT MLENT1
  179. C
  180. C
  181. C**** KRIPAD pour la correspondance global/local de 'FACE'
  182. C
  183. CALL KRIPAD(MELEMF,MLENT2)
  184. IF(IERR.NE.0)GOTO 9999
  185. C SEGACT MELNT2
  186. C
  187. C**** CHPOINTs de la table DOMAINE
  188. C
  189. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  190. IF(IERR.NE.0)GOTO 9999
  191. CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
  192. IF(IERR.NE.0)GOTO 9999
  193. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  194. IF(IERR.NE.0)GOTO 9999
  195. C
  196. C**** LICHT active les MPOVALs en *MOD
  197. C
  198. C i.e.
  199. C
  200. C SEGACT MPOVSU*MOD
  201. C SEGACT MPOVDI*MOD
  202. C SEGACT MPNORM*MOD
  203. C
  204. C**** Les FLUX aux faces
  205. C
  206. CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
  207. C
  208. C SEGACT MPOFLU*MOD
  209. C
  210. C
  211. C**** Initialisation de 1/DT
  212. C
  213. UNSDT = 0.0D0
  214. C
  215. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  216. C
  217. DO NLCF = 1, NFAC
  218. C
  219. C******* NLCF = numero local du centre de facel
  220. C NGCF = numero global du centre de facel
  221. C NLCF1 = numero local du centre de face
  222. C NGCEG = numero global du centre ELT "gauche"
  223. C NLCEG = numero local du centre ELT "gauche"
  224. C NGCED = numero global du centre ELT "droite"
  225. C NLCED = numero local du centre ELT "droite"
  226. C
  227. NGCEG = IPT2.NUM(1,NLCF)
  228. NGCED = IPT2.NUM(3,NLCF)
  229. NGCF = IPT2.NUM(2,NLCF)
  230. NLCF1 = MLENT2.LECT(NGCF)
  231. NLCEG = MLENT1.LECT(NGCEG)
  232. NLCED = MLENT1.LECT(NGCED)
  233. C
  234. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  235. C
  236. IF(NLCF .NE. NLCF1)THEN
  237. MESERR = 'Il ne faut pas jouer avec la console. '
  238. LOGAN = .TRUE.
  239. GOTO 9999
  240. ENDIF
  241. C
  242. C******* Calcul du flux/DT
  243. C
  244. UX=MPOVIT.VPOCHA(NLCF,1)
  245. UY=MPOVIT.VPOCHA(NLCF,2)
  246. CNX=MPNORM.VPOCHA(NLCF,1)
  247. CNY=MPNORM.VPOCHA(NLCF,2)
  248. UN= (UX*CNX) + (UY*CNY)
  249. IF(IDIM .EQ.3)THEN
  250. UZ=MPOVIT.VPOCHA(NLCF,3)
  251. CNZ=MPNORM.VPOCHA(NLCF,3)
  252. UN=UN+(UZ*CNZ)
  253. ENDIF
  254. C
  255. IF(INDMET .EQ. 1)THEN
  256. IF(UN.GT.0.0D0)THEN
  257. DO ISCA=1,NSCA,1
  258. MELVAL=MCHAM1.IELVAL(ISCA)
  259. IFLUX.FLUX(ISCA)=UN*MELVAL.VELCHE(1,NLCF)
  260. DIAM = MPOVDI.VPOCHA(NLCEG,1)
  261. ENDDO
  262. ELSE
  263. DO ISCA=1,NSCA,1
  264. MELVAL=MCHAM1.IELVAL(ISCA)
  265. IFLUX.FLUX(ISCA)=UN*MELVAL.VELCHE(3,NLCF)
  266. DIAM = MPOVDI.VPOCHA(NLCED,1)
  267. ENDDO
  268. ENDIF
  269. ELSEIF(INDMET .EQ. 2)THEN
  270. DO ISCA=1,NSCA,1
  271. MELVAL=MCHAM1.IELVAL(ISCA)
  272. IFLUX.FLUX(ISCA)=UN*(MELVAL.VELCHE(1,NLCF)+MELVAL
  273. $ .VELCHE(3,NLCF))*0.5D0
  274. DIAM = MIN(MPOVDI.VPOCHA(NLCED,1),MPOVDI.VPOCHA(NLCEG,1))
  275. ENDDO
  276. ENDIF
  277. C
  278. C******* Ecriture des flux
  279. C
  280. SURF = MPOVSU.VPOCHA(NLCF,1)
  281. DO ISCA=1,NSCA,1
  282. MPOFLU.VPOCHA(NLCF,ISCA) =
  283. & (IFLUX.FLUX(ISCA) * SURF )
  284. ENDDO
  285. C
  286. C******* Calcul du pas du temps (CFL)
  287. C
  288. CELL = ABS(UN)/DIAM
  289. IF(CELL .GT. UNSDT)THEN
  290. UNSDT = CELL
  291. ENDIF
  292. C
  293. C**** Fin boucle sur FACEL
  294. C
  295. ENDDO
  296. C
  297. C**** Pas du temps (condition de non interaction en 1D)
  298. C
  299. DT = 0.5D0 / UNSDT
  300. C
  301. C**** Desactivation des segments et
  302. C on detruit les MCHAMLs
  303. C
  304. SEGSUP MLENT1
  305. SEGSUP MLENT2
  306. SEGDES IPT2
  307. C
  308. SEGSUP IFLUX
  309. C
  310. SEGDES MPOVSU
  311. SEGDES MPOVDI
  312. SEGDES MPNORM
  313. C
  314. SEGDES MPOFLU
  315. C
  316. DO ISCA=1,NSCA,1
  317. MELVAL=MCHAM1.IELVAL(ISCA)
  318. SEGDES MELVAL
  319. ENDDO
  320. SEGDES MCHAM1
  321. C
  322. 9999 CONTINUE
  323. C
  324. RETURN
  325. END
  326. C
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  

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