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

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