Télécharger ytscal.eso

Retour à la liste

Numérotation des lignes :

ytscal
  1. C YTSCAL SOURCE FANDEUR 22/01/03 21:16:00 11136
  2. SUBROUTINE YTSCAL
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C CET OPERATEUR DISCRETISE UNE EQUATION DE TRANSPORT
  8. C EN 2D SUR LES ELEMENTS QUA4 ET TRI3 PLAN OU AXI
  9. C EN 3D SUR LES ELEMENTS CUB8 ET PRI6
  10. C LES OPERATEURS SONT "SOUS-INTEGRES"
  11. C
  12. C SYNTAXE :
  13. C ---------
  14. C 1/ Cas incompréssible
  15. C
  16. C de/dt + u Grad e = alpha Lapl e < + S >
  17. C
  18. C 'OPER' 'TSCAL' al 'UN' s 'INCO' EN :
  19. C 'OPER' 'TSCAL' al 'UN' s alt sgt 'INCO' EN :
  20. C
  21. C 2/ Cas compréssible
  22. C
  23. C dh/dt + u Grad h + h Div u = alpha Lapl(tn) < + S >
  24. C
  25. C 'OPER' 'TSCAL' lb 'UN' s tn 'INCO' HN :
  26. C 'OPER' 'TSCAL' lb 'UN' s tn lbt sgt 'INCO' HN :
  27. C
  28. C
  29. C al,alt Diffusivité thermique moléculaire ou turbulente
  30. C FLOTTANT où CHPOINT SCAL CENTRE
  31. C lb,lbt Conductivité thermiquemoléculaire ou turbulente
  32. C FLOTTANT où CHPOINT SCAL CENTRE
  33. C sgt Prandtl turbulent
  34. C s source volumique
  35. C POINT où CHPOINT SCAL CENTRE
  36. C
  37. C un Champ de vitesse transportant
  38. C CHPOINT VECT SOMMET
  39. C tn Champ de température
  40. C CHPOINT SCAL SOMMET
  41. C
  42. C***********************************************************************
  43.  
  44. -INC CCVQUA4
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC CCGEOME
  49. -INC SIZFFB
  50. POINTEUR IZF1.IZFFM,IZH2.IZHR
  51. PARAMETER (LRV=64)
  52. SEGMENT PETROV
  53. REAL*8 WT(LRV,NP,NPG,KDIM),WS(LRV,NP,NPG,KDIM),HK(LRV,IDIM,NP,NPG)
  54. REAL*8 UIL(LRV,IDIM,NPG),DUIL(LRV,IDIM,NPG)
  55. REAL*8 PGSK(LRV,NPG),RPGK(LRV,NPG),AIRE(LRV),ANUK(LRV),COEFK(LRV)
  56. REAL*8 AJK(LRV,IDIM,IDIM,NPG)
  57. ENDSEGMENT
  58.  
  59. -INC SMCHAML
  60. -INC SMCOORD
  61. -INC SMLENTI
  62. POINTEUR IPADI.MLENTI,IPADS.MLENTI
  63. POINTEUR IPADD.MLENTI,IPADQ.MLENTI
  64. -INC SMELEME
  65. POINTEUR MELEMC.MELEME,MELEMS.MELEME
  66. POINTEUR MELEMQ.MELEME,MELEMK.MELEME
  67. POINTEUR MELEMI.MELEME,MELEP1.MELEME
  68. -INC SMCHPOI
  69. POINTEUR MCHPIN.MCHPOI
  70. POINTEUR IZGG1.MPOVAL
  71. POINTEUR IZTU1.MPOVAL
  72. POINTEUR VISCO.MPOVAL
  73. POINTEUR IZTGG3.MPOVAL,IZTGG4.MPOVAL
  74. POINTEUR MZALT.MPOVAL,MZST.MPOVAL
  75. POINTEUR IZVOL.MPOVAL,IZTCO.MPOVAL
  76. POINTEUR VITESS.MPOVAL,UTRANS.MPOVAL
  77. POINTEUR IPM.IZAFM
  78. SEGMENT IMATRS
  79. INTEGER LIZAFS(NBSOUS,NBME)
  80. ENDSEGMENT
  81. POINTEUR IPMS.IZAFM,IPS1.IZAFM,IPS2.IZAFM,IPS3.IZAFM
  82. -INC SMLMOTS
  83. POINTEUR LINCO.MLMOTS
  84. CHARACTER*8 NOMZ,NOMI,NOM0,TYPE,TYPC,NOM,NOMA,MTYP,CHAI
  85. CHARACTER*4 NOM4(3)
  86. PARAMETER (NTB=1)
  87. CHARACTER*8 LTAB(NTB)
  88. DIMENSION KTAB(NTB),IXV(3),RO(1)
  89. SAVE IPAS
  90. DATA LTAB/'KIZX '/,IPAS/0/
  91. C*****************************************************************************
  92. CTSCAL
  93. C write(6,*)' Debut TSCAL'
  94.  
  95. segact mcoord
  96.  
  97. C Nouvelle directive EQUA de EQEX
  98. MTYP=' '
  99. ro(1)=1.d0
  100. CALL QUETYP(MTYP,0,IRET)
  101. IF(IRET.EQ.0)THEN
  102. C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40
  103. MOTERR( 1: 8) = 'CHAI '
  104. MOTERR( 9:16) = 'MMODEL '
  105. MOTERR(17:24) = 'TABLE '
  106. CALL ERREUR(472)
  107. RETURN
  108. ENDIF
  109.  
  110. IF(MTYP.EQ.'MMODEL')THEN
  111. CALL YTCLSF('TCLS ','TSCA ')
  112. RETURN
  113. ELSEIF(MTYP.EQ.'MOT ')THEN
  114. CALL LIRCHA(CHAI,1,IRET)
  115. CALL YTCLSF(CHAI,'TSCA ')
  116. RETURN
  117. ENDIF
  118. C Fin Nouvelle directive EQUA de EQEX
  119.  
  120. c CALL LITABS(LTAB,KTAB,NTB,1,IRET)
  121. c IF(IERR.NE.0) RETURN
  122. c MTABX=KTAB(1)
  123.  
  124. C
  125. C- Récupération de la table xNS type KIZX (pointeur MTABX)
  126. C
  127. C write(6,*)'Récupération de la table xOP type KIZX pointeur MTABX'
  128. CALL LIROBJ('TABLE',MTABX,1,IRET)
  129. IF(IRET.EQ.0)THEN
  130. C% On ne trouve pas d'objet de type %m1:8
  131. MOTERR( 1: 8) = 'TABLE'
  132. CALL ERREUR(37)
  133. RETURN
  134. ENDIF
  135. C A tout hazard on regarde si une table ne peut en cacher une autre
  136. C write(6,*)' A tout hazard on regarde si une table ne peut en',
  137. C &' cacher une autre !!!!!'
  138.  
  139. MTYP='TABLE'
  140. CALL QUETYP(MTYP,0,IRET)
  141. IF(IRET.EQ.1)THEN
  142. CALL LIROBJ('TABLE',MTABX,1,IRET)
  143. IF(IRET.EQ.0)THEN
  144. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  145. MOTERR( 1: 8) = ' MTABX '
  146. MOTERR( 9:16) = ' MTABX '
  147. MOTERR(17:24) = ' KIZX '
  148. CALL ERREUR(786)
  149. RETURN
  150. ENDIF
  151. C write(6,*)' EH BEN C EST LE CAS une KIZX // !!!!!!!!!!'
  152. cc call pplist(MTABX)
  153. TYPE=' '
  154. CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ)
  155. CALL LEKMOD(MMDZ,MTABZ,INEFMD)
  156. TYPE='TABLE'
  157. CALL ECMO(MTABX,'TDOMZ',TYPE,MTABZ)
  158. ELSE
  159. TYPE=' '
  160. CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ)
  161. IF(TYPE.EQ.'MMODEL')THEN
  162. c call pplist(mtabx)
  163. CALL LEKMOD(MMDZ,MTABZ,INEFMD)
  164. ENDIF
  165. ENDIF
  166.  
  167. C.......................................................................
  168. C
  169. C- Récupération de la table RV type EQEX (pointeur MTAB1)
  170. C
  171. CALL LEKTAB(MTABX,'EQEX',MTAB1)
  172. IF(MTAB1.EQ.0)THEN
  173. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  174. MOTERR( 1: 8) = ' EQEX '
  175. MOTERR( 9:16) = ' EQEX '
  176. MOTERR(17:24) = ' KIZX '
  177. CALL ERREUR(786)
  178. RETURN
  179. ENDIF
  180. CALL ACME(MTAB1,'NAVISTOK',NASTOK)
  181. IF(NASTOK.EQ.0)THEN
  182. CALL ZTSCAL(MTABX,MTAB1)
  183. RETURN
  184. ENDIF
  185. C
  186. C- Récupération de la table INCO (pointeur KINC)
  187. C
  188. CALL LEKTAB(MTAB1,'INCO',KINC)
  189. IF(KINC.EQ.0)THEN
  190. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  191. MOTERR( 1: 8) = ' INCO '
  192. MOTERR( 9:16) = ' INCO '
  193. MOTERR(17:24) = ' EQEX '
  194. CALL ERREUR(786)
  195. RETURN
  196. ENDIF
  197. C.......................................................................
  198.  
  199. CALL ACMM(MTABX,'NOMZONE',NOMZ)
  200.  
  201. C On récupère le MODEL partitionné ou non
  202. TYPE=' '
  203. CALL ACMO(MTABX,'DOMZ',TYPE,MMDZ)
  204. IF(TYPE.NE.'MMODEL')THEN
  205. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  206. MOTERR( 1: 8) = ' DOMZ '
  207. MOTERR( 9:16) = ' DOMZ '
  208. MOTERR(17:24) = ' KIZX '
  209. CALL ERREUR(786)
  210. RETURN
  211. ENDIF
  212.  
  213. C*****************************************************************************
  214. C OPTIONS
  215. C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI
  216. C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC
  217. C IDCEN = 0-> rien 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG
  218.  
  219. IAXI=0
  220. IF(IFOMOD.EQ.0)IAXI=2
  221. C
  222. C- Récupération de la table des options KOPT (pointeur KOPTI)
  223. C
  224. CALL LEKTAB(MTABX,'KOPT',KOPTI)
  225. IF (KOPTI.EQ.0) THEN
  226. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  227. MOTERR( 1: 8) = ' KOPT '
  228. MOTERR( 9:16) = ' KOPT '
  229. MOTERR(17:24) = ' KIZX '
  230. CALL ERREUR(786)
  231. RETURN
  232. ENDIF
  233.  
  234.  
  235. CALL ACME(KOPTI,'MTRMASS ',MMPG)
  236. IPG=0
  237. IF(MMPG.EQ.3)IPG=1
  238. KDIM=1
  239. CALL ACME(KOPTI,'IDCEN',IDCEN)
  240. IF(IDCEN.EQ.2)KDIM=IDIM
  241. CALL ACME(KOPTI,'IKOMP',IKOMP)
  242. CALL ACME(KOPTI,'KIMPL',KIMPL)
  243. CALL ACME(KOPTI,'IDIV',IDIV)
  244. CALL ACMF(KOPTI,'CMD',CMD)
  245. CALL ACMF(KOPTI,'AIMPL',AIMPL)
  246. AG=AIMPL
  247. AD=AIMPL-1.D0
  248. CALL ACME(KOPTI,'KFORM',KFORM)
  249. CALL ACME(KOPTI,'KPOIN',KPRE)
  250. CALL ACME(KOPTI,'KMACO',KMACO)
  251. IF (IERR.NE.0) RETURN
  252.  
  253. C*****************************************************************************
  254. C
  255. C- Récupération de la table DOMAINE associée au domaine local
  256. C
  257.  
  258. C E/ MMODEL : Pointeur de la table contenant l'information cherchée
  259. C /S IPOINT : Pointeur sur la table DOMAINE
  260. C /S INEFMD : Type formulation INEFMD=1 LINE,=2 MACRO,=3 QUADRATIQUE
  261. C INEFMD=4 LINB
  262.  
  263. c?? CALL LEKMOD(MMDZ,MTABZ,INEFMD)
  264.  
  265. CALL LEKTAB(MTABZ,'MAILLAGE',MELEME)
  266. CALL LEKTAB(MTABZ,'SOMMET',MELEMS)
  267. CALL LEKTAB(MTABZ,'CENTRE',MELEMC)
  268. CALL LEKTAB(MTABZ,'MACRO',MACRO)
  269. CALL LEKTAB(MTABZ,'MACRO1',MELEMK)
  270. CALL LEKTAB(MTABZ,'QUADRATI',MQUAD)
  271. IF (IERR.NE.0) RETURN
  272.  
  273. MELEMQ=MELEMC
  274. MELEP1=MELEMC
  275. IF(KPRE.EQ.3)THEN
  276. CALL LEKTAB(MTABZ,'CENTREP0',MELEMQ)
  277. MELEP1=MELEMQ
  278. ELSEIF(KPRE.EQ.4)THEN
  279. CALL LEKTAB(MTABZ,'CENTREP1',MELEMQ)
  280. CALL LEKTAB(MTABZ,'ELTP1NC ',MELEP1)
  281. ENDIF
  282.  
  283. IF (IERR.NE.0) RETURN
  284. C***
  285.  
  286.  
  287. C*************************************************************************
  288. C VERIFICATIONS SUR LES INCONNUES
  289. C
  290. C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI
  291. C
  292. TYPE='LISTMOTS'
  293. CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO)
  294. IF (IERR.NE.0) RETURN
  295. SEGACT LINCO
  296. NBINC=LINCO.MOTS(/2)
  297. IF(NBINC.NE.1)THEN
  298. C Indice %m1:8 : contient plus de %i1 %m9:16
  299. MOTERR( 1:8) = 'LISTINCO'
  300. INTERR(1) = 1
  301. MOTERR(9:16) = ' MOTS '
  302. CALL ERREUR(799)
  303. RETURN
  304. ENDIF
  305.  
  306. NOMI=LINCO.MOTS(1)
  307. NOMA=NOMI
  308. WRITE(NOM4(1),FMT='(A4)')NOMI(1:4)
  309. C
  310. C- Récupération de l'inconnue
  311. C
  312. TYPE=' '
  313. CALL ACMO(KINC,NOMI,TYPE,MCHPOI)
  314. IF(TYPE.NE.'CHPOINT ')THEN
  315. C Indice %m1:8 : ne contient pas un objet de type %m9:16
  316. MOTERR( 1: 8) = 'INC '//NOMI
  317. MOTERR( 9:16) = 'CHPOINT '
  318. CALL ERREUR(800)
  319. RETURN
  320. ELSE
  321. CALL LICHTL(MCHPOI,IZTU1,TYPC,MELEMI)
  322. MCHPIN=MCHPOI
  323. NINKO = IZTU1.VPOCHA(/2)
  324. NPTI = IZTU1.VPOCHA(/1)
  325. IF (NINKO.NE.1) THEN
  326. C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes
  327. MOTERR( 1: 8) = 'INC '//NOMI
  328. MOTERR( 9:16) = 'CHPOINT '
  329. CALL ERREUR(784)
  330. RETURN
  331. ENDIF
  332. ENDIF
  333.  
  334. C*****************************************************************************
  335. C Le domaine de definition est donne par le SPG de la premiere inconnue
  336. C Les inconnues suivantes devront posseder ce meme pointeur
  337. C On verifie que les points de la zone sont tous inclus dans ce SPG
  338.  
  339. CALL KRIPAD(MELEMI,IPADI)
  340. IPADS=IPADI
  341. NPTS=NPTI
  342. IPADD=IPADI
  343. IF(MELEMI.NE.MELEMS)THEN
  344. CALL KRIPAD(MELEMS,IPADS)
  345. NPTS=MELEMS.NUM(/2)
  346. ENDIF
  347.  
  348. IF(IPAS.EQ.0)THEN
  349. CALL VERPAD(IPADI,MELEME,IRET)
  350. IF(IRET.NE.0)THEN
  351. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  352. MOTERR(1: 8) = 'INC '//NOMI
  353. MOTERR(9:16) = 'CHPOINT '
  354. CALL ERREUR(788)
  355. RETURN
  356. ENDIF
  357. ENDIF
  358.  
  359. C*****************************************************************************
  360. IF(KFORM.EQ.1)THEN
  361. IHV=0
  362.  
  363. CMT=CMD
  364. DT=0.D0
  365. IF(IDCEN.EQ.4.OR.IDCEN.EQ.5)THEN
  366. C IDCEN 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG
  367. TYPE=' '
  368. CALL ACMO(MTABT,'DELTAT',TYPE,IENT)
  369. IF(TYPE.NE.'ENTIER')THEN
  370. WRITE(6,*)' Opérateur TSCA'
  371. WRITE(6,*)' On reclame un pas de temps'
  372. C Option %m1:8 incompatible avec les données
  373. MOTERR( 1: 8) = ' EF '
  374. CALL ERREUR(803)
  375. RETURN
  376. ELSE
  377. CALL ACMF(MTABT,'DELTAT',DT)
  378. CMT=DT
  379. ENDIF
  380. ENDIF
  381.  
  382. CALL YCLS('TSCA ',MTABX,MTABZ,IHV,MCHPIN,NOMI,MATRIK,MCHPO1)
  383.  
  384. CALL ECROBJ('MATRIK',MATRIK)
  385. CALL ECROBJ('CHPOINT',MCHPO1)
  386.  
  387. RETURN
  388. ENDIF
  389.  
  390. C*****************************************************************************
  391. C Lecture des coefficient
  392. C Type du coefficient :
  393. C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur
  394.  
  395. C write(6,*)' Opérateur TSCAL lecture des coefficients'
  396. CALL ACME(MTABX,'IARG',IARG)
  397. IF(IKOMP.EQ.0)THEN
  398. IF(IARG.NE.3.AND.IARG.NE.4.AND.IARG.NE.5)THEN
  399. WRITE(6,*)' Opérateur TSCAL : option non conservative '
  400. WRITE(6,*)' Nombre d''arguments incorrect : ',IARG
  401. WRITE(6,*)' On attend 3 , 4 ou 5 '
  402. C Indice %m1:8 : nombre d'arguments incorrect
  403. MOTERR(1:8) = 'IARG '
  404. CALL ERREUR(804)
  405. RETURN
  406. ENDIF
  407. ELSEIF(IKOMP.EQ.1.AND.KFORM.NE.1)THEN
  408. IF(IARG.NE.4.AND.IARG.NE.6)THEN
  409. WRITE(6,*)' Opérateur TSCAL : option compréssible '
  410. WRITE(6,*)' Nombre d''arguments incorrect : ',IARG
  411. WRITE(6,*)' On attend 4 ou 6 '
  412. C Indice %m1:8 : nombre d'arguments incorrect
  413. MOTERR(1:8) = 'IARG '
  414. CALL ERREUR(804)
  415. RETURN
  416. ENDIF
  417. ENDIF
  418.  
  419.  
  420. C--Cas incompressible
  421. IF(IKOMP.EQ.0.OR.IKOMP.EQ.2)THEN
  422. C 1er coefficient Alpha
  423. IXV(1)=MELEMC
  424. IXV(2)=1
  425. IXV(3)=0
  426. CALL LEKCOF('Opérateur TSCAL :',
  427. & MTABX,KINC,1,IXV,MCOF,VISCO,NPT1,NC1,IKL,IRET)
  428. IF(IRET.EQ.0)RETURN
  429.  
  430. IK2=-1
  431. IKG=-1
  432. IK3=-1
  433. IK4=-1
  434. IZTGG4=IZTU1
  435. MZALT=VISCO
  436. MZST=VISCO
  437.  
  438. C 2ème coefficient UN
  439. IXV(1)=-MELEMS
  440. IXV(2)=0
  441. IXV(3)=1
  442. CALL LEKCOF('Opérateur TSCAL :',
  443. & MTABX,KINC,2,IXV,MUTR,UTRANS,NPTU,NC2,IKU,IRET)
  444. IF(IRET.EQ.0)RETURN
  445. IF(IKU.EQ.2)IKU=1
  446.  
  447. C 3ème coefficient source
  448. IXV(1)=MELEMC
  449. IXV(2)=1
  450. IXV(3)=0
  451. CALL LEKCOF('Opérateur TSCAL :',
  452. & MTABX,KINC,3,IXV,IZTG3,IZTGG3,NPT3,NC3,IKS,IRET)
  453. IF(IRET.EQ.0)RETURN
  454.  
  455. IF(IARG.EQ.5)THEN
  456. C alpha turbulent
  457. IXV(1)=MELEMC
  458. IXV(2)=0
  459. IXV(3)=0
  460. CALL LEKCOF('Opérateur TSCAL :',
  461. & MTABX,KINC,4,IXV,MALT,MZALT,NPT4,NC4,IK4,IRET)
  462. IF(IRET.EQ.0)RETURN
  463.  
  464. C sigma turbulent
  465. IXV(1)=0
  466. IXV(2)=1
  467. IXV(3)=0
  468. CALL LEKCOF('Opérateur TSCAL :',
  469. & MTABX,KINC,5,IXV,MST,MZST,NPT5,NC5,IK5,IRET)
  470. IF(IRET.EQ.0)RETURN
  471. IF(MZST.VPOCHA(1,1).LE.0.D0)THEN
  472. WRITE(6,*)' Opérateur TSCAL :'
  473. WRITE(6,*)'Valeur du Prandtl turbulent érronée'
  474. RETURN
  475. ENDIF
  476. ENDIF
  477.  
  478. C--Cas compréssible
  479. ELSEIF(IKOMP.EQ.1)THEN
  480. C 1er coefficient Lambda
  481. IXV(1)=MELEMC
  482. IXV(2)=1
  483. IXV(3)=0
  484. CALL LEKCOF('Opérateur TSCAL :',
  485. & MTABX,KINC,1,IXV,MCOF,VISCO,NPT1,NC1,IKL,IRET)
  486. IF(IRET.EQ.0)RETURN
  487.  
  488. IK2=-1
  489. IKG=-1
  490. IK3=-1
  491. IK4=-1
  492. MZALT=VISCO
  493. MZST=VISCO
  494.  
  495. C 2ème coefficient UN
  496. IXV(1)=-MELEMS
  497. IXV(2)=0
  498. IXV(3)=1
  499. CALL LEKCOF('Opérateur TSCAL :',
  500. & MTABX,KINC,2,IXV,MUTR,UTRANS,NPTU,NC2,IKU,IRET)
  501. IF(IRET.EQ.0)RETURN
  502. IF(IKU.EQ.2)IKU=1
  503.  
  504. C 3ème coefficient source
  505. IXV(1)=MELEMC
  506. IXV(2)=1
  507. IXV(3)=0
  508. CALL LEKCOF('Opérateur TSCAL :',
  509. & MTABX,KINC,3,IXV,IZTG3,IZTGG3,NPT3,NC3,IKS,IRET)
  510. IF(IRET.EQ.0)RETURN
  511.  
  512. C 4ème coefficient tn
  513. IXV(1)=MELEMS
  514. IXV(2)=0
  515. IXV(3)=0
  516. CALL LEKCOF('Opérateur TSCAL :',
  517. & MTABX,KINC,4,IXV,IZTG4,IZTGG4,NPT4,NC4,IK4,IRET)
  518. IPADD=IPADS
  519. IF(IRET.EQ.0)RETURN
  520.  
  521. IF(IARG.EQ.6)THEN
  522. C lambda turbulent
  523. IXV(1)=MELEMC
  524. IXV(2)=0
  525. IXV(3)=0
  526. CALL LEKCOF('Opérateur TSCAL :',
  527. & MTABX,KINC,5,IXV,MALT,MZALT,NPT5,NC5,IK5,IRET)
  528. IF(IRET.EQ.0)RETURN
  529.  
  530. C sigma turbulent
  531. IXV(1)=0
  532. IXV(2)=1
  533. IXV(3)=0
  534. CALL LEKCOF('Opérateur TSCAL :',
  535. & MTABX,KINC,6,IXV,MST,MZST,NPT6,NC6,IK6,IRET)
  536. IF(IRET.EQ.0)RETURN
  537. IF(MZST.VPOCHA(1,1).LE.0.D0)THEN
  538. call erreur(992)
  539. RETURN
  540. ENDIF
  541. ENDIF
  542.  
  543. ENDIF
  544.  
  545. C write(6,*)' Opérateur TSCAL : Fin lecture Arguments '
  546. C Fin lecture Arguments ************************************************
  547.  
  548. C*****************************************************************************
  549. C Lecture table 'PASDETPS'
  550. CALL LEKTAB(MTAB1,'PASDETPS',MTABT)
  551. IF(MTABT.EQ.0)THEN
  552. CALL CRTABL(MTABT)
  553. CALL ECMM(MTABT,'SOUSTYPE','PASDETPS')
  554. CALL ECMO(MTAB1,'PASDETPS','TABLE ',MTABT)
  555. DT=1.D30
  556. DTP=1.D30+DT
  557. IPAT=1
  558. CALL ECME(MTABT,'NUPASDT',IPAT)
  559. DTM1=1.D-20
  560. CALL ECMF(MTABT,'DELTAT-1',DTM1)
  561. ELSE
  562. CALL ACMF(MTABT,'DELTAT',DTP)
  563. CALL ACMF(MTABT,'DELTAT-1',DTM1)
  564. ENDIF
  565.  
  566.  
  567. C*********** FORMULATIONS **********
  568. C*********** FORMULATIONS **********
  569. C*********** FORMULATIONS **********
  570.  
  571.  
  572.  
  573. C************************** FORMULATION EFM1 ***************************
  574. IF(KFORM.EQ.0)THEN
  575. C Formulation EFM1
  576. C Vérification des options
  577.  
  578. IF(INEFMD.NE.1.AND.INEFMD.NE.2)THEN
  579. C Option %m1:8 incompatible avec les données
  580. MOTERR( 1: 8) = ' EFM1 '
  581. CALL ERREUR(803)
  582. RETURN
  583. ENDIF
  584.  
  585. IF(KIMPL.NE.0)THEN
  586. C Option %m1:8 incompatible avec les données
  587. MOTERR( 1: 8) = ' EFM1 '
  588. WRITE(6,*)' Options incompatibles : EFM1 et (IMPL ou SEMI) '
  589. CALL ERREUR(803)
  590. RETURN
  591. ENDIF
  592.  
  593. CALL LEKTAB(MTABZ,'XXPSOML',MCHELM)
  594. CALL LEKTAB(MTABZ,'XXDXDY',MCHPDX)
  595. CALL LEKTAB(MTABZ,'XXVOLUM',MCHPVO)
  596. IF (IERR.NE.0) RETURN
  597.  
  598. SEGACT MCHELM
  599. CALL LICHTL(MCHPDX,IZTCO,TYPC,IGEOM)
  600. NELZ=IZTCO.VPOCHA(/1)
  601. CALL LICHTL(MCHPVO,IZVOL,TYPC,IGEOM)
  602.  
  603. IF(IKOMP.EQ.1.AND.(IDCEN.EQ.6.OR.IDCEN.EQ.7))THEN
  604. C Option %m1:8 incompatible avec les données
  605. MOTERR( 1: 8) = ' EFM1 '
  606. WRITE(6,*)' Option de décentrement non prévue en',
  607. & ' formulation conservative '
  608. CALL ERREUR(803)
  609. RETURN
  610. ENDIF
  611.  
  612. IF(IDCEN.GE.4.AND.(IDCEN.NE.6.AND.IDCEN.NE.7))THEN
  613. C Option %m1:8 incompatible avec les données
  614. MOTERR( 1: 8) = ' EFM1 '
  615. WRITE(6,*)' Option de décentrement non prévue en',
  616. & ' formulation EFM1 '
  617. CALL ERREUR(803)
  618. RETURN
  619. ENDIF
  620.  
  621. IF(IDIM.EQ.3.AND.(IDCEN.EQ.6.OR.IDCEN.EQ.7))THEN
  622. C Option %m1:8 incompatible avec les données
  623. MOTERR( 1: 8) = ' EFM1 '
  624. WRITE(6,*)' Option de décentrement non prévue en 3D'
  625. CALL ERREUR(803)
  626. RETURN
  627. ENDIF
  628.  
  629. NC=IZTU1.VPOCHA(/2)
  630. TYPE='SOMMET'
  631. CALL KRCHPT(TYPE,MELEMS,NC,IZG1,NOM4)
  632.  
  633. CALL LICHTM(IZG1,IZGG1,TYPC,IGEOM)
  634.  
  635. NPTS=IZGG1.VPOCHA(/1)
  636.  
  637.  
  638. CALL LEKTAB(MTABZ,'MATESI',MATRIK)
  639. IF (IERR.NE.0) RETURN
  640. SEGACT MATRIK
  641.  
  642. IMATRI=IRIGEL(4,1)
  643. SEGACT IMATRI
  644. C---
  645.  
  646. SEGACT MELEME
  647. NBSOUS=LISOUS(/1)
  648. IF(NBSOUS.EQ.0)NBSOUS=1
  649. NUTOEL=0
  650. DT=1.E30
  651.  
  652. DO 1 L=1,NBSOUS
  653. IPT1=MELEME
  654. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  655. SEGACT IPT1
  656.  
  657. NOM0=NOMS(IPT1.ITYPEL)//' '
  658. CALL KALPBG(NOM0,'FONFORM0',IZFFM)
  659. SEGACT IZFFM*MOD
  660.  
  661. MCHAML=ICHAML(L)
  662. SEGACT MCHAML
  663. MELVAL=IELVAL(1)
  664. SEGACT MELVAL
  665.  
  666. IF(IMACHE(L).NE.IPT1)THEN
  667. write(*,*)'IPT1,IMACHE ',IPT1,IMACHE(L)
  668. goto 90
  669. ENDIF
  670.  
  671. IZAFM=LIZAFM(L,1)
  672. IPM1=IZAFM
  673. SEGACT IZAFM
  674. IF(IAXI.NE.0)THEN
  675. IPM1=LIZAFM(L,2)
  676. SEGACT IPM1
  677. ENDIF
  678.  
  679. NP =IPT1.NUM(/1)
  680. NBEL=IPT1.NUM(/2)
  681. IES=IDIM
  682.  
  683. NPTT=IZTGG4.VPOCHA(/1)
  684. NPTI=IZTGG4.VPOCHA(/1)
  685.  
  686. IF(IDCEN.GE.1.AND.IDCEN.LE.3)THEN
  687.  
  688. IF(IKOMP.EQ.0)THEN
  689.  
  690. CALL YCTSCL(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,IES,NP,
  691. & IAXI,IPADI.LECT,IPADS.LECT,IPADD.LECT,IKOMP,IARG,
  692. & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTS,IZTGG4.VPOCHA,NPTT,
  693. & IZTGG3.VPOCHA,IKS,
  694. & IZTU1.VPOCHA,IZGG1.VPOCHA,NPTI,
  695. & MZALT.VPOCHA,MZST.VPOCHA,
  696. & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,IDCEN,IPG,
  697. & DTM1,DT,DTT1,DTT2,NUEL,DIAEL,IZFFM.FN)
  698.  
  699. ELSEIF(IKOMP.EQ.1)THEN
  700.  
  701. CALL YCTSCA(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP,
  702. & IAXI,IPADI.LECT,IKOMP,IARG,IPADS.LECT,IPADD.LECT,
  703. & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTS,IZTGG4.VPOCHA,
  704. & IZTGG3.VPOCHA,IKS,IZTU1.VPOCHA,
  705. & IZGG1.VPOCHA,MZALT.VPOCHA,MZST.VPOCHA,
  706. & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,IDCEN,
  707. & DTM1,DT,DTT1,DTT2,NUEL,DIAEL)
  708.  
  709. ENDIF
  710.  
  711. ELSEIF(IDCEN.EQ.6)THEN
  712.  
  713.  
  714. N=NPTS
  715. NC=1
  716. SEGINI MPOVA6
  717.  
  718. CALL YPSI(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP,
  719. & IAXI,IPADI.LECT,IKOMP,IARG,
  720. & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTS,IPADS.LECT,
  721. & IZTGG4.VPOCHA,IZTGG3.VPOCHA,IKS,IZTU1.VPOCHA,
  722. & IZGG1.VPOCHA,MZALT.VPOCHA,MZST.VPOCHA,
  723. & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,MPOVA6.VPOCHA,
  724. & DTM1,DT,DTT1,DTT2,NUEL,DIAEL)
  725.  
  726. SEGSUP MPOVA6
  727.  
  728.  
  729.  
  730. ELSEIF(IDCEN.EQ.7)THEN
  731.  
  732. CALL YJOHNS(AM,IPM1.AM,VELCHE,IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP,
  733. & IAXI,IPADI.LECT,IKOMP,IARG,
  734. & VISCO.VPOCHA,IKL,UTRANS.VPOCHA,IKU,NPTS,IPADS.LECT,
  735. & IZTGG4.VPOCHA,IZTGG3.VPOCHA,IKS,IZTU1.VPOCHA,
  736. & IZGG1.VPOCHA,MZALT.VPOCHA,MZST.VPOCHA,
  737. & IZVOL.VPOCHA,IZTCO.VPOCHA,NELZ,
  738. & DTM1,DT,DTT1,DTT2,NUEL,DIAEL)
  739.  
  740. ENDIF
  741.  
  742.  
  743. SEGDES IZAFM*NOMOD,IPT1*NOMOD,MCHAML*NOMOD,MELVAL*NOMOD
  744. IF(IAXI.NE.0)SEGDES IPM1*NOMOD
  745. NUTOEL=NUTOEL+NBEL
  746.  
  747. 1 CONTINUE
  748. SEGDES MATRIK*NOMOD,MCHELM*NOMOD
  749. SEGDES IMATRI
  750.  
  751. IF(DT.LT.DTP)THEN
  752. CALL ECMF(MTABT,'DELTAT',DT)
  753. CALL ECMM(MTABT,'OPER','TSCAL')
  754. CALL ECMM(MTABT,'ZONE',NOMZ)
  755. CALL ECMF(MTABT,'DTCONV',DTT1)
  756. CALL ECMF(MTABT,'DTDIFU',DTT2)
  757. CALL ECMF(MTABT,'DIAEL',DIAEL)
  758. CALL ECME(MTABT,'NUEL',NUEL)
  759. ENDIF
  760. SEGDES VISCO,UTRANS
  761. IF(IKOMP.EQ.0.AND.IARG.EQ.3)SEGDES IZTGG3*NOMOD
  762. IF(IKOMP.EQ.1.AND.IARG.EQ.4)SEGDES IZTGG3*NOMOD,IZTGG4*NOMOD
  763. IF(IKOMP.EQ.1.AND.IARG.EQ.6)SEGDES IZTGG3*NOMOD,IZTGG4*NOMOD
  764. & ,MZALT*NOMOD,MZST*NOMOD
  765. SEGDES IZTU1
  766. SEGDES IZGG1
  767. SEGDES IZVOL,IZTCO
  768. SEGDES LINCO
  769.  
  770. NRIGE=7
  771. NKID =9
  772. NKMT =7
  773. NMATRI=0
  774. SEGINI MATRIK
  775. CALL ECROBJ('MATRIK',MATRIK)
  776. CALL ECROBJ('CHPOINT',IZG1)
  777.  
  778. C*************************************************************************
  779. ELSE IF(KFORM.EQ.1)THEN
  780. C CAS FORMULATION EF
  781.  
  782. DT=0.D0
  783. IF(IDCEN.EQ.4)THEN
  784. TYPE=' '
  785. CALL ACMO(MTABT,'DELTAT',TYPE,IENT)
  786. IF(TYPE.NE.'ENTIER')THEN
  787. WRITE(6,*)' Opérateur TSCA'
  788. WRITE(6,*)' On reclame un pas de temps'
  789. C Option %m1:8 incompatible avec les données
  790. MOTERR( 1: 8) = ' EF '
  791. CALL ERREUR(803)
  792. RETURN
  793. ELSE
  794. CALL ACMF(MTABT,'DELTAT',DT)
  795. ENDIF
  796. ENDIF
  797.  
  798. IHV=0
  799. NUTOEL=0
  800. NINKO=IZTU1.VPOCHA(/2)
  801.  
  802. TYPE=' '
  803. CALL ACMO(MTABX,'MATELM',TYPE,MATRIK)
  804. IF(TYPE.EQ.'MATRIK'.AND.KMACO.NE.0)THEN
  805. SEGACT MATRIK
  806. NMATRI=IRIGEL(/2)
  807. MELEME=IRIGEL(1,1)
  808. SEGACT MELEME
  809. IMATRI=IRIGEL(4,1)
  810. SEGACT IMATRI
  811. NBME=LIZAFM(/2)
  812. NINKO=NBME
  813. MELEMS=KSPGP
  814.  
  815.  
  816. ELSE
  817.  
  818. NRIGE=7
  819. NKID =9
  820. NKMT =7
  821. NMATRI=1
  822. SEGINI MATRIK
  823. IRIGEL(1,1)=MELEME
  824. IRIGEL(2,1)=MELEME
  825. IRIGEL(7,1)=2
  826. NBME=NINKO
  827. NBELC=0
  828. CALL LEKTAB(MTABZ,'SOMMET',MELEMS)
  829.  
  830. C --- CALCUL DU NOMBRE DE PAQUETS DE LRV ELEMENTS ---
  831. CALL KPLRVM(MELEME,LRV,NBSOUS)
  832.  
  833. SEGINI IMATRI,IMATRS
  834. IRIGEL(4,1)=IMATRI
  835. KSPGP=MELEMS
  836. KSPGD=MELEMS
  837.  
  838. IF(NBME.EQ.1)THEN
  839. LISPRI(1)=NOMI(1:4)//' '
  840. LISDUA(1)=NOMA(1:4)//' '
  841. ELSE
  842. DO 102 I=1,NBME
  843. WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7)
  844. LISPRI(I)=NOM(1:4)//' '
  845. WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7)
  846. LISDUA(I)=NOM(1:4)//' '
  847. 102 CONTINUE
  848. ENDIF
  849.  
  850. SEGACT MELEME
  851. NBSOU1=LISOUS(/1)
  852. IF(NBSOU1.EQ.0)NBSOU1=1
  853. LL=0
  854. NUTOEL=0
  855. DO 101 L=1,NBSOU1
  856. IPT1=MELEME
  857. IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  858. SEGACT IPT1
  859. NOM0=NOMS(IPT1.ITYPEL)//' '
  860. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  861. SEGACT IZFFM*MOD
  862. IZHR=KZHR(1)
  863. IZH2=KZHR(2)
  864. SEGACT IZHR*MOD
  865. NES=GR(/1)
  866. NPG=GR(/3)
  867. IZF1=KTP(1)
  868.  
  869. NP = IPT1.NUM(/1)
  870. MP = NP
  871. NBELEM=IPT1.NUM(/2)
  872.  
  873. NNN=MOD(NBELEM,LRV)
  874. IF(NNN.EQ.0) NPACK=NBELEM/LRV
  875. IF(NNN.NE.0) NPACK=1+(NBELEM-NNN)/LRV
  876.  
  877. DO 701 KPACK=1,NPACK
  878.  
  879. C --- POUR CHAQUE PAQUET DE LRV ELEMENTS ou moins
  880. KDEB=1+(KPACK-1)*LRV
  881. KFIN=MIN(NBELEM,KDEB+LRV-1)
  882.  
  883. NBEL=KFIN-KDEB+1
  884. LL=LL+1
  885.  
  886. SEGINI IPM1,IPS1
  887. LIZAFM(LL,1)=IPM1
  888. LIZAFS(LL,1)=IPS1
  889. IPM2=IPM1
  890. IPM3=IPM1
  891. IPS2=IPS1
  892. IPS3=IPS1
  893. IF(NBME.GE.2)THEN
  894. SEGINI IPM2,IPS2
  895. LIZAFM(LL,2)=IPM2
  896. LIZAFS(LL,2)=IPS2
  897. ENDIF
  898. IF(NBME.GE.3)THEN
  899. SEGINI IPM3,IPS3
  900. LIZAFM(LL,3)=IPM3
  901. LIZAFS(LL,3)=IPS3
  902. ENDIF
  903.  
  904.  
  905. KITT=2
  906. KJTT=IKL
  907.  
  908. SEGINI PETROV
  909.  
  910. CALL XCONV(FN,GR,PG,XYZ,HR,PGSQ,RPG,AJ,
  911. & NES,IDIM,NP,NPG,IAXI,AG,AD,IDIV,CMD,IKOMP,LRV,
  912. & WT,WS,HK,PGSK,RPGK,AIRE,AJK,UIL,DUIL,COEFK,ANUK,
  913. & RO,1,UTRANS.VPOCHA,NPTS,IPADS.LECT,VISCO.VPOCHA,IKL,
  914. & IPT1.NUM(1,KDEB),NBEL,NUTOEL,XCOOR,
  915. & IPM1.AM,IPM2.AM,IPM3.AM,
  916. & IPS1.AM,IPS2.AM,IPS3.AM,
  917. & NINKO,IDCEN,DT,
  918. & IZTU1.VPOCHA,NPTG,IPADI.LECT)
  919.  
  920. SEGSUP PETROV
  921.  
  922. CALL XLAPL(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,
  923. & VISCO.VPOCHA,VISCO.VPOCHA,VISCO.VPOCHA,KITT,KJTT,IKL,
  924. & IPT1.NUM(1,KDEB),NBEL,NUTOEL,XCOOR,AIMPL,IKOMP,
  925. & IPM1.AM,IPM2.AM,IPM3.AM,
  926. & IPS1.AM,IPS2.AM,IPS3.AM,
  927. & NINKO,IHV,IARG,VISCO.VPOCHA)
  928.  
  929. NUTOEL=NUTOEL+NBEL
  930. SEGDES IPM1,IPS1
  931. IF(NBME.GE.2)SEGDES IPM2,IPS2
  932. IF(NBME.GE.3)SEGDES IPM3,IPS3
  933.  
  934. 701 CONTINUE
  935. SEGDES IPT1
  936. SEGSUP IZFFM,IZHR,IZF1,IZH2
  937. 101 CONTINUE
  938. IF(NBSOU1.NE.1)SEGDES MELEME
  939. ENDIF
  940.  
  941. C On cree le CHPOINT pour les sources et eventuellement le semi
  942. C
  943. NAT=2
  944. NSOUPO=1
  945. SEGACT MELEMS
  946. N=MELEMS.NUM(/2)
  947. NC=NINKO
  948. SEGINI MCHPO1,MSOUP1,MPOVA1
  949. MCHPO1.IFOPOI=IFOUR
  950. MCHPO1.MOCHDE=TITREE
  951. MCHPO1.MTYPOI='SMBR'
  952. MCHPO1.JATTRI(1)=2
  953. MCHPO1.IPCHP(1)=MSOUP1
  954. DO 177 N=1,NINKO
  955. MSOUP1.NOCOMP(N)=LISDUA(N)
  956. 177 CONTINUE
  957. MSOUP1.IGEOC=MELEMS
  958. MSOUP1.IPOVAL=MPOVA1
  959. SEGDES MCHPO1,MSOUP1
  960.  
  961. CALL KRIPAD(MELEMQ,IPADQ)
  962. SEGDES MELEMQ,MELEMS
  963.  
  964. SEGACT MELEMK
  965. NBSOUS=MELEMK.LISOUS(/1)
  966. IF(NBSOUS.EQ.0)NBSOUS=1
  967.  
  968. NUTOEL=0
  969. DO 1102 L=1,NBSOUS
  970. IPT1=MELEMK
  971. IF(NBSOUS.NE.1)IPT1=MELEMK.LISOUS(L)
  972. SEGACT IPT1
  973.  
  974. NOM0=NOMS(IPT1.ITYPEL)//' '
  975. C write(6,*)'MQUAD,MACRO,INEFMD=',MQUAD,MACRO,INEFMD
  976. IF(INEFMD.EQ.3)THEN
  977. C QUAD
  978. IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  979. IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  980. IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  981. ELSEIF(INEFMD.EQ.2)THEN
  982. C MACRO
  983. IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' '
  984. IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  985. IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  986. ELSE
  987. IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//' '
  988. ENDIF
  989.  
  990. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  991.  
  992.  
  993. SEGACT IZFFM*MOD
  994. IZHR=KZHR(1)
  995. IZH2=KZHR(2)
  996. SEGACT IZHR*MOD
  997. NES=GR(/1)
  998. NPG=GR(/3)
  999. IZF1=KTP(1)
  1000. SEGACT IZF1*MOD
  1001. MP1=IZF1.FN(/1)
  1002. NP = IPT1.NUM(/1)
  1003. MP = NP
  1004. NBEL=IPT1.NUM(/2)
  1005. NELG=IZTGG3.VPOCHA(/1)
  1006. NPT =MPOVA1.VPOCHA(/1)
  1007. SEGACT MELEP1
  1008.  
  1009. IKAS=1
  1010. CALL XSOUR(FN,IZF1.FN,GR,PG,XYZ,HR,PGSQ,RPG,
  1011. & NES,IDIM,NP,MP1,NPG,IAXI,IPT1.NUM,IKAS,KPRE,
  1012. & IZTGG3.VPOCHA,IKS,NELG,IPADQ.LECT,MELEP1.NUM,
  1013. & IZTGG3.VPOCHA,IKS,IZTGG3.VPOCHA,IKS,IPADS.LECT,
  1014. & NBEL,NUTOEL,XCOOR,MPOVA1.VPOCHA,NPT)
  1015.  
  1016. NUTOEL=NUTOEL+NBEL
  1017. SEGSUP IZFFM,IZHR,IZF1,IZH2
  1018. SEGDES IPT1
  1019. 1102 CONTINUE
  1020. SEGDES IZTGG3,MPOVA1,MELEP1
  1021. SEGSUP IPADQ
  1022. IF(NBSOU1.NE.1)SEGDES MELEMK
  1023.  
  1024. SEGACT MELEME
  1025. NBSOU1=LISOUS(/1)
  1026. IF(NBSOU1.EQ.0)NBSOU1=1
  1027. LL=0
  1028.  
  1029. IF(KIMPL.EQ.0.OR.KIMPL.EQ.2)THEN
  1030. SEGACT MPOVA1*MOD
  1031. DO 1533 L=1,NBSOU1
  1032. IPT1=MELEME
  1033. IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  1034. SEGACT IPT1
  1035. NP=IPT1.NUM(/1)
  1036. NBELEM=IPT1.NUM(/2)
  1037.  
  1038. NNN=MOD(NBELEM,LRV)
  1039. IF(NNN.EQ.0) NPACK=NBELEM/LRV
  1040. IF(NNN.NE.0) NPACK=1+(NBELEM-NNN)/LRV
  1041.  
  1042. DO 1534 KPACK=1,NPACK
  1043.  
  1044. C --- POUR CHAQUE PAQUET DE LRV ELEMENTS ou moins
  1045. KDEB=1+(KPACK-1)*LRV
  1046. KFIN=MIN(NBELEM,KDEB+LRV-1)
  1047. NBEL=KFIN-KDEB+1
  1048. LL=LL+1
  1049.  
  1050. DO 2 N=1,NINKO
  1051. IPMS=LIZAFS(LL,N)
  1052. SEGACT IPMS
  1053. DO 12 K=1,NBEL
  1054. KI=KDEB+K-1
  1055. DO 13 J=1,NP
  1056. UU=0.D0
  1057. IU=IPADS.LECT(IPT1.NUM(J,KI))
  1058. DO 14 I=1,NP
  1059. IK=IPADI.LECT(IPT1.NUM(I,KI))
  1060. UU=UU+IPMS.AM(K,I,J)*IZTU1.VPOCHA(IK,N)
  1061. 14 CONTINUE
  1062. MPOVA1.VPOCHA(IU,N)=MPOVA1.VPOCHA(IU,N)+UU
  1063. 13 CONTINUE
  1064. 12 CONTINUE
  1065. SEGSUP IPMS
  1066. 2 CONTINUE
  1067.  
  1068. 1534 CONTINUE
  1069. SEGDES IPT1
  1070. 1533 CONTINUE
  1071. IF(NBSOU1.NE.1)SEGDES MELEME
  1072. ELSE
  1073. NBSOUS=LIZAFS(/1)
  1074. DO L=1,NBSOUS
  1075. DO N=1,NINKO
  1076. IPMS=LIZAFS(L,N)
  1077. SEGSUP IPMS
  1078. ENDDO
  1079. ENDDO
  1080. ENDIF
  1081. SEGDES IZTU1,MPOVA1
  1082.  
  1083. CALL ECROBJ('MATRIK',MATRIK)
  1084.  
  1085. CALL ECROBJ('CHPOINT',MCHPO1)
  1086.  
  1087. SEGDES IMATRI
  1088. SEGSUP IMATRS
  1089. SEGDES MELEME,MATRIK
  1090. IF(IKL.EQ.0)THEN
  1091. SEGDES VISCO
  1092. ENDIF
  1093.  
  1094. C*************************************************************************
  1095. ELSE IF(KFORM.EQ.2)THEN
  1096. C CAS FORMULATION VF
  1097. WRITE(6,*)' FORMULATION VF NON DISPONIBLE '
  1098. C Option %m1:8 incompatible avec les données
  1099. MOTERR( 1: 8) = ' EF '
  1100. CALL ERREUR(803)
  1101. RETURN
  1102.  
  1103. ENDIF
  1104.  
  1105. C write(6,*)' RETOUR DE TSCA '
  1106. IF(IPADS.NE.IPADI)THEN
  1107. SEGSUP IPADS,IPADI
  1108. ELSE
  1109. SEGSUP IPADS
  1110. ENDIF
  1111. IPAS=1
  1112. RETURN
  1113.  
  1114.  
  1115. 90 CONTINUE
  1116. WRITE(6,*)' Interuption anormale de TSCAL '
  1117. C Option %m1:8 incompatible avec les données
  1118. CALL ERREUR(803)
  1119. RETURN
  1120. 1002 FORMAT(10(1X,1PE11.4))
  1121. 1001 FORMAT(20(1X,I5))
  1122. END
  1123.  
  1124.  
  1125.  
  1126.  
  1127.  
  1128.  
  1129.  
  1130.  
  1131.  
  1132.  
  1133.  
  1134.  
  1135.  
  1136.  
  1137.  
  1138.  
  1139.  
  1140.  
  1141.  
  1142.  
  1143.  
  1144.  
  1145.  
  1146.  
  1147.  
  1148.  
  1149.  
  1150.  
  1151.  
  1152.  
  1153.  
  1154.  
  1155.  
  1156.  
  1157.  
  1158.  
  1159.  
  1160.  
  1161.  
  1162.  
  1163.  
  1164.  
  1165.  
  1166.  

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