Télécharger trajec.eso

Retour à la liste

Numérotation des lignes :

trajec
  1. C TRAJEC SOURCE CB215821 20/11/25 13:41:17 10792
  2. SUBROUTINE TRAJEC
  3. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C
  5. C CE SOUS PROGRAMME GERE L'OPERATEUR TRAJ DE CALCUL DE TRAJECTOIRES
  6. C ( cf Rapport DMT/94/707)
  7. C
  8. C Appelé par PILOT
  9. C lit les données CHPOIN des vitesses ou des flux
  10. C ou tables transitoires
  11. C MODELE ou TABLE domaine
  12. C TABLE de lacher
  13. C appelle : TRJCN1 et TRJCN3 qui controlent les données
  14. C : TRJFLU et TRJVIT qui preparent les données relatives
  15. C au flux ou à la vitesse.
  16. C : TRJPAR qui décode la table de lacher et
  17. C pilote le calcul
  18. C
  19. C Auteur : F Auriol
  20. C
  21. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  22.  
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8 (A-H,O-Z)
  25.  
  26. -INC SMTABLE
  27. -INC SMELEME
  28. -INC SMCHPOI
  29. -INC SMLREEL
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCHAML
  33. -INC SMMODEL
  34.  
  35. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  36. POINTEUR IZLAC.MELEME,IELTFA.MELEME,IZCENT.MELEME,IFACEL.MELEME
  37. POINTEUR IZFACE.MELEME
  38. POINTEUR MTABTR.MTABLE
  39. CHARACTER*20 MOCAL(3)
  40. SEGMENT IZVIT
  41. REAL*8 TEMTRA(NVIPT)
  42. INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
  43. ENDSEGMENT
  44. C IDUN(I) nombre d elements avant le sous maillage I
  45. C IPVPT pointeurs de izvpt pour chaque pas de temps
  46. SEGMENT IZVPT
  47. INTEGER IPUN1(NBS),IPUMAX
  48. ENDSEGMENT
  49. SEGMENT IZUN
  50. REAL*8 UN(I1,I2,I3)
  51. ENDSEGMENT
  52. POINTEUR IZUN1.IZUN ,IZUN2.IZUN
  53. SEGMENT IZUMAX
  54. REAL*8 UMAX(NBREL)
  55. ENDSEGMENT
  56. DATA MOCAL/'CONVECTION_EXPLICITE','CONVECTION_ANALYTIQU',
  57. * 'CONVECTION_DIFFUSION'/
  58. C
  59. IRETOU=0
  60.  
  61. C LECTURE DU TYPE DE CALCUL
  62. IRAN=0
  63. CALL LIRMOT(MOCAL,3,IRAN,0)
  64. IICAL=IRAN
  65. IF(IRAN.EQ.0)IICAL=1
  66.  
  67. C LA VITESSE
  68. CALL LIROBJ('CHPOINT',MCHPOI,0,IRETOU)
  69. IF(IRETOU.NE.0)THEN
  70. IPTVIT=MCHPOI
  71. ITR=1
  72. SEGACT MCHPOI
  73. NSOUPO=IPCHP(/1)
  74. IF(NSOUPO.NE.1)THEN
  75. CALL ERREUR(21)
  76. RETURN
  77. ENDIF
  78. MSOUPO=IPCHP(1)
  79. SEGACT MSOUPO
  80. C ON VA TESTER LE NOM DES COMPOSANTES POUR DETERMINER
  81. C LA FORMULATION : ELEM FINIS OU MIXTE HYBRIDES
  82. IF(IIMPI.GT.0) WRITE(IOIMP,*)NOCOMP(1)
  83. IF(NOCOMP(1).EQ.'FLUX')THEN
  84. IFORMU=2
  85. IF(IIMPI.GT.0)WRITE(IOIMP,*)' FORMULATION HYBRIDE '
  86. ELSEIF(NOCOMP(1).EQ.'VX ' )THEN
  87. IFORMU=1
  88. IF(IIMPI.GT.0)
  89. * WRITE(IOIMP,*)' FORMULATION ELEMENTS FINIS ',NOCOMP(2)
  90. IF(NOCOMP(2).NE.'VY ')THEN
  91. MOTERR=NOCOMP(2)
  92. CALL ERREUR(197)
  93. RETURN
  94. ENDIF
  95. ELSE
  96. MOTERR=NOCOMP(1)
  97. CALL ERREUR(197)
  98. RETURN
  99. ENDIF
  100. ELSE
  101. CALL LIRTAB('DARCY_TRANSITOIRE',MTABTR,0,IRETOU)
  102. IF (IRETOU.NE.0)THEN
  103. ITR=3
  104. IFORMU=2
  105. IPTVIT=MTABTR
  106. ELSE
  107. CALL LIRTAB('TRANSITOIRE',MTABTR,1,IRETOU)
  108. IF (IRETOU.EQ.0)RETURN
  109. ITR=3
  110. IFORMU=1
  111. IPTVIT=MTABTR
  112. ENDIF
  113. ENDIF
  114.  
  115. C MODELE OU TABLE DOMAINE
  116. C LE TYPE DU MODELE EST TESTE DANS LEKMOD
  117. IRETOU=0
  118. MTAB1=0
  119. MCHELM=0
  120. CALL LIROBJ('MMODEL',IPMODE,0,IRET)
  121. IF(IRET.NE.0)THEN
  122. CALL LEKMOD(IPMODE,MTAB1,INEFMD)
  123. ELSE
  124. CALL LIRTAB('DOMAINE',MTAB1,1,IRETOU)
  125. IF(IRETOU.EQ.0)THEN
  126. MOTERR(1:40)=' '
  127. MOTERR(1:8)='MODELE '
  128. MOTERR(9:16) =' TABLE'
  129. MOTERR(17:24)='_DOMAINE'
  130. CALL ERREUR(471)
  131. RETURN
  132. ENDIF
  133. ENDIF
  134.  
  135. C LECTURE DES MCHAML
  136. IZPOR=0
  137. IZDIFF=0
  138. IZDISP=0
  139. 20 CONTINUE
  140. CALL LIRCHA(CHARI(1:4),0,IRET)
  141. IF(IRET.NE.0)THEN
  142. IF(CHARI(1:4).EQ.'PORO')THEN
  143. CALL LIROBJ('MCHAML ',IRET1,1,IRET2)
  144. IF(IRET2.EQ.0)THEN
  145. MOTERR(1:8)='PORO '
  146. MOTERR(9:16)='MCHAML '
  147. CALL ERREUR(929)
  148. RETURN
  149. ENDIF
  150. IZPOR=IRET1
  151. GO TO 20
  152. ELSEIF(CHARI(1:4).EQ.'DISP')THEN
  153. CALL LIROBJ('MCHAML ',IRET1,1,IRET2)
  154. IF(IRET2.EQ.0)THEN
  155. MOTERR(1:8)='DISP '
  156. MOTERR(9:16)='MCHAML '
  157. CALL ERREUR(929)
  158. RETURN
  159. ENDIF
  160. IZDISP=IRET1
  161. IICAL=3
  162. GO TO 20
  163. ELSEIF(CHARI(1:4).EQ.'DIFF')THEN
  164. CALL LIROBJ('MCHAML ',IRET1,1,IRET2)
  165. IF(IRET2.EQ.0)THEN
  166. MOTERR(1:8)='DIFF '
  167. MOTERR(9:16)='MCHAML '
  168. CALL ERREUR(929)
  169. RETURN
  170. ENDIF
  171. IZDIFF=IRET1
  172. IICAL=3
  173. GO TO 20
  174. ENDIF
  175. ENDIF
  176.  
  177. C LE MAILLAGE
  178. SEGACT MTAB1
  179. IRETR=0
  180. CHARI='MAILLAGE'
  181. CALL LEKTAB(MTAB1,CHARI,IRETR)
  182. MELEME=IRETR
  183.  
  184. CALL TRJCN1(MELEME)
  185. IF(IERR.NE.0)RETURN
  186. SEGACT MELEME
  187. C ON RECUPERE LE MAILLAGE DES POINTS CENTRES
  188. IRETR=0
  189. CALL LEKTAB(MTAB1,'CENTRE',IRETR)
  190. IZCENT=IRETR
  191. C ON RECUPERE LE MAILLAGE DES FACES PAR ELEMENTS
  192. IRETR=0
  193. CALL LEKTAB(MTAB1,'ELTFA',IRETR)
  194. IELTFA=IRETR
  195. C ON RECUPERE LE LAISONS FACES CENTRES
  196. IRETR=0
  197. CALL LEKTAB(MTAB1,'FACEL',IRETR)
  198. IFACEL=IRETR
  199. C controle de la coherence vitesse maillage
  200. MCHPO1=MCHPOI
  201. IF(IFORMU.EQ.1)THEN
  202. NCC=IDIM
  203. IF(ITR.NE.3)THEN
  204. CALL TRJCN3(MCHPO1,MELEME,NCC)
  205. ELSE
  206. IVALI=1
  207. XVALI=0.D0
  208. IRETI=0
  209. IVALR=0
  210. XVALR=0.D0
  211. MTYPI='MOT'
  212. CHARR=' '
  213. MTYPR='TABLE'
  214. CALL ACCTAB(IPTVIT,MTYPI,IVALI,XVALI,'VITESSE',.TRUE.,
  215. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  216. MTABFT=IRETR
  217. CALL TRJCN6(MTABFT,MELEME,NCC)
  218. ENDIF
  219. IF(IERR.NE.0)RETURN
  220. CALL TRJVIT(IPTVIT,ITR,MELEME,IZVIT)
  221. IF(IERR.NE.0)RETURN
  222. ELSEIF(IFORMU.EQ.2)THEN
  223. C ON RECUPERE LE MAILLAGE FACES
  224. IVALI=0
  225. XVALI=0.D0
  226. IRETI=0
  227. IVALR=0
  228. XVALR=0.D0
  229. IRETR=0
  230. MTYPI='MOT '
  231. MTYPR='MAILLAGE'
  232. CHARR='MAILLAGE'
  233. CALL LEKTAB(MTAB1,'FACE',IRETR)
  234. IZFACE=IRETR
  235. NCC=1
  236. SEGACT IZFACE
  237. IF(ITR.NE.3)THEN
  238. CALL TRJCN3(MCHPO1,IZFACE,NCC)
  239. ELSE
  240. IVALI=1
  241. XVALI=0.D0
  242. IRETI=0
  243. IVALR=0
  244. XVALR=0.D0
  245. MTYPI='MOT'
  246. CHARR=' '
  247. MTYPR='TABLE'
  248. CALL ACCTAB(IPTVIT,MTYPI,IVALI,XVALI,'FLUX',.TRUE.,
  249. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  250. MTABFT=IRETR
  251. CALL TRJCN6(MTABFT,IZFACE,NCC)
  252. ENDIF
  253. SEGDES IZFACE
  254. IF(IERR.NE.0)RETURN
  255. CALL LEKTAB(MTAB1,'XXNORMAE',MCHELM)
  256. IF(IERR.NE.0)RETURN
  257. CALL TRJFLU(IPTVIT,ITR,MCHELM,IELTFA,MELEME,IZVIT)
  258. IF(IERR.NE.0)RETURN
  259. ENDIF
  260.  
  261. C LA TABLE DE LACHER
  262. CALL LIROBJ('TABLE',MTAB2,1,IRETOU)
  263. IF(IRETOU.EQ.0)RETURN
  264.  
  265. C ON CREE LA PILE RESULTAT
  266. CALL CRTABL(MTAB3)
  267. C
  268. IERR=0
  269. CALL TRJPAR(MELEME,IZVIT,IZCENT,IELTFA,IFACEL,MTAB2,IICAL,IZPOR,
  270. * IZDIFF,IZDISP,MCHEL1,MMODE1 )
  271. IF(IERR.NE.0)RETURN
  272.  
  273. SEGDES IZCENT,IFACEL
  274. NBS=IELTFA.LISOUS(/1)
  275. IF(NBS.NE.0)THEN
  276. DO 81 I=1,NBS
  277. IPT1=IELTFA.LISOUS(I)
  278. SEGDES IPT1
  279. 81 CONTINUE
  280. ENDIF
  281. SEGDES IELTFA
  282. NBS=LISOUS(/1)
  283. IF(NBS.NE.0)THEN
  284. DO 83 I=1,NBS
  285. IPT1=LISOUS(I)
  286. SEGDES IPT1
  287. 83 CONTINUE
  288. ENDIF
  289. SEGDES MELEME
  290. SEGDES MTAB2
  291. SEGDES MTAB1
  292. IF(IERR.NE.0)RETURN
  293. SEGACT IZVIT
  294. NBS=IPUN(/1)
  295. DO 80 I=1,NBS
  296. IZUN=IPUN(I)
  297. SEGSUP IZUN
  298. 80 CONTINUE
  299. NVIPT= IPVPT(/1)
  300. DO 85 J=1,NVIPT
  301. IZVPT=IPVPT(J)
  302. SEGACT IZVPT
  303. DO 82 I=1,NBS
  304. IZUN1=IPUN1(I)
  305. IF(IZUN1.NE.0)SEGSUP IZUN1
  306. 82 CONTINUE
  307. IZUMAX=IPUMAX
  308. SEGSUP IZUMAX
  309. SEGSUP IZVPT
  310. 85 CONTINUE
  311. SEGSUP IZVIT
  312.  
  313. C ON SAUVEGARDE LES RESULTATS
  314. CALL ECROBJ('MCHAML ',MCHEL1)
  315. CALL ECROBJ('MMODEL ',MMODE1)
  316. SEGDES MCHEL1,MMODE1
  317.  
  318. RETURN
  319. END
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  

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