Télécharger eqex.eso

Retour à la liste

Numérotation des lignes :

  1. C EQEX SOURCE GOUNAND 13/01/22 21:15:00 7679
  2. SUBROUTINE EQEX
  3. C***********************************************************************
  4. C VERSION : ????
  5. C HISTORIQUE : 22/03/00: gounand
  6. C Rajout des préconditionneurs ILUT (ILU with dual truncation) et d'une
  7. C variante (ILUT2) qui remplit mieux la mémoire et des paramètres
  8. C associés : ILUTLFIL (ILUT level of fill) et ILUTDTOL (ILUT drop
  9. C tolerance)
  10. C HISTORIQUE : 20/12/99: gounand
  11. C Ajout des indices 'TYRENU' (type de renumérotation) et 'PCMLAG'
  12. C (placement des multiplicateurs de Lagrange à la table d'indice
  13. C 'METHINV'.
  14. C HISTORIQUE : 08/04/04 : ajout ILUTP
  15. C HISTORIQUE : 27/10/10: JCARDO: correction bug lié à IARG, qui pouvait
  16. C parfois valoir zéro à tort (label 110)
  17. C HISTORIQUE :
  18. C***********************************************************************
  19. IMPLICIT REAL*8 (A-H,O-Z)
  20. IMPLICIT INTEGER (I-N)
  21. PARAMETER (NBM=21,NBL=4,NOPT=75)
  22. PARAMETER (NTB=2,NBH=7)
  23. -INC CCOPTIO
  24. -INC SMLREEL
  25. -INC SMLENTI
  26. POINTEUR MLENT4.MLENTI
  27. -INC SMLMOTS
  28. POINTEUR MINCO.MLMOTS
  29. -INC SMELEME
  30. POINTEUR IGEOM.MELEME
  31. -INC SMMODEL
  32. -INC SMCHPOI
  33. POINTEUR MCHINI.MCHPOI
  34.  
  35. LOGICAL XEQUA,TTRAN,TPROJ,LOG1
  36. INTEGER RESTRT
  37. CHARACTER*8 LMOTS(NBM),NOM,CHAI,NOMZ,MTYP,NOMI,NOML,NMACO
  38. CHARACTER*8 LSCHE(NBH)
  39. CHARACTER*20 NOMO,MEQUA,MNEFMD
  40. CHARACTER*8 TYPE,TYPC,TYPS
  41. CHARACTER*8 LOPTI(NOPT)
  42. CHARACTER*8 MOIMP(NBL)
  43. DIMENSION KINCD(100)
  44. CHARACTER*8 TINCD(100)
  45.  
  46. CHARACTER*8 LTAB(NTB)
  47. DIMENSION KTAB(NTB)
  48.  
  49. DATA LMOTS /'ZONE ','OPER ','INCO ','CLIM ',
  50. & 'ITMA ','ALFA ','DTI ','IIMP ',
  51. & 'DUMP ','OPTI ','NOMVI ','DOMINC ',
  52. & 'TPSI ','TFINAL ','FIDT ','NISTO ',
  53. & 'NITER ','OMEGA ','EPS ','IMPR ',
  54. & 'EQUA '/
  55. DATA MOIMP /'UIMP ','VIMP ','WIMP ','TIMP '/
  56.  
  57. DATA LOPTI /
  58. C indice KFORM 0 à 3
  59. & 'EFM1 ','EF ','VF ','EFMC ','????????',
  60. & 'LINE ','MACRO ','QUAF ','LINB ','ISOQ ',
  61. C indice IDCEN
  62. & 'CENTREE ','SUPGDC ','SUPG ','TVISQUEU','CNG ',
  63. & 'PSI ','JOHNSON ','UPWIND ','GODUNOV ','VANLEER ',
  64. & 'VLH ','HUSVL ','HUSVLH ','AUSM ','CG ',
  65. & 'VSM ','VSMCC ','SUPGDCH ','SUPGH ','????????',
  66. C indice KPOIN
  67. & 'SOMMET ','FACE ','CENTRE ','CENTREP0','CENTREP1',
  68. & 'MSOMMET ','????????','????????','????????','????????',
  69. C indice KIMPL ---------------------->|indice ISCHT
  70. & 'IMPL ','EXPL ','SEMI ','BDF2 ','BDF4 ',
  71. & 'DIV2 ','CMD ','RIGIDITE','LIMITE ','NODIV ',
  72. C indice IKOMP-------------->| RNG KMACO ALE
  73. & 'CONS ','NOCONS ','CONS2 ','RNG ','ALE ',
  74. C indice MTRMASS---------------------->|
  75. & 'MMPLEINE','MMDIAGO ','MMPG ','MATCONS ','????????',
  76. C indice IDEUL ------------------------->|
  77. & 'EULER ','EULERMS ','EULERMST','????????','????????',
  78. C indice KPOIND->|
  79. & 'INCOD ','INCOP ','STABP ','MUCONS ','FTAU ',
  80. C
  81. & 'MUVARI ','????????','????????','????????','????????'/
  82.  
  83. DATA LSCHE /'EUL_EXPL','EUL_IMPL','TVISQ ','SEMI ',
  84. & 'CN ','CNG ','BDF2 '/
  85.  
  86. DATA LTAB/'DOMAINE ','EQEX '/
  87. C***
  88. C WRITE(IOIMP,*) ' DEBUT EQEX '
  89. NBIK=0
  90. IDP=0
  91. MTABD=0
  92. CALL INITI(KTAB,NTB,0)
  93.  
  94. C Définition des options par défaut
  95. CALL CRTABL(KOPT)
  96. CALL ECMM(KOPT,'SOUSTYPE','KOPT')
  97. CALL ECME(KOPT,'IDCEN',2)
  98. CALL ECME(KOPT,'RNG ',1)
  99. CALL ECME(KOPT,'IKOMP',0)
  100. CALL ECME(KOPT,'KMACO',0)
  101. CALL ECMM(KOPT,'NMACO','xxxxxxxx')
  102. CALL ECME(KOPT,'KIMPL',0)
  103. CALL ECME(KOPT,'KFORM',0)
  104. CALL ECMF(KOPT,'AIMPL',1.D0)
  105. CALL ECME(KOPT,'ALE',0)
  106. CALL ECME(KOPT,'KMU',0)
  107. CALL ECME(KOPT,'KPOIND',99)
  108. CALL ECME(KOPT,'KPOIN',2)
  109. CALL ECME(KOPT,'MTRMASS ',1)
  110. CALL ECME(KOPT,'IDEUL ',1)
  111. CALL ECME(KOPT,'ISCHT',0)
  112. CALL ECME(KOPT,'IDIV',0)
  113. CALL ECMF(KOPT,'CMD',0.2D0)
  114. CALL ECMF(KOPT,'STABP',1.D-2)
  115. CALL ECME(KOPT,'RIGIDITE',0)
  116. CALL ECME(KOPT,'LIMITE',0)
  117. c CALL ECMM(KOPT,'INEFMD','xxxxxxxx')
  118.  
  119.  
  120. CALL QUETYP(TYPE,0,IRET)
  121.  
  122. MATABL=0
  123. MMODEL=0
  124. IF(TYPE.EQ.'MMODEL')THEN
  125. CALL LIROBJ('MMODEL',MMODEL,0,IRET)
  126. CALL LEKMOD(MMODEL,MTBLE,INEFMD)
  127. IF(MTBLE.EQ.0)RETURN
  128. KTAB(1)=MTBLE
  129. KTAB(2)=0
  130. CALL ECMM(KOPT,'INEFMD',LOPTI(5+INEFMD))
  131.  
  132. ELSEIF(TYPE.EQ.'MOT')THEN
  133. C Nouvelle directive EQUA
  134. c write(6,*)' Nouvelle directive EQUA'
  135. CALL LIRCHA(CHAI,1,LCHAR)
  136. KTAB(1)=-1
  137. KTAB(2)=0
  138. IF(CHAI(1:4).NE.'EQUA')THEN
  139. CALL ECRCHA(CHAI)
  140. GO TO 6
  141. ENDIF
  142.  
  143. CALL CRTABL(MATABL)
  144. CALL ECMM(MATABL,'SOUSTYPE','EQEX')
  145. XEQUA=.TRUE.
  146. CALL ECML(MATABL,'XEQUA',XEQUA)
  147. CALL ECML(MATABL,'XRIG',.FALSE.)
  148. C Lecture du nom de l'equation/inconnue
  149. NBIC=0
  150. JGN=4
  151. JGM=0
  152. NINCT=0
  153. SEGINI MLMOT2
  154. CALL ECMO(MATABL,'LISTINCO','LISTMOTS',MLMOT2)
  155. SEGDES MLMOT2
  156. 3 CONTINUE
  157. CALL QUETYP(MTYP,0,IRET)
  158. IF(MTYP.EQ.'MMODEL ')THEN
  159. GO TO 4
  160. ELSEIF(MTYP.EQ.'MOT ')THEN
  161. CALL LIRCHA(CHAI,1,LCHAR)
  162. IF(CHAI.EQ.'RIGIDITE')THEN
  163. CALL ECML(MATABL,'XRIG',.TRUE.)
  164. GO TO 3
  165. ENDIF
  166.  
  167. NBIC=NBIC+1
  168. SEGACT MLMOT2
  169. JGM=NBIC
  170. SEGADJ MLMOT2
  171. MLMOT2.MOTS(NBIC)=CHAI
  172. SEGDES MLMOT2
  173. GO TO 3
  174. ELSE
  175. C On ne trouve pas d'objet de type %m1:8
  176. MOTERR( 1: 8) = ' '
  177. CALL ERREUR(38)
  178. RETURN
  179. ENDIF
  180.  
  181.  
  182. 4 CONTINUE
  183. IF(NBIC.EQ.0)THEN
  184. C On ne trouve pas d'objet de type %m1:8
  185. MOTERR( 1: 8) = 'MOT '
  186. CALL ERREUR(38)
  187. RETURN
  188. ENDIF
  189.  
  190. CALL LIROBJ('MMODEL',MMODEL,0,IRET)
  191. CALL ECMO(MATABL,'MODELE','MMODEL ',MMODEL)
  192. SEGACT MMODEL
  193. * Détermination de MACRO et INEFMD
  194. IMODEL = KMODEL(1)
  195. SEGACT IMODEL
  196. IF(NEFMOD.GE.129.AND.NEFMOD.LE.135)THEN
  197. INEFMD=1
  198. ELSEIF(NEFMOD.GE.136.AND.NEFMOD.LE.141)THEN
  199. INEFMD=2
  200. ELSEIF(NEFMOD.GE.143.AND.NEFMOD.LE.149)THEN
  201. INEFMD=3
  202. ELSEIF(NEFMOD.GE.158.AND.NEFMOD.LE.164)THEN
  203. INEFMD=4
  204. ELSE
  205. C% Le type d'élément fini %m1:8 ne convient pas.
  206. WRITE(NOM,FMT='(I8)')NEFMOD
  207. MOTERR( 1: 8) = NOM
  208. CALL ERREUR(926)
  209. RETURN
  210. ENDIF
  211. SEGDES MMODEL,IMODEL
  212. CALL ECMM(KOPT,'INEFMD',LOPTI(5+INEFMD))
  213. CALL ECMM(MATABL,'INEFMD',LOPTI(5+INEFMD))
  214.  
  215. JGN=8
  216. JGM=NBIC
  217. NINCT=0
  218. SEGINI MLMOT3
  219. CALL ECMO(MATABL,'TYPEINCO','LISTMOTS',MLMOT3)
  220. DO 5 I=1,NBIC
  221. CALL LIRCHA(CHAI,1,LCHAR)
  222. IF(LCHAR.EQ.0)THEN
  223. C On ne trouve pas d'objet de type %m1:8
  224. MOTERR( 1: 8) = 'MOT '
  225. CALL ERREUR(38)
  226. RETURN
  227. ENDIF
  228.  
  229. CALL ECMM(MATABL,'TYPPRESS','MSOMMET ')
  230. IF(CHAI.EQ.'PRESSION')THEN
  231. CALL LIRCHA(NOM,1,LCHAR)
  232. CALL OPTLI(IPRE,LOPTI(33),NOM,4)
  233. IF(IPRE.EQ.0)THEN
  234. C% On a lu : %m1:8 : , alors qu'on attend un des mots clés suivant :
  235. C% %m9:16 %m17:24 %m25:32 %m33:40
  236. MOTERR( 1: 8) = NOM
  237. MOTERR( 9:16) = LOPTI(33)
  238. MOTERR(17:24) = LOPTI(35)
  239. MOTERR(25:32) = LOPTI(36)
  240. CALL ERREUR(930)
  241. RETURN
  242. ENDIF
  243. CALL ECMM(MATABL,'TYPPRESS',NOM)
  244. ENDIF
  245.  
  246. IF(CHAI.NE.'TEMPERAT'.AND.CHAI.NE.'VITESSE'.AND.
  247. & CHAI.NE.'PRESSION')THEN
  248. C Option %m1:8 incompatible avec les données
  249. MOTERR( 1: 8) =CHAI
  250. CALL ERREUR(803)
  251. RETURN
  252. ENDIF
  253. MLMOT3.MOTS(I)=CHAI
  254. 5 CONTINUE
  255. SEGDES MLMOT3
  256.  
  257. C Lecture du Schema en temps
  258.  
  259. CALL LIRCHA(CHAI,1,LCHAR)
  260. IF(LCHAR.EQ.0)THEN
  261. C On ne trouve pas d'objet de type %m1:8
  262. MOTERR( 1: 8) = 'MOT '
  263. CALL ERREUR(38)
  264. RETURN
  265. ENDIF
  266.  
  267. IF(CHAI.NE.'PERM'.AND.CHAI.NE.'TRAN'.AND.CHAI.NE.'PROJ')THEN
  268. C% On a lu : %m1:8 : , alors qu'on attend un des mots clés suivant :
  269. C% %m9:16 %m17:24 %m25:32 %m33:40
  270. MOTERR( 1: 8) = CHAI
  271. MOTERR( 9:16) = 'PERM'
  272. MOTERR(17:24) = 'TRAN'
  273. MOTERR(25:32) = 'PROJ'
  274. CALL ERREUR(930)
  275. RETURN
  276. ENDIF
  277.  
  278. TPROJ=.FALSE.
  279. IF(CHAI.EQ.'PERM')TTRAN=.FALSE.
  280. IF(CHAI.EQ.'TRAN')TTRAN=.TRUE.
  281. IF(CHAI.EQ.'PROJ')THEN
  282. TTRAN=.TRUE.
  283. TPROJ=.TRUE.
  284. ENDIF
  285. CALL ECML(MATABL,'TRAN',TTRAN)
  286. CALL ECML(MATABL,'PROJ',TPROJ)
  287.  
  288. IP=0
  289.  
  290. IF(TTRAN)THEN
  291. C Lecture des parametres du transitoire
  292. CALL QUETYP(MTYP,0,IRET)
  293. IF(IRET.EQ.0)THEN
  294. C On ne trouve pas d'objet de type %m1:8
  295. MOTERR( 1: 8) = 'MOT ou R'
  296. CALL ERREUR(38)
  297. RETURN
  298. ENDIF
  299. IF(MTYP.EQ.'MOT')THEN
  300. CALL LIRCHA(CHAI,1,LCHAR)
  301. CALL ECMM(MATABL,'DELTAT',CHAI)
  302. ELSEIF(MTYP.EQ.'FLOTTANT')THEN
  303. CALL LIRREE(XVAL,1,IRET)
  304. CALL ECMF(MATABL,'DELTAT',XVAL)
  305. ELSE
  306. C On ne trouve pas d'objet de type %m1:8
  307. MOTERR( 1: 8) = 'MOT ou R'
  308. CALL ERREUR(38)
  309. RETURN
  310. ENDIF
  311.  
  312. CALL LIRCHA(NOM,1,IRET)
  313. IF(IRET.EQ.0)THEN
  314. C On ne trouve pas d'objet de type %m1:8
  315. MOTERR( 1: 8) = 'MOT '
  316. CALL ERREUR(38)
  317. RETURN
  318. ENDIF
  319.  
  320. CALL OPTLI(IPST,LSCHE,NOM,NBH)
  321.  
  322. IF(IPST.EQ.0)THEN
  323. WRITE(IOIMP,*)'Directive : ',NOM
  324. WRITE(IOIMP,*)'non trouvée dans la liste ->',LSCHE
  325. RETURN
  326. ENDIF
  327. CALL ECMM(MATABL,'SCHEMAT',LSCHE(IPST))
  328. IF(IPST.EQ.4)THEN
  329. CALL LIRREE(XVAL,1,IRET)
  330. IF(IRET.EQ.0)THEN
  331. C On ne trouve pas d'objet de type %m1:8
  332. MOTERR( 1: 8) = 'FLOTTANT'
  333. CALL ERREUR(38)
  334. RETURN
  335. ENDIF
  336. CALL ECMF(MATABL,'Betat',XVAL)
  337. ENDIF
  338.  
  339. CALL ECML(MATABL,'XDIAG',.FALSE.)
  340.  
  341. ENDIF
  342.  
  343. DO 51 I=1,NBIC
  344.  
  345. CALL LIRCHA(CHAI,1,IRET)
  346. IF(IRET.EQ.0)THEN
  347. C On ne trouve pas d'objet de type %m1:8
  348. MOTERR( 1: 8) = 'MOT '
  349. CALL ERREUR(38)
  350. RETURN
  351. ENDIF
  352.  
  353. CALL OPTLI(IP,LMOTS,CHAI,NBM)
  354. IF(IP.NE.0)THEN
  355. write(6,*)' OPTI et ZONE sont des mots cles '
  356. write(6,*)' Choix mal venu pour un nom de variable'
  357. C On ne trouve pas d'objet de type %m1:8
  358. MOTERR( 1: 8) = 'MOT '
  359. CALL ERREUR(38)
  360. RETURN
  361. ENDIF
  362.  
  363. WRITE(NOM,FMT='(A3,I1)')'INC',I
  364. CALL ECMM(MATABL,NOM,CHAI)
  365.  
  366. 51 CONTINUE
  367.  
  368. IF(IPST.EQ.7.AND.TTRAN)THEN
  369. DO 52 I=1,NBIC
  370.  
  371. CALL LIRCHA(CHAI,1,IRET)
  372. IF(IRET.EQ.0)THEN
  373. C On ne trouve pas d'objet de type %m1:8
  374. MOTERR( 1: 8) = 'MOT '
  375. CALL ERREUR(38)
  376. RETURN
  377. ENDIF
  378.  
  379. WRITE(NOM,FMT='(A3,I1)')'IMC',I
  380. c write(6,*)' NOM,CHAI=',NOM,CHAI
  381. CALL ECMM(MATABL,NOM,CHAI)
  382.  
  383. 52 CONTINUE
  384. ENDIF
  385.  
  386.  
  387. ELSEIF(TYPE.EQ.'TABLE')THEN
  388. CALL LIROBJ(TYPE,MTBLE,0,IRET)
  389. TYPC=' '
  390. CALL ACMO(MTBLE,'SOUSTYPE',TYPC,IRET)
  391. IF(TYPC.EQ.'MOT ')THEN
  392. CALL ACMM(MTBLE,'SOUSTYPE',TYPS)
  393. IF(TYPS.EQ.'DOMAINE')THEN
  394. KTAB(1)=MTBLE
  395. KTAB(2)=0
  396. XEQUA=.FALSE.
  397. CALL ECML(MTBLE,'XEQUA',XEQUA)
  398. CALL ECMM(MTBLE,'INEFMD',' ')
  399. CALL ECMM(KOPT,'INEFMD',' ')
  400. ELSEIF(TYPS.EQ.'EQEX')THEN
  401. KTAB(1)=0
  402. KTAB(2)=MTBLE
  403. CALL ACML(MTBLE,'XEQUA',XEQUA)
  404. CALL ACMM(MTBLE,'INEFMD',MNEFMD)
  405. CALL ECMM(KOPT,'INEFMD',MNEFMD)
  406. ELSE
  407. WRITE(IOIMP,*)' On attend une table soustype DOMAINE ou EQEX'
  408. RETURN
  409. ENDIF
  410. ENDIF
  411. ELSE
  412. KTAB(1)=-1
  413. KTAB(2)=0
  414. ENDIF
  415.  
  416. 6 CONTINUE
  417.  
  418. IF(KTAB(2).NE.0)THEN
  419. MTABLE=KTAB(2)
  420. TYPE='LISTMOTS'
  421. CALL ACMO(MTABLE,'LISTOPER',TYPE,MLMOT1)
  422. SEGACT MLMOT1
  423. NEQUA=MLMOT1.MOTS(/2)
  424. ELSEIF(KTAB(1).NE.0)THEN
  425. MTABD=KTAB(1)
  426.  
  427. IF(MATABL.EQ.0)THEN
  428. CALL CRTABL(MTABLE)
  429. CALL ECMM(MTABLE,'SOUSTYPE','EQEX')
  430. XEQUA=.FALSE.
  431. CALL ECML(MTABLE,'XEQUA',XEQUA)
  432. CALL ECMM(MTABLE,'INEFMD',' ')
  433. CALL ECMM(KOPT,'INEFMD',MNEFMD)
  434. ELSE
  435. MTABLE=MATABL
  436. ENDIF
  437. CALL CRTABL(MINCO)
  438. CALL ECMM(MINCO,'SOUSTYPE','INCO')
  439. NEQUA=0
  440. CALL ECME(MTABLE,'DISCPRES',0)
  441. IF(KTAB(1).GT.0)THEN
  442. IF(MMODEL.EQ.0)CALL ECMO(MTABLE,'DOMAINE','TABLE ',MTABD)
  443. CALL ECME(MTABLE,'NAVISTOK',MMODEL)
  444. ELSE
  445. CALL ECME(MTABLE,'NAVISTOK',-1)
  446. ENDIF
  447. C? IF(MMODEL.NE.0)THEN
  448. C CALL ECMO(MTABLE,'DOMAINE','MMODEL ',MMODEL)
  449. C CALL ECMO(MTABLE,'TDOMAINE','TABLE ',MTABD)
  450. C? CALL ECMO(MTABLE,'DOMAINE','TABLE ',MTABD)
  451. C? ENDIF
  452. CALL ECMO(MTABLE,'INCO','TABLE ',MINCO)
  453. CALL ECMM(MTABLE,'NOMVI','UN')
  454. JGN=8
  455. JGM=0
  456. SEGINI MLMOT1
  457. CALL ECMO(MTABLE,'LISTOPER','LISTMOTS',MLMOT1)
  458. CALL ECME(MTABLE,'ITMA',0)
  459. CALL ECMF(MTABLE,'ALFA',1.D0)
  460. CALL ECME(MTABLE,'FIDT',20)
  461. CALL ECME(MTABLE,'NISTO',20)
  462. CALL ECME(MTABLE,'NITER',1)
  463. CALL ECME(MTABLE,'IPP',0)
  464. CALL ECME(MTABLE,'IMPR',0)
  465. CALL ECMF(MTABLE,'OMEGA',1.D0)
  466. CALL ECMF(MTABLE,'EPS',1.D-2)
  467. CALL ECMF(MTABLE,'TFINAL',1.D30)
  468. NAT=2
  469. NSOUPO=0
  470. SEGINI MCHPOI
  471. JATTRI(1)=2
  472. CALL ECMO(MTABLE,'CLIM','CHPOINT',MCHPOI)
  473.  
  474. CALL CRTABL(MTABT)
  475. CALL ECMM(MTABT,'SOUSTYPE','PASDETPS')
  476. CALL ECMO(MTABLE,'PASDETPS','TABLE ',MTABT)
  477. IPAT=1
  478. CALL ECME(MTABT,'NUPASDT',IPAT)
  479. DT=1.D30
  480. CALL ECMF(MTABT,'DELTAT',DT)
  481. CALL ECMF(MTABT,'DELTAT-1',DT)
  482. TPS=0.D0
  483. CALL ECMF(MTABT,'TPS',TPS)
  484. CALL ECMM(MTABT,'OPER','EQEX')
  485. CALL ECMM(MTABT,'ZONE','EQEX')
  486. CALL ECMF(MTABT,'DTCONV',0.D0)
  487. CALL ECMF(MTABT,'DTDIFU',0.D0)
  488. CALL ECMF(MTABT,'DIAEL',0.D0)
  489. CALL ECME(MTABT,'NUEL',0)
  490.  
  491. C Définition de la méthode d'inversion et des paramètres
  492. C éventuels associés
  493. CALL CRTABL(MTINV)
  494. CALL ECMM(MTINV,'SOUSTYPE','METHINV')
  495. CALL ECMO(MTABLE,'METHINV ','TABLE ',MTINV)
  496. C Méthode d'inversion du système
  497. C 1 : résolution directe (Choleski)
  498. C 2 : Gradient Conjugué
  499. C 3 : Bi-Gradient Conjugué Stabilisé (BiCGSTAB)
  500. C 4 : BiCGSTAB(2)
  501. KTYPI=1
  502. CALL ECME(MTINV,'TYPINV',KTYPI)
  503. C Niveau d'impression pour la partie résolution itérative
  504. IMPINV=0
  505. CALL ECME(MTINV,'IMPINV',IMPINV)
  506. C Options spécifiques aux méthodes itératives :
  507. C
  508. C - Pour l'assemblage : type de renumérotation
  509. C * 'RIEN' : pas de renumérotation
  510. C * 'SLOA' : algorithme de chez Sloan
  511. C * 'GIPR' : Gibbs-King (profile reduction)
  512. C * 'GIBA' : Gibbs-Poole-Stockmeyer (bandwidth reduction)
  513. CALL ECMM(MTINV,'TYRENU','SLOA')
  514. * CALL ECMM(MTINV,'TYRENU','RIEN')
  515. C - Pour l'assemblage : prise en compte des mult.lag
  516. C * 'RIEN'
  517. C * 'APR2'
  518. CALL ECMM(MTINV,'PCMLAG','APR2')
  519. C - Pour l'assemblage : SCALING (type ENTIER) :
  520. C Scaling de la matrice :
  521. C - 0 : pas de scaling
  522. C - 1 : scaling par les normes L2 des lignes et des colonnes
  523. C Par défaut : 0
  524. ISCAL=0
  525. CALL ECME(MTINV,'SCALING',ISCAL)
  526. C - Pour l'assemblage : OUBMAT (type ENTIER) :
  527. C Oublie les matrices élémentaires :
  528. C - 0 : non
  529. C - 1 : oui
  530. C Par défaut : 0
  531. IOUBL=0
  532. CALL ECME(MTINV,'OUBMAT',IOUBL)
  533. C - Champoint d'initialisation de la méthode
  534. C (i.e. estimation de l'inconnue)
  535. ***** MCHINI=0
  536. NAT=0
  537. NSOUPO=0
  538. SEGINI MCHINI
  539. SEGDES MCHINI
  540. CALL ECMO(MTINV,'XINIT','CHPOINT ',MCHINI)
  541. C - Nombre maxi d'itérations à effectuer
  542. ITER=2000
  543. CALL ECME(MTINV,'NITMAX',ITER)
  544. C - Norme maxi (L2 normé par le second membre) du résidu
  545. RESID=1.D-10
  546. CALL ECMF(MTINV,'RESID',RESID)
  547. C - Type de préconditionnement :
  548. C 0 : pas de préconditionnement
  549. C 1 : préconditionnement par la diagonale
  550. C 2 : préconditionnement D-ILU
  551. C 3 : préconditionnement ILU(0) (Choleski)
  552. C 4 : préconditionnement MILU(0) (Choleski modifié)
  553. C 5 : préconditionnement ILUT (dual truncation)
  554. C 6 : préconditionnement ILUT2 (une variante du
  555. C précédent qui remplit mieux la mémoire et
  556. C fonctionne mieux quelquefois)
  557. C 7 : préconditionnement ILUTP (avec pivoting)
  558. C 8 : préconditionnement ILUTPG (avec pivoting)
  559. C ILUTP version gounand
  560. C On traite de manière spéciale les termes
  561. C qui sont dans ILU(0)
  562. C 9 : préconditionnement ILUTPG2 (avec pivoting)
  563. C ILUTP version gounand 2
  564. C On garde tous les termes qui sont dans ILU(0)
  565. KPREC=3
  566. CALL ECME(MTINV,'PRECOND',KPREC)
  567. C - Pour une méthode ILUT, on a les deux indices suivant :
  568. C * ILUTLFIL : encombrement maximal (approximatif) du
  569. C préconditionneur, par rapport à la matrice.
  570. C * ILUTDTOL : "drop tolerance" pour le préconditionneur.
  571. C i.e. en-dessous de cette valeur relative, les
  572. C termes de la factorisation incomplète seront
  573. C oubliés.
  574. XLFIL=2.D0
  575. CALL ECMF(MTINV,'ILUTLFIL',XLFIL)
  576. * -1. sinon, oubli possible des 0.D0 dans le préconditionneur
  577. XDTOL=-1.D0
  578. CALL ECMF(MTINV,'ILUTDTOL',XDTOL)
  579. C - Pour une méthode ILUTP, on a les deux indices suivant :
  580. C * ILUTPPIV (type REEL) (compris entre 0.D0 et 1.D0) :
  581. C 0.D0 : on ne pivote pas
  582. C 1.D0 : on pivote tout le temps
  583. C (recommandation : entre 0.1D0 et 0.01D0)
  584. C Par défaut : 0.1D0
  585. XSPIV=0.1D0
  586. CALL ECMF(MTINV,'ILUTPPIV',XSPIV)
  587. C - Fréquence de recalcul du préconditionneur en fonction
  588. C des deux indices de boucle suivant :
  589. C * indice de boucle sur les pas de temps
  590. C * indice de boucle sur la boucle d'itérations utilisée
  591. C pour résoudre les non-linéarités
  592. C Par défaut, on recalcule tout le temps le préconditionneur
  593. IFCPRT=1
  594. IFCPRI=1
  595. CALL ECME(MTINV,'FCPRECT',IFCPRT)
  596. CALL ECME(MTINV,'FCPRECI',IFCPRI)
  597. C - 'Breakdown tolerance' pour les méthodes de type
  598. C BiCGSTAB. Si un certain produit scalaire de vecteurs
  599. C "direction" est inférieur à cette tolérance, la
  600. C méthode s'arrete.
  601. BRTOL=1.D-40
  602. CALL ECMF(MTINV,'BCGSBTOL',BRTOL)
  603. C - Paramètre de relaxation pour le préconditionnement
  604. C MILU(0) compris entre 0. et 1.
  605. C S'il est égal à 0, on se ramène à ILU(0)
  606. C S'il est égal à 1, MILU(0) est dit non relaxé
  607. RXMILU=1.D0
  608. CALL ECMF(MTINV,'MILURELX',RXMILU)
  609. C - Paramètre de redémarrage pour GMRES(m)
  610. RESTRT=50
  611. CALL ECME(MTINV,'GMRESTRT',RESTRT)
  612. ENDIF
  613.  
  614. 1 CONTINUE
  615. CALL LIRCHA(NOM,0,IRET)
  616. IF(IRET.EQ.0)GO TO 90
  617. 2 CONTINUE
  618.  
  619. IF(IDP.NE.0)WRITE(IOIMP,*) ' Directive en cours :',NOM
  620. C WRITE(IOIMP,*) ' Directive en cours :',NOM
  621. CALL OPTLI(IP,LMOTS,NOM,NBM)
  622. C WRITE(IOIMP,*)' EQEX, IP=',ip,' NOM=',nom
  623. IF(IP.EQ.0)THEN
  624. WRITE(IOIMP,*)'Directive : ',NOM
  625. WRITE(IOIMP,*)'non trouvée dans la liste ->',LMOTS
  626. RETURN
  627. ENDIF
  628.  
  629.  
  630. GO TO (10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
  631. & 25,26,27,28,29),IP
  632.  
  633. C ZONE
  634.  
  635. 10 CONTINUE
  636.  
  637. CALL LITABS(LTAB,KTAB,1,0,IRET)
  638.  
  639. MMODEL=0
  640. IF(KTAB(1).EQ.0)THEN
  641. CALL LIROBJ('MMODEL',MMODEL,0,IRET2)
  642. IF(IRET2.EQ.0)THEN
  643. WRITE(IOIMP,*)' On attend un objet TABLE DOMAINE ou MODELE'
  644. RETURN
  645. ENDIF
  646. CALL LEKMOD(MMODEL,MTBLE,INEFMD)
  647. IF(MTBLE.EQ.0)RETURN
  648. KTAB(1)=MTBLE
  649. CALL ECMM(KOPT,'INEFMD',LOPTI(5+INEFMD))
  650. ENDIF
  651.  
  652. CALL QUENOM(NOMZ)
  653. GO TO 1
  654.  
  655. C OPER
  656.  
  657. 11 CONTINUE
  658.  
  659. CALL LIRCHA(NOMO,1,LNOMO)
  660. IF(LNOMO.EQ.0)THEN
  661. WRITE(IOIMP,*)' ON ATTEND LE NOM DE L OPERATEUR'
  662. RETURN
  663. ENDIF
  664.  
  665. * ECRITURE DU NOM DE L'OPERATEUR
  666.  
  667. NEQUA=NEQUA+1
  668. IF(NEQUA.LT.10)THEN
  669. LNOMOT=LNOMO+1
  670. WRITE(MEQUA,FMT='(I1,19A1)')NEQUA,(NOMO(I:I),I=1,LNOMO)
  671. C WRITE(IOIMP,*)' MEQUA=',MEQUA
  672. ELSEIF(NEQUA.LT.100.AND.NEQUA.GE.10)THEN
  673. LNOMOT=LNOMO+2
  674. WRITE(MEQUA,FMT='(I2,18A1)')NEQUA,(NOMO(I:I),I=1,LNOMO)
  675. ELSEIF(NEQUA.LT.1000.AND.NEQUA.GE.100)THEN
  676. LNOMOT=LNOMO+3
  677. WRITE(MEQUA,FMT='(I3,17A1)')NEQUA,(NOMO(I:I),I=1,LNOMO)
  678. C WRITE(IOIMP,*)' MEQUA=',MEQUA
  679. ELSE
  680. WRITE(IOIMP,*)'PLUS DE 999 OPERATEURS : CAS NON PREVU'
  681. RETURN
  682. ENDIF
  683. JGN=8
  684. JGM=MLMOT1.MOTS(/2)+1
  685. SEGADJ MLMOT1
  686. MLMOT1.MOTS(JGM)=NOMO(1:LNOMO)
  687. C CALL LENCHA(MEQUA,LC1)
  688. CALL CRTABL(MTABX)
  689. CALL ECMM(MTABX,'SOUSTYPE','KIZX')
  690. C CALL ECMO(MTABLE,MEQUA(1:8),'TABLE',MTABX)
  691. CALL ECCTAB(MTABLE,'MOT',0,0.D0,MEQUA(1:LNOMOT),.TRUE.,0,
  692. & 'TABLE',0,0.D0,CHAI,.TRUE.,MTABX)
  693. * ECRITURE DE LA TABLE DE REFERENCE
  694. CALL ECMO(MTABX,'EQEX','TABLE',MTABLE)
  695. * ECRITURE DU NOM DE LA ZONE
  696. CALL ECMM(MTABX,'NOMZONE',NOMZ)
  697. * ECRITURE DE MELEMZ
  698. CALL ECMO(MTABX,'DOMZ','TABLE',KTAB(1))
  699. IF(MMODEL.NE.0)THEN
  700. CALL ECMO(MTABX,'DOMZ','MMODEL',MMODEL)
  701. CALL ECMO(MTABX,'TDOMZ','TABLE',KTAB(1))
  702. ENDIF
  703.  
  704. CALL ECMM(MTABX,'NOMOPER',NOMO(1:8))
  705. CALL ECMO(MTABX,'KOPT','TABLE',KOPT)
  706. * ECRITURE DE LA LISTE DES ARGUMENTS
  707. * 1) on initialise la variable IARG à 0
  708. * 2) chaque fois que l'on trouve un argument pour l'opérateur courant,
  709. * on incrémente cette variable et on boucle (=> GOTO 110)
  710. * 3) on met à jour 'IARG' dans MTABX dès qu'il n'y a plus d'argument:
  711. * - soit il n'y a plus d'objet passé à EQEX (=> GOTO 90)
  712. * - soit on est tombé sur un autre mot-clé (=> GOTO 2 )
  713. IARG=0
  714.  
  715. 110 CONTINUE
  716. CALL QUETYP(MTYP,0,IRET)
  717. C WRITE(IOIMP,*)' MTYP=',mtyp,' iret=',iret
  718. IF(IRET.EQ.0)THEN
  719. * PLUS AUCUN MOT DANS EQEX => ON MET À JOUR 'IARG'
  720. CALL ECME(MTABX,'IARG',IARG)
  721. GO TO 90
  722. ENDIF
  723.  
  724. IF(MTYP.EQ.'MOT ')THEN
  725.  
  726. CALL LIRCHA(NOM,1,IRET)
  727. CALL OPTLI(IP,LMOTS,NOM,NBM)
  728. IF(IP.EQ.0)THEN
  729. IARG=IARG+1
  730. IF(IARG.GT.9)CALL ARRET(0)
  731. CHAI=NOM
  732. WRITE(NOM,FMT='(A3,I1)')'ARG',IARG
  733. CALL ECMM(MTABX,NOM(1:4),CHAI)
  734. GO TO 110
  735. ELSE
  736. * MOT-CLÉ TROUVÉ => PLUS D'ARGUMENTS => ON MET À JOUR 'IARG'
  737. CALL ECME(MTABX,'IARG',IARG)
  738. C WRITE(IOIMP,*)' 1er gt2 nom=',nom
  739. GO TO 2
  740. ENDIF
  741.  
  742. ELSEIF(MTYP.EQ.'FLOTTANT')THEN
  743. CALL LIRREE(XVAL,1,IRET)
  744. IARG=IARG+1
  745. IF(IARG.GT.9)CALL ARRET(0)
  746. WRITE(NOM,FMT='(A3,I1)')'ARG',IARG
  747. CALL ECMF(MTABX,NOM(1:4),XVAL)
  748. GO TO 110
  749.  
  750. ELSEIF(MTYP.EQ.'ENTIER')THEN
  751. CALL LIRENT(IENT,1,IRET)
  752. IARG=IARG+1
  753. IF(IARG.GT.9)CALL ARRET(0)
  754. WRITE(NOM,FMT='(A3,I1)')'ARG',IARG
  755. CC XVAL=DBLE(IENT)
  756. CC CALL ECMF(MTABX,NOM(1:4),XVAL)
  757. CALL ECME(MTABX,NOM(1:4),IENT)
  758. GO TO 110
  759.  
  760. ELSEIF(MTYP.EQ.'POINT')THEN
  761. CALL LIROBJ('POINT',IZTAB,1,IRET)
  762. IARG=IARG+1
  763. IF(IARG.GT.9)CALL ARRET(0)
  764. WRITE(NOM,FMT='(A3,I1)')'ARG',IARG
  765. CALL ECMO(MTABX,NOM(1:4),'POINT',IZTAB)
  766. GO TO 110
  767.  
  768. ELSEIF(MTYP.EQ.'LOGIQUE ')THEN
  769. CALL LIRLOG(LOG1,1,IRET)
  770. IARG=IARG+1
  771. IF(IARG.GT.9)CALL ARRET(0)
  772. WRITE(NOM,FMT='(A3,I1)')'ARG',IARG
  773. CALL ECML(MTABX,NOM(1:4),LOG1)
  774. GO TO 110
  775.  
  776. ELSE
  777. CALL LIROBJ(MTYP,IZTAB,1,IRET)
  778. IARG=IARG+1
  779. IF(IARG.GT.9)RETURN
  780. WRITE(NOM,FMT='(A3,I1)')'ARG',IARG
  781. CALL ECMO(MTABX,NOM(1:4),MTYP,IZTAB)
  782. GO TO 110
  783.  
  784. ENDIF
  785.  
  786. C INCO
  787.  
  788. 12 CONTINUE
  789. C On crée si ce n'est pas déja fait la liste totale des inconnues
  790. C et on la complète
  791. TYPE=' '
  792. CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2)
  793. IF(TYPE.NE.'LISTMOTS')THEN
  794. JGN=4
  795. JGM=0
  796. NINCT=0
  797. SEGINI MLMOT2
  798. CALL ECMO(MTABLE,'LISTINCO','LISTMOTS',MLMOT2)
  799. SEGDES MLMOT2
  800. ENDIF
  801. SEGACT MLMOT2
  802. NINCT=MLMOT2.MOTS(/2)
  803. NINCT0=0
  804. SEGDES MLMOT2
  805.  
  806. C on crée la liste des inconnues associées à l'opérateur
  807. JGN=4
  808. JGM=0
  809. JG =0
  810. SEGINI MLMOTS,MLENT4
  811. * ECRITURE DE LA LISTE DES INCONNUES
  812. CALL ECMO(MTABX,'LISTINCO','LISTMOTS',MLMOTS)
  813. CALL ECMO(MTABX,'NUMEINCO','LISTENTI',MLENT4)
  814. SEGDES MLMOTS,MLENT4
  815. C on crée la liste des types d'inconnues associés à l'opérateur
  816. JGN=8
  817. JGM=0
  818. SEGINI MLMOT4
  819. * ECRITURE DE LA LISTE DES TYPES D'INCONNUES
  820. CALL ECMO(MTABX,'TYPEINCO','LISTMOTS',MLMOT4)
  821. SEGDES MLMOT4
  822.  
  823. 120 CONTINUE
  824. SEGDES MLMOTS,MLMOT2
  825. CALL LIRCHA(NOM,0,IRET)
  826. IF(IRET.EQ.0)THEN
  827. GO TO 90
  828. ENDIF
  829.  
  830. CALL OPTLI(IP,LMOTS,NOM,NBM)
  831.  
  832. IF(IP.EQ.2.OR.IP.EQ.3)THEN
  833. WRITE(IOIMP,*)' Il faut recommencer a la directive ZONE '
  834. RETURN
  835. ENDIF
  836. C WRITE(IOIMP,*)' EQEX : ',NOM,IP
  837.  
  838. IF(IP.EQ.0)THEN
  839.  
  840. NINCT0=NINCT0+1
  841. IF(NINCT0.GT.5)THEN
  842. WRITE(IOIMP,*)' Opérateur EQEX :'
  843. WRITE(IOIMP,*)' Le nombre d''inconnues semble important ',
  844. & NINCT0,' ? ',NOM
  845. ENDIF
  846.  
  847. JGN=4
  848. SEGACT MLMOTS
  849. JGM=MOTS(/2)+1
  850. SEGADJ MLMOTS
  851. C WRITE(IOIMP,*)' EQEX : ',NOM,' NINCT=',ninct
  852. MOTS(JGM)=NOM
  853.  
  854. C Cas directive EQUA
  855. IF(XEQUA)THEN
  856. TYPE=' '
  857. CALL ACMO(MTABLE,'TYPEINCO',TYPE,MLMOT3)
  858. IF(TYPE.NE.'LISTMOTS')THEN
  859. write(6,*)' Petit probleme Non prevu '
  860. RETURN
  861. ENDIF
  862. SEGACT MLMOT2,MLMOT3,MLMOT4,MLENT4
  863. NBIC=MLMOT2.MOTS(/2)
  864. DO 122 I=1,NBIC
  865.  
  866. IF(NOM.EQ.MLMOT2.MOTS(I))THEN
  867. JGN=8
  868. JG=JGM
  869. SEGADJ MLMOT4,MLENT4
  870. MLMOT4.MOTS(JGM)=MLMOT3.MOTS(I)
  871. MLENT4.LECT(JGM)=I
  872. GO TO 123
  873. ENDIF
  874. 122 CONTINUE
  875. C% L'inconnue : %m1:8 : n'apparait pas dans la liste des inconnues.
  876. MOTERR( 1: 8) = NOM
  877. CALL ERREUR(931)
  878. RETURN
  879.  
  880. 123 CONTINUE
  881. SEGDES MLMOT2,MLMOT3,MLMOT4,MLENT4
  882.  
  883.  
  884. ENDIF
  885. C On ecrit aussi directement dans MTABX NBINCO,INC1 INC2
  886. C etc comme pour les arguments
  887. C? NBINCO=JGM
  888. C? WRITE(CHAI,FMT='(A3,I1)')'INC',NBINCO
  889. C? CALL ECMM(MTABX,CHAI(1:4),NOM)
  890. C? CALL ECME(MTABX,'NBINCO',NBINCO)
  891.  
  892. SEGACT MLMOT2
  893. DO 121 I=1,NINCT
  894. C WRITE(IOIMP,*)' On cherche : ',MLMOT2.MOTS(I),NOM
  895. IF(MLMOT2.MOTS(I).EQ.NOM)GO TO 120
  896. 121 CONTINUE
  897. JGM=NINCT+1
  898. NINCT=NINCT+1
  899.  
  900. JGN=4
  901. SEGADJ MLMOT2
  902. MLMOT2.MOTS(JGM)=NOM
  903. GO TO 120
  904. ELSE
  905. SEGDES MLMOTS,MLMOT2
  906. C WRITE(IOIMP,*)' 2eme gt2 nom=',nom
  907. GO TO 2
  908. ENDIF
  909.  
  910. C CLIM
  911.  
  912. 13 CONTINUE
  913.  
  914. TYPE=' '
  915. CALL ACMO(MTABLE,'CLIM',TYPE,MCHPO1)
  916. IF(TYPE.NE.'CHPOINT')MCHPO1=0
  917.  
  918. CALL LIRCHA(NOMI,0,IRET)
  919. C WRITE(IOIMP,*)' MCHPO1=',mchpo1,' NOMI=',nomi
  920. IF(IRET.EQ.0)THEN
  921. GO TO 90
  922. ENDIF
  923. CALL OPTLI(IP,LMOTS,NOMI,NBM)
  924. IF(IP.NE.0)THEN
  925. NOM=NOMI
  926. C WRITE(IOIMP,*)' 3eme gt2 nom=',nom
  927. GO TO 2
  928. ENDIF
  929.  
  930. CALL LENCHA(NOMI,LCI)
  931.  
  932. CALL LIRMOT(MOIMP,NBL,IP,1)
  933. IF(IP.EQ.0)THEN
  934. WRITE(IOIMP,*)' Directive CLIM : '
  935. WRITE(IOIMP,*)' On attend un mot cle de la liste suivante :'
  936. $ ,MOIMP
  937. RETURN
  938. ENDIF
  939.  
  940. WRITE(NOML,FMT='(I1,A4)')IP,NOMI
  941. IF(IP.EQ.4)NOML=NOMI
  942. CALL LIROBJ('MAILLAGE',MELEME,1,IRET)
  943. IF(IRET.EQ.0)THEN
  944. GO TO 90
  945. ENDIF
  946.  
  947. CALL ECRCHA('POI1')
  948. CALL ECROBJ('MAILLAGE',MELEME)
  949. CALL PRCHAN
  950. CALL LIROBJ('MAILLAGE',MELEME,1,IRET)
  951. SEGACT MELEME
  952. N=NUM(/2)
  953. NAT=2
  954. NSOUPO=1
  955. NC=1
  956. SEGINI MCHPOI,MSOUPO,MPOVAL
  957. IFOPOI=IFOMOD
  958. MOCHDE=TITREE
  959. MTYPOI='CLIM'
  960. JATTRI(1)=2
  961. IPCHP(1)=MSOUPO
  962. C WRITE(IOIMP,*)' EQEX 1 : IPCHP,mchpoi=',IPCHP(1),mchpoi
  963. NOCOMP(1)=NOML(1:4)
  964. IGEOC=MELEME
  965. IPOVAL=MPOVAL
  966.  
  967. CALL QUETYP(MTYP,1,IRET)
  968.  
  969. if(mtyp.eq.'TABLE')THEN
  970. ikkt=0
  971. 1234 continue
  972. ikkt=ikkt+1
  973. WRITE(IOIMP,*)' ikkt=',ikkt
  974. if(ikkt.gt.100)return
  975. CALL LIROBJ('TABLE',IP,1,IRET)
  976. WRITE(IOIMP,*)' Petit incident '
  977. if(ip.ne.ktab(2))then
  978. WRITE(IOIMP,*)' Gros incident ',ip,ktab
  979. endif
  980. CALL QUETYP(MTYP,0,IRET)
  981. if(mtyp.eq.'TABLE')go to 1234
  982. endif
  983.  
  984. C WRITE(IOIMP,*)' MTYP a=',mtyp,iret,' N=',N
  985.  
  986. IF(MTYP.EQ.'FLOTTANT')THEN
  987. CALL LIRREE(XVAL,1,IRET)
  988. CALL INITD(VPOCHA,N,XVAL)
  989. SEGDES MPOVAL
  990. ELSEIF(MTYP.EQ.'ENTIER')THEN
  991. CALL LIRENT(IENT,1,IRET)
  992. XVAL=DBLE(IENT)
  993. CALL INITD(VPOCHA,N,XVAL)
  994. SEGDES MPOVAL
  995. ELSEIF(MTYP.EQ.'CHPOINT')THEN
  996. CALL LIROBJ('CHPOINT',MCHPO2,1,IRET)
  997. SEGACT MCHPO2
  998. NSP=MCHPO2.IPCHP(/1)
  999. CALL KRIPAD(MELEME,MLENTI)
  1000. SEGACT MELEME
  1001. DO 3569 L=1,NSP
  1002. MSOUP2=MCHPO2.IPCHP(L)
  1003. SEGACT MSOUP2
  1004. IGEOM=MSOUP2.IGEOC
  1005. MPOVA2=MSOUP2.IPOVAL
  1006. SEGACT IGEOM,MPOVA2
  1007. NBEL=IGEOM.NUM(/2)
  1008. DO 3568 I=1,NBEL
  1009. I1=IGEOM.NUM(1,I)
  1010. II1=LECT(I1)
  1011. IF(II1.EQ.0)GO TO 3568
  1012. VPOCHA(II1,1)=MPOVA2.VPOCHA(I,1)
  1013. 3568 CONTINUE
  1014. SEGDES MSOUP2,IGEOM,MPOVA2
  1015. 3569 CONTINUE
  1016. SEGSUP MLENTI
  1017. SEGDES MCHPO2
  1018.  
  1019. ELSE
  1020. WRITE(IOIMP,*)' TYPE NON ENCORE TRAITE'
  1021. RETURN
  1022. ENDIF
  1023. SEGDES MCHPOI,MSOUPO,MPOVAL
  1024.  
  1025. IF(MCHPO1.NE.0)THEN
  1026. CALL ECROBJ('CHPOINT',MCHPOI)
  1027. CALL ECROBJ('CHPOINT',MCHPO1)
  1028. CALL PRFUSE
  1029. CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
  1030. ENDIF
  1031. CALL ECMO(MTABLE,'CLIM','CHPOINT',MCHPOI)
  1032.  
  1033. GO TO 13
  1034.  
  1035. C ITMA
  1036.  
  1037. 14 CONTINUE
  1038. CALL LIRENT(IENT,1,IRET)
  1039. IF(IRET.EQ.0)THEN
  1040. WRITE(IOIMP,*)' MOT CLE ITMA (Nb maximum de pas de temps) :'
  1041. WRITE(IOIMP,*)' On attend un entier '
  1042. RETURN
  1043. ENDIF
  1044. CALL ECME(MTABLE,'ITMA',IENT)
  1045. GO TO 1
  1046.  
  1047. C ALFA
  1048.  
  1049. 15 CONTINUE
  1050. CALL LIRREE(XVAL,1,IRET)
  1051. IF(IRET.EQ.0)THEN
  1052. WRITE(IOIMP,*)' MOT CLE ALFA (Tolerance sur le pas de temps) :'
  1053. WRITE(IOIMP,*)' doit etre compris entre 0 et 1 (1 par defaut)'
  1054. WRITE(IOIMP,*)' On attend un flottant '
  1055. RETURN
  1056. ENDIF
  1057. CALL ECMF(MTABLE,'ALFA',XVAL)
  1058. GO TO 1
  1059.  
  1060. C DTI
  1061.  
  1062. 16 CONTINUE
  1063. CALL LIRREE(XVAL,1,IRET)
  1064. IF(IRET.EQ.0)THEN
  1065. WRITE(IOIMP,*)' MOT CLE DTI (Pas de temps iinitial) :'
  1066. WRITE(IOIMP,*)' On attend un flottant '
  1067. RETURN
  1068. ENDIF
  1069. DT=XVAL
  1070. CALL ECMF(MTABT,'DELTAT',DT)
  1071. CALL ECMF(MTABT,'DELTAT-1',DT)
  1072. GO TO 1
  1073.  
  1074. C IIMP
  1075.  
  1076. 17 CONTINUE
  1077.  
  1078. TYPE=' '
  1079. CALL ACMO(MTABLE,'IIMP',TYPE,MCHPO1)
  1080. IF(TYPE.NE.'CHPOINT')MCHPO1=0
  1081.  
  1082. CALL LIRCHA(NOMI,0,IRET)
  1083. IF(IRET.EQ.0)THEN
  1084. GO TO 90
  1085. ENDIF
  1086. CALL OPTLI(IP,LMOTS,NOMI,NBM)
  1087. IF(IP.NE.0)THEN
  1088. NOM=NOMI
  1089. C WRITE(IOIMP,*)' 4eme gt2 nom=',nom
  1090. GO TO 2
  1091. ENDIF
  1092.  
  1093. CALL LENCHA(NOMI,LCI)
  1094.  
  1095. CALL LIRMOT(MOIMP,NBL,IP,1)
  1096. IF(IP.EQ.0)THEN
  1097. WRITE(IOIMP,*)' Directive IIMP : '
  1098. WRITE(IOIMP,*)' On attend un mot cle de la liste suivante :'
  1099. $ ,MOIMP
  1100. RETURN
  1101. ENDIF
  1102. C WRITE(IOIMP,*)' MOIMP=',moimp(ip)
  1103.  
  1104. WRITE(NOML,FMT='(I1,A4)')IP,NOMI
  1105. IF(IP.EQ.4)NOML=NOMI
  1106.  
  1107. CALL LIROBJ('MAILLAGE',MELEME,1,IRET)
  1108. IF(IRET.EQ.0)THEN
  1109. GO TO 90
  1110. ENDIF
  1111.  
  1112. CALL ECRCHA('POI1')
  1113. CALL ECROBJ('MAILLAGE',MELEME)
  1114. CALL PRCHAN
  1115. CALL LIROBJ('MAILLAGE',MELEME,1,IRET)
  1116. SEGACT MELEME
  1117. N=NUM(/2)
  1118. NAT=2
  1119. NSOUPO=1
  1120. NC=1
  1121. SEGINI MCHPOI,MSOUPO,MPOVAL
  1122. IFOPOI=IFOMOD
  1123. MOCHDE=TITREE
  1124. MTYPOI='IIMP'
  1125. JATTRI(1)=2
  1126. IPCHP(1)=MSOUPO
  1127. C WRITE(IOIMP,*)' EQEX 2 : IPCHP,mchpoi=',IPCHP(1),mchpoi
  1128. NOCOMP(1)=NOML(1:4)
  1129. IGEOC=MELEME
  1130. IPOVAL=MPOVAL
  1131.  
  1132. CALL QUETYP(MTYP,1,IRET)
  1133. C WRITE(IOIMP,*)' MTYP=',mtyp
  1134.  
  1135. IF(MTYP.EQ.'FLOTTANT')THEN
  1136. CALL LIRREE(XVAL,1,IRET)
  1137. CALL INITD(VPOCHA,N,XVAL)
  1138. SEGDES MPOVAL
  1139. ELSEIF(MTYP.EQ.'ENTIER')THEN
  1140. CALL LIRENT(IENT,1,IRET)
  1141. XVAL=DBLE(IENT)
  1142. CALL INITD(VPOCHA,N,XVAL)
  1143. SEGDES MPOVAL
  1144. ELSE
  1145. WRITE(IOIMP,*)' TYPE NON ENCORE TRAITE'
  1146. RETURN
  1147. ENDIF
  1148. SEGDES MCHPOI,MSOUPO,MPOVAL
  1149.  
  1150. IF(MCHPO1.NE.0)THEN
  1151. CALL ECROBJ('CHPOINT',MCHPOI)
  1152. CALL ECROBJ('CHPOINT',MCHPO1)
  1153. CALL PRFUSE
  1154. CALL LIROBJ('CHPOINT',MCHPOI,1,IRET)
  1155. ENDIF
  1156. CALL ECMO(MTABLE,'IIMP','CHPOINT',MCHPOI)
  1157.  
  1158. GO TO 17
  1159.  
  1160. C DUMP
  1161.  
  1162. 18 CONTINUE
  1163. IDP=1
  1164. GO TO 1
  1165.  
  1166. C OPTI
  1167.  
  1168. 19 CONTINUE
  1169. C Définition des options par défaut
  1170. CALL CRTABL(KOPT1)
  1171. CALL ECMM(KOPT1,'SOUSTYPE','KOPT')
  1172.  
  1173. CALL ACME(KOPT,'IDCEN',IDCEN)
  1174. CALL ACME(KOPT,'RNG ',KRNG)
  1175. CALL ACME(KOPT,'IKOMP',IKOMP)
  1176. CALL ACME(KOPT,'KMACO',KMACO)
  1177. CALL ACMM(KOPT,'NMACO',NMACO)
  1178. CALL ACME(KOPT,'KIMPL',KIMPL)
  1179. CALL ACME(KOPT,'KFORM',KFORM)
  1180. CALL ACMF(KOPT,'AIMPL',AIMPL)
  1181. CALL ACME(KOPT,'ALE ',KALE)
  1182. CALL ACME(KOPT,'KMU',KMU)
  1183. CALL ACME(KOPT,'KPOIND',KPOIND)
  1184. CALL ACME(KOPT,'KPOIN',KPOIN)
  1185. CALL ACME(KOPT,'MTRMASS ',MTRMAS)
  1186. CALL ACME(KOPT,'IDEUL ',IDEUL)
  1187. CALL ACME(KOPT,'ISCHT',ISCHT)
  1188. CALL ACME(KOPT,'IDIV',IDIV)
  1189. CALL ACMF(KOPT,'CMD',CMD)
  1190. CALL ACMF(KOPT,'STABP',STAB)
  1191. CALL ACME(KOPT,'RIGIDITE',IRIG)
  1192. CALL ACME(KOPT,'LIMITE',LIMITE)
  1193. CALL ACMM(KOPT,'INEFMD',MNEFMD)
  1194.  
  1195. CALL ECME(KOPT1,'IDCEN',IDCEN)
  1196. CALL ECME(KOPT1,'RNG ',KRNG)
  1197. CALL ECME(KOPT1,'IKOMP',IKOMP)
  1198. CALL ECME(KOPT1,'KMACO',KMACO)
  1199. CALL ECMM(KOPT1,'NMACO',NMACO)
  1200. CALL ECME(KOPT1,'KIMPL',KIMPL)
  1201. CALL ECME(KOPT1,'KFORM',KFORM)
  1202. IF(KIMPL.EQ.1)AIMPL=1.D0
  1203. IF(KIMPL.EQ.0)AIMPL=0.D0
  1204. CALL ECMF(KOPT1,'AIMPL',AIMPL)
  1205. CALL ECME(KOPT1,'ALE',KALE)
  1206. CALL ECME(KOPT1,'KMU',KMU)
  1207. C? CALL ECME(KOPT1,'KPOIND',99)
  1208. CALL ECME(KOPT1,'KPOIND',KPOIND)
  1209. CALL ECME(KOPT1,'KPOIN',KPOIN)
  1210. CALL ECME(KOPT1,'MTRMASS ',MTRMAS)
  1211. CALL ECME(KOPT1,'IDEUL ',IDEUL)
  1212. CALL ECME(KOPT1,'ISCHT',ISCHT)
  1213. CALL ECME(KOPT1,'IDIV',IDIV)
  1214. CALL ECMF(KOPT1,'CMD',CMD)
  1215. CALL ECMF(KOPT1,'STABP',STAB)
  1216. CALL ECME(KOPT1,'RIGIDITE',IRIG)
  1217. CALL ECME(KOPT1,'LIMITE',LIMITE)
  1218. CALL ECMM(KOPT1,'INEFMD',MNEFMD)
  1219.  
  1220. KOPT=KOPT1
  1221.  
  1222. 191 CONTINUE
  1223. CALL LIRCHA(NOM,0,IRET)
  1224. IF(IRET.EQ.0)THEN
  1225. GO TO 90
  1226. ENDIF
  1227. CALL OPTLI(IP,LOPTI,NOM,NOPT)
  1228. IF(IP.EQ.0)THEN
  1229. CALL ECRCHA(NOM)
  1230. GO TO 1
  1231. ENDIF
  1232. C write(6,*)' NOM=',NOM,IP
  1233.  
  1234. GO TO (1901,1902,1903,1904,1905,1906,1907,1908,1909,1910,
  1235. & 1911,1912,1913,1914,1915,1916,1917,1918,1919,1920,
  1236. & 1921,1922,1923,1924,1925,1926,1927,1928,1929,1930,
  1237. & 1931,1932,1933,1934,1935,1936,1937,1938,1939,1940,
  1238. & 1941,1942,1943,1944,1945,1946,1947,1948,1949,1950,
  1239. & 1951,1952,1953,1954,1955,1956,1957,1958,1959,1960,
  1240. & 1961,1962,1963,1964,1965,1966,1967,1968,1969,1970,
  1241. & 1971,1972,1973,1974,1975 ),IP
  1242.  
  1243. C Formulation EFM1
  1244. 1901 CALL ECME(KOPT,'KFORM',0)
  1245. GO TO 191
  1246. C Formulation EF
  1247. 1902 CALL ECME(KOPT,'KFORM',1)
  1248. GO TO 191
  1249. C Formulation VF
  1250. 1903 CALL ECME(KOPT,'KFORM',2)
  1251. GO TO 191
  1252. C Formulation EFMC
  1253. 1904 CALL ECME(KOPT,'KFORM',3)
  1254. GO TO 191
  1255.  
  1256. C Emplacements libres pour une nouvelle formulation
  1257. 1905 CONTINUE
  1258. GO TO 191
  1259.  
  1260. C Formulation EF LINE
  1261. 1906 CALL ECMM(KOPT,'INEFMD','LINE')
  1262. GO TO 191
  1263. C Formulation EF MACRO
  1264. 1907 CALL ECMM(KOPT,'INEFMD','MACRO')
  1265. GO TO 191
  1266. C Formulation EF QUAF
  1267. 1908 CALL ECMM(KOPT,'INEFMD','QUAF')
  1268. GO TO 191
  1269. C Formulation EF LINB
  1270. 1909 CALL ECMM(KOPT,'INEFMD','LINB')
  1271. GO TO 191
  1272. C Formulation EF LINB
  1273. 1910 CALL ECMM(KOPT,'INEFMD','ISOQ')
  1274. GO TO 191
  1275.  
  1276. C CENTREE
  1277. 1911 CALL ECME(KOPT,'IDCEN',1)
  1278. GO TO 191
  1279. C SUPGDC
  1280. 1912 CALL ECME(KOPT,'IDCEN',2)
  1281. GO TO 191
  1282. C SUPG
  1283. 1913 CALL ECME(KOPT,'IDCEN',3)
  1284. GO TO 191
  1285. C Tenseur visqueux
  1286. 1914 CALL ECME(KOPT,'IDCEN',4)
  1287. GO TO 191
  1288. C Crank Nicholson généralisé
  1289. 1915 CALL ECME(KOPT,'IDCEN',5)
  1290. GO TO 191
  1291. C PSI
  1292. 1916 CALL ECME(KOPT,'IDCEN',6)
  1293. GO TO 191
  1294. C JOHNSON
  1295. 1917 CALL ECME(KOPT,'IDCEN',7)
  1296. GO TO 191
  1297. C UPWIND
  1298. 1918 CALL ECME(KOPT,'IDCEN',8)
  1299. GO TO 191
  1300. C GODUNOV
  1301. 1919 CALL ECME(KOPT,'IDCEN',9)
  1302. GO TO 191
  1303. C VANLEER
  1304. 1920 CALL ECME(KOPT,'IDCEN',10)
  1305. GO TO 191
  1306. C VLH (VAN LEER - HANEL)
  1307. 1921 CALL ECME(KOPT,'IDCEN',11)
  1308. GO TO 191
  1309. C HUSVL (VAN LEER + OSHER)
  1310. 1922 CALL ECME(KOPT,'IDCEN',12)
  1311. GOTO 191
  1312. C HUSVLH (VAN LEER - HANEL + OSHER)
  1313. 1923 CALL ECME(KOPT,'IDCEN',13)
  1314. GOTO 191
  1315. C AUSM (AUSM+)
  1316. 1924 CALL ECME(KOPT,'IDCEN',14)
  1317. GOTO 191
  1318. C CG Colella-Glaz
  1319. 1925 CALL ECME(KOPT,'IDCEN',15)
  1320. GOTO 191
  1321. C VSM Viscosité de sous-maille
  1322. 1926 CALL ECME(KOPT,'IDCEN',16)
  1323. GOTO 191
  1324. C VSMCC Viscosité de sous-maille Capture de choc
  1325. 1927 CALL ECME(KOPT,'IDCEN',17)
  1326. GOTO 191
  1327. C SUPGDCH
  1328. 1928 CALL ECME(KOPT,'IDCEN',18)
  1329. GOTO 191
  1330. C SUPGH
  1331. 1929 CALL ECME(KOPT,'IDCEN',19)
  1332. GOTO 191
  1333. C emplacements libres pour nouveaux schema
  1334. 1930 CONTINUE
  1335. GO TO 191
  1336.  
  1337. C sommet
  1338. 1931 CALL ECME(KOPT,'KPOIN',0)
  1339. GO TO 191
  1340. C face
  1341. 1932 CALL ECME(KOPT,'KPOIN',1)
  1342. GO TO 191
  1343. C centre
  1344. 1933 CALL ECME(KOPT,'KPOIN',2)
  1345. GO TO 191
  1346. C centrep0
  1347. 1934 CALL ECME(KOPT,'KPOIN',3)
  1348. GO TO 191
  1349. C centrep1
  1350. 1935 CALL ECME(KOPT,'KPOIN',4)
  1351. GO TO 191
  1352. C msommet
  1353. 1936 CALL ECME(KOPT,'KPOIN',5)
  1354. GO TO 191
  1355. C Emplacements libres pour de nouveaux points
  1356. 1937 CONTINUE
  1357. 1938 CONTINUE
  1358. 1939 CONTINUE
  1359. 1940 CONTINUE
  1360. GO TO 191
  1361.  
  1362. C Implicite
  1363. 1941 CALL ECME(KOPT,'KIMPL',1)
  1364. CALL ECMF(KOPT,'AIMPL',1.D0)
  1365. GO TO 191
  1366. C Explicite
  1367. 1942 CALL ECME(KOPT,'KIMPL',0)
  1368. CALL ECMF(KOPT,'AIMPL',0.D0)
  1369. GO TO 191
  1370. C Semi implicite
  1371. 1943 CALL ECME(KOPT,'KIMPL',2)
  1372. C? WRITE(IOIMP,*)' EQEX KIMPL mis a 2 '
  1373. CALL QUETYP(MTYP,0,IRET)
  1374. IF(MTYP.EQ.'FLOTTANT')THEN
  1375. CALL LIRREE(AIMPL,0,IRET)
  1376. CALL ECMF(KOPT,'AIMPL',AIMPL)
  1377. ELSE
  1378. CALL ECMF(KOPT,'AIMPL',0.5D0)
  1379. ENDIF
  1380. GO TO 191
  1381. C Schema en temps implicite 2eme ordre BDF2
  1382. 1944 CALL ECME(KOPT,'ISCHT',1)
  1383. GO TO 191
  1384. C Schema en temps implicite 4eme ordre BDF4
  1385. 1945 CALL ECME(KOPT,'ISCHT',2)
  1386. GO TO 191
  1387. C Rajout du terme 1/2 T Div U pour stabiliser (par defaut 0)
  1388. 1946 CALL ECME(KOPT,'IDIV',1)
  1389. GO TO 191
  1390. C Coefficient multiplicateur du decentrement (par defaut 1.)
  1391. 1947 CONTINUE
  1392. CALL QUETYP(MTYP,0,IRET)
  1393. IF(MTYP.EQ.'FLOTTANT')THEN
  1394. CALL LIRREE(CMD,0,IRET)
  1395. IF(IRET.EQ.0)THEN
  1396. GO TO 90
  1397. ENDIF
  1398. CALL ECMF(KOPT,'CMD',CMD)
  1399. ELSE
  1400. RETURN
  1401. ENDIF
  1402. GO TO 191
  1403. C Format des matrices RIGIDITE IRIG = 1 MATRIK IRIG = 0 defaut
  1404. 1948 CONTINUE
  1405. CALL ECME(KOPT,'RIGIDITE',1)
  1406. GO TO 191
  1407. C LIMITE Limiteur divers active (Kepsilon ou autre)
  1408. 1949 CONTINUE
  1409. CALL ECME(KOPT,'LIMITE',1)
  1410. GO TO 191
  1411. C NODIV
  1412. 1950 CONTINUE
  1413. CALL ECME(KOPT,'IDIV',0)
  1414. GO TO 191
  1415. C Emplacements libres pour de nouveaux Schéma
  1416.  
  1417. C Formulation conservative
  1418. 1951 CALL ECME(KOPT,'IKOMP',1)
  1419. C Formulation non conservative
  1420. GO TO 191
  1421. 1952 CALL ECME(KOPT,'IKOMP',0)
  1422. GO TO 191
  1423. 1953 CALL ECME(KOPT,'IKOMP',2)
  1424. GO TO 191
  1425. 1954 CALL ECME(KOPT,'RNG ',2)
  1426. GO TO 191
  1427. 1955 CALL ECME(KOPT,'ALE',1)
  1428. GO TO 191
  1429. C Matrice masse pleine
  1430. 1956 CALL ECME(KOPT,'MTRMASS ',1)
  1431. GO TO 191
  1432. C Matrice masse diagonale
  1433. 1957 CALL ECME(KOPT,'MTRMASS ',2)
  1434. GO TO 191
  1435. C Matrice masse consistante (Petrov Galerkin) pour le terme source
  1436. 1958 CALL ECME(KOPT,'MTRMASS ',3)
  1437. GO TO 191
  1438. C Matrice CONSTANTE
  1439. 1959 CALL ECME(KOPT,'KMACO',1)
  1440. CALL LIRCHA(CHAI,1,LCHAR)
  1441. IF(LCHAR.EQ.0)THEN
  1442. C On ne trouve pas d'objet de type %m1:8
  1443. MOTERR( 1: 8) = 'MOT'
  1444. CALL ERREUR(38)
  1445. RETURN
  1446. ENDIF
  1447. NMACO=CHAI(1:LCHAR)
  1448. CALL ECMM(KOPT,'NMACO',NMACO)
  1449. GO TO 191
  1450. C Emplacement libre pour de nouvelles idées (il faudra etre concis)
  1451. 1960 CONTINUE
  1452. GO TO 191
  1453.  
  1454. C Indices IDEUL
  1455. C EULER
  1456. 1961 CALL ECME(KOPT,'IDEUL',1)
  1457. GO TO 191
  1458. C EULERMS
  1459. 1962 CALL ECME(KOPT,'IDEUL',2)
  1460. GO TO 191
  1461. C EULERMST
  1462. 1963 CALL ECME(KOPT,'IDEUL',3)
  1463. GO TO 191
  1464. C Emplacements libres pour de nouveaux Schéma
  1465. 1964 CONTINUE
  1466. 1965 CONTINUE
  1467. GO TO 191
  1468. C Indices KPOIND
  1469. 1966 CONTINUE
  1470. CALL LIRCHA(NOM,0,IRET)
  1471. IF(IRET.EQ.0)THEN
  1472. GO TO 90
  1473. ENDIF
  1474. CALL OPTLI(IP,LOPTI(31),NOM,6)
  1475. IF(IP.EQ.0)THEN
  1476. GO TO 90
  1477. ELSE
  1478. CALL ECME(KOPT,'KPOIND',IP-1)
  1479. ENDIF
  1480. GO TO 191
  1481.  
  1482. C Emplacements libres
  1483. 1967 CONTINUE
  1484. GO TO 191
  1485.  
  1486. 1968 CONTINUE
  1487. C Indice STABP
  1488. CALL LIRREE(STAB,0,IRET)
  1489. IF(IRET.EQ.0)THEN
  1490. GO TO 90
  1491. ENDIF
  1492. CALL ECMF(KOPT,'STABP',STAB)
  1493. GO TO 191
  1494.  
  1495. C MUCONS mu constant par élément
  1496. 1969 CALL ECME(KOPT,'KMU',0)
  1497. GO TO 191
  1498.  
  1499. C FTAU mu variable par élément (formulation en grad mu)
  1500. 1970 CALL ECME(KOPT,'KMU',1)
  1501. GO TO 191
  1502.  
  1503. C MUVARI Formulation en Tau
  1504. 1971 CALL ECME(KOPT,'KMU',2)
  1505. GO TO 191
  1506.  
  1507. C Emplacements libres
  1508. 1972 CONTINUE
  1509. 1973 CONTINUE
  1510. 1974 CONTINUE
  1511. 1975 CONTINUE
  1512. GO TO 191
  1513.  
  1514.  
  1515. C OPTI
  1516.  
  1517. 20 CONTINUE
  1518. CALL LIRCHA(NOM,0,IRET)
  1519. IF(IRET.EQ.0)GO TO 90
  1520. CALL ECMM(MTABLE,'NOMVI',NOM)
  1521. GO TO 1
  1522.  
  1523. C ' '
  1524.  
  1525. 21 CONTINUE
  1526. C WRITE(IOIMP,*)' nbik=',nbik
  1527. NBIK=NBIK+1
  1528. CALL LIRCHA(NOM,0,IRET)
  1529. C WRITE(IOIMP,*)' NOM=',nom,iret
  1530. IF(IRET.EQ.0)GO TO 90
  1531. TINCD(NBIK)=NOM
  1532. CALL LITABS(LTAB,KTAB,1,1,IRET)
  1533. C WRITE(IOIMP,*)' iret=',iret
  1534. IF(IRET.EQ.0)THEN
  1535. WRITE(IOIMP,*)' On attend un objet TABLE DOMAINE'
  1536. RETURN
  1537. ENDIF
  1538. KINCD(NBIK)=KTAB(1)
  1539.  
  1540. GO TO 1
  1541.  
  1542. C TPSI
  1543.  
  1544. 22 CONTINUE
  1545. CALL LIRREE(XVAL,1,IRET)
  1546. IF(IRET.EQ.0)THEN
  1547. WRITE(IOIMP,*)' MOT CLE TPSI (Instant initial) :'
  1548. WRITE(IOIMP,*)' On attend un flottant '
  1549. RETURN
  1550. ENDIF
  1551. CALL ECMF(MTABLE,'TPSI',XVAL)
  1552. GO TO 1
  1553.  
  1554. C TFINAL
  1555.  
  1556. 23 CONTINUE
  1557. CALL LIRREE(XVAL,1,IRET)
  1558. IF(IRET.EQ.0)THEN
  1559. WRITE(IOIMP,*)' MOT CLE TFINAL (Temps final) :'
  1560. WRITE(IOIMP,*)' On attend un flottant '
  1561. RETURN
  1562. ENDIF
  1563. CALL ECMF(MTABLE,'TFINAL',XVAL)
  1564. GO TO 1
  1565.  
  1566. C FIDT
  1567.  
  1568. 24 CONTINUE
  1569. CALL LIRENT(IENT,1,IRET)
  1570. IF(IRET.EQ.0)THEN
  1571. WRITE(IOIMP,*)' MOT CLE FIDT (Frequence impression temps) :'
  1572. WRITE(IOIMP,*)' On attend un entier '
  1573. RETURN
  1574. ENDIF
  1575. CALL ECME(MTABLE,'FIDT',IENT)
  1576. GO TO 1
  1577.  
  1578. C NISTO
  1579.  
  1580. 25 CONTINUE
  1581. CALL LIRENT(IENT,1,IRET)
  1582. IF(IRET.EQ.0)THEN
  1583. WRITE(IOIMP,*)' MOT CLE NISTO (Frequence saisie historique) :'
  1584. WRITE(IOIMP,*)' On attend un entier '
  1585. RETURN
  1586. ENDIF
  1587. CALL ECME(MTABLE,'NISTO',IENT)
  1588. GO TO 1
  1589.  
  1590. C NITER
  1591.  
  1592. 26 CONTINUE
  1593. CALL LIRENT(IENT,1,IRET)
  1594. IF(IRET.EQ.0)THEN
  1595. WRITE(IOIMP,*)' MOT CLE NITER (Nombre iterations internes) :'
  1596. WRITE(IOIMP,*)' On attend un entier '
  1597. RETURN
  1598. ENDIF
  1599. CALL ECME(MTABLE,'NITER',IENT)
  1600. GO TO 1
  1601.  
  1602. C OMEGA
  1603.  
  1604. 27 CONTINUE
  1605. CALL LIRREE(XVAL,1,IRET)
  1606. IF(IRET.EQ.0)THEN
  1607. WRITE(IOIMP,*)' MOT CLE OMEGA (Facteur de relaxation) :'
  1608. WRITE(IOIMP,*)' On attend un flottant '
  1609. RETURN
  1610. ENDIF
  1611. CALL ECMF(MTABLE,'OMEGA',XVAL)
  1612. GO TO 1
  1613.  
  1614. C EPS
  1615.  
  1616. 28 CONTINUE
  1617. CALL LIRREE(XVAL,1,IRET)
  1618. IF(IRET.EQ.0)THEN
  1619. WRITE(IOIMP,*)' MOT CLE EPS (Tolerance sur le residu) :'
  1620. WRITE(IOIMP,*)' On attend un flottant '
  1621. RETURN
  1622. ENDIF
  1623. CALL ECMF(MTABLE,'EPS',XVAL)
  1624. GO TO 1
  1625.  
  1626. C IMPR
  1627.  
  1628. 29 CONTINUE
  1629. CALL LIRENT(IENT,1,IRET)
  1630. IF(IRET.EQ.0)THEN
  1631. WRITE(IOIMP,*)' MOT CLE IMPR (Niveau d impression) :'
  1632. WRITE(IOIMP,*)' On attend un entier '
  1633. RETURN
  1634. ENDIF
  1635. CALL ECME(MTABLE,'IMPR',IENT)
  1636. GO TO 1
  1637.  
  1638. 90 CONTINUE
  1639.  
  1640. TYPE=' '
  1641. CALL ACMO(MTABLE,'DOMAINE',TYPE,MTABD)
  1642. IF(TYPE.NE.'TABLE')GO TO 900
  1643. TYPE=' '
  1644. CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2)
  1645.  
  1646. IF(MLMOT2.NE.0)THEN
  1647.  
  1648. SEGACT MLMOT2
  1649. NINCT=MLMOT2.MOTS(/2)
  1650.  
  1651. TYPE=' '
  1652. CALL ACMO(MTABLE,'DOMINC',TYPE,MTABI)
  1653. IF(TYPE.EQ.'TABLE')THEN
  1654.  
  1655. DO 93 I=1,NINCT
  1656. NOMI=MLMOT2.MOTS(I)
  1657. TYPE=' '
  1658. CALL ACMO(MTABI,NOMI,TYPE,IPT)
  1659. IF(TYPE.NE.'TABLE')CALL ECMO(MTABI,NOMI,'TABLE',MTABD)
  1660. 93 CONTINUE
  1661. DO 94 I=1,NBIK
  1662. NOMI=TINCD(NBIK)
  1663. CALL ECMO(MTABI,NOMI,'TABLE',KINCD(NBIK))
  1664. 94 CONTINUE
  1665.  
  1666. ELSE
  1667.  
  1668. CALL CRTABL(MTABI)
  1669. CALL ECMO(MTABLE,'DOMINC','TABLE',MTABI)
  1670. DO 91 I=1,NINCT
  1671. NOMI=MLMOT2.MOTS(I)
  1672. CALL ECMO(MTABI,NOMI,'TABLE',MTABD)
  1673. 91 CONTINUE
  1674. DO 92 I=1,NBIK
  1675. NOMI=TINCD(NBIK)
  1676. CALL ECMO(MTABI,NOMI,'TABLE',KINCD(NBIK))
  1677. 92 CONTINUE
  1678.  
  1679. ENDIF
  1680. SEGDES MLMOT2
  1681. ENDIF
  1682.  
  1683. 900 CONTINUE
  1684. CALL ECROBJ('TABLE',MTABLE)
  1685. C write(6,*)' RETOUR EQEX '
  1686. RETURN
  1687. END
  1688.  
  1689.  
  1690.  
  1691.  
  1692.  
  1693.  
  1694.  
  1695.  
  1696.  
  1697.  
  1698.  
  1699.  
  1700.  
  1701.  
  1702.  
  1703.  
  1704.  
  1705.  
  1706.  
  1707.  
  1708.  
  1709.  

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