Télécharger eqex.eso

Retour à la liste

Numérotation des lignes :

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

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