Télécharger eqex.eso

Retour à la liste

Numérotation des lignes :

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

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