Télécharger prkres.eso

Retour à la liste

Numérotation des lignes :

  1. C PRKRES SOURCE GOUNAND 19/07/03 21:15:08 10248
  2. SUBROUTINE PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,
  3. $ MAPREC,
  4. $ MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID,
  5. $ BRTOL,IRSTRT,KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,LBCG,
  6. $ ICALRS,METASS,LTIME,LDEPE,MRIGID,IDDOT,IMVEC,IRET)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM : PRKRES
  11. C DESCRIPTION :
  12. C Lecture des arguments et mise à défaut des optionnels ()
  13. C
  14. C MATRIK : La matrice lue en entrée au format MATRIK
  15. C MTINV : L'éventuelle table d'inversion (obsolète)
  16. C IMPR : Niveau d'impression solveur direct
  17. C KCLIM : Chpoint éventuel de conditions aux limites de Dirichlet
  18. C KSMBR : Chpoint second membre
  19. C KTYPI : Type de méthode de résolution
  20. C MATASS : Matrice utilisée pour préconditionner l'assemblage
  21. C MAPREC : Matrice utilisée pour préconditionner la construction du
  22. C préconditionneur
  23. C MRENU : Type de renumérotation
  24. C MMULAG : Placement des multiplicateurs de Lagrange
  25. C ISCAL : Scaling de la matrice
  26. C INORMU : Mise à l'échelle des multiplicateurs de Lagrange
  27. C IOUBL : Oubli des matrices élémentaires ?
  28. C IMPINV : Niveau d'impression solveur itératif
  29. C MCHINI : Chpoint estimation de l'inconnue
  30. C ITER : Nombre maxi d'itérations à effectuer
  31. C RESID : Norme L2 maxi du résidu
  32. C BRTOL : Breakdown tolerance pour les méthodes de type Bi-CG
  33. C IRSTRT : Paramètre m de redémarrage pour GMRES
  34. C KPREC : Type du préconditionneur
  35. C RXMILU : Paramètre de relaxation pour MILU(0)
  36. C RXILUP : Paramètre de filtre pour ILU(0)-PV
  37. C XLFIL : Paramètre de remplissage pour les préconditionneurs ILUT
  38. C XDTOL : Drop tolerance pour les préconditionneurs ILUT
  39. C XSPIV : Sensibilité du pivoting pour les préconditionneurs ILUTP
  40. C LBCG : le l dans BicgStab(l)
  41. C ICALRS : façon de calculer le résidu
  42. C METASS : méthode d'assemblage
  43. C LTIME : construit une table avec des statistiques temporelles
  44. C si vrai
  45. C LDEPE : élimine les dépendances si VRAI
  46. C et matrice d'entrée RIGIDITE
  47. C IDDOT : 0 => utilisation du produit scalaire normal dans les
  48. C méthodes itératives
  49. C 1 => utilisation du produit scalaire compensé
  50. C IMVEC : 0, pas de parallélisme pour les produits matrice-vecteur
  51. C 1, parallélisme stratégie 1, entrelace les lignes.
  52. C 2, parallélisme stratégie 2, groupe les lignes.
  53. C Par defaut : 2
  54. C
  55. C LANGAGE : ESOPE
  56. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  57. C mél : gounand@semt2.smts.cea.fr
  58. C***********************************************************************
  59. C APPELES :
  60. C APPELES (E/S) :
  61. C APPELES (BLAS) :
  62. C APPELES (CALCUL) :
  63. C APPELE PAR :
  64. C***********************************************************************
  65. C SYNTAXE GIBIANE :
  66. C ENTREES :
  67. C ENTREES/SORTIES :
  68. C SORTIES :
  69. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  70. C***********************************************************************
  71. C VERSION : v1, 22/02/2006, version initiale
  72. C HISTORIQUE : v1, 22/02/2006, création
  73. C HISTORIQUE :
  74. C HISTORIQUE :
  75. C***********************************************************************
  76. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  77. C en cas de modification de ce sous-programme afin de faciliter
  78. C la maintenance !
  79. C***********************************************************************
  80. -INC CCREEL
  81. -INC CCOPTIO
  82. -INC SMCHPOI
  83. POINTEUR KCLIM.MCHPOI
  84. POINTEUR KSMBR.MCHPOI
  85. POINTEUR MCHINI.MCHPOI
  86. POINTEUR MCHSOL.MCHPOI
  87. -INC SMTABLE
  88. POINTEUR MTINV.MTABLE
  89. *-INC SMMATRIK
  90. * POINTEUR MAPREC.MATRIK
  91. * POINTEUR MATASS.MATRIK
  92. -INC SMRIGID
  93. -INC SMELEME
  94. *
  95. INTEGER KTYPI,ISCAL,INORMU,IOUBL,IMPINV,ITER,IRSTRT,KPREC
  96. REAL*8 RESID,BRTOL,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV
  97. CHARACTER*4 MRENU,MMULAG
  98. *
  99. CHARACTER*8 TYPI,TYPR,TYP2,BLAN,TYPE,MTYP
  100. CHARACTER*8 TYTABL,TYLMOT,TYCHPO,TYMOT,TYENT,TYFLO,TYLENT
  101. CHARACTER*8 TYMATK,TYRIGI,INDTAB,TYLOG
  102. *
  103. INTEGER IBID,IVAL,IOBJ
  104. REAL*8 XBID,XVAL
  105. CHARACTER*4 CBID,CVAL
  106. LOGICAL LBID,LVAL,LTIME,LMRENU,LMETAS,LDEPE,LLDEPE
  107. LOGICAL LMUANO,LNORMA
  108. *
  109. INTEGER IMPR,IRET
  110. PARAMETER (NMOT=31)
  111. CHARACTER*8 MOTSCL(NMOT),TYARG(NMOT)
  112. C CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  113. C $ MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
  114. C $ IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,IMPR,IRET)
  115. DATA MOTSCL/
  116. $ 'IMPR ','TYPI ','CLIM ','SMBR ','TYPINV ',
  117. $ 'MATASS ','MAPREC ','TYRENU ','PCMLAG ','SCALING ',
  118. $ 'SCALAG ',
  119. $ 'OUBMAT ','IMPINV ','XINIT ','NITMAX ','RESID ',
  120. $ 'BCGSBTOL','GMRESTRT','PRECOND ','MILURELX','ILUTLFIL',
  121. $ 'ILUTDTOL','ILUTPPIV','LBCG ','CALRES ','METASS ',
  122. $ 'LTIME ','LDEPE ','ILUPRELX','IDDOT ','IMVEC '/
  123. DATA TYARG/
  124. $ 'ENTIER ','TABLE ','CHPOINT ','CHPOINT ','ENTIER ',
  125. $ 'MATRIK ','MATRIK ','MOT ','MOT ','ENTIER ',
  126. $ 'ENTIER ',
  127. $ 'ENTIER ','ENTIER ','CHPOINT ','ENTIER ','FLOTTANT',
  128. $ 'FLOTTANT','ENTIER ','ENTIER ','FLOTTANT','FLOTTANT',
  129. $ 'FLOTTANT','FLOTTANT','ENTIER ','ENTIER ','ENTIER ',
  130. $ 'LOGIQUE ','LOGIQUE ','FLOTTANT','ENTIER ','ENTIER '/
  131. DATA TYTABL,TYCHPO,TYMOT,TYENT,TYFLO,TYMATK,TYRIGI,BLAN,TYLOG/
  132. $ 'TABLE ','CHPOINT ','MOT ','ENTIER ','FLOTTANT',
  133. $ 'MATRIK ','RIGIDITE',' ','LOGIQUE '
  134. $ /
  135. *
  136. * Executable statements
  137. *
  138. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prkres.eso'
  139. *
  140. * Lecture de la matrice
  141. *
  142. TYPE=BLAN
  143. CALL QUETYP(TYPE,1,IRET)
  144. IF (IRET.EQ.0) GOTO 9999
  145. IF (TYPE.EQ.TYRIGI) THEN
  146. MATRIK=0
  147. CALL LIROBJ(TYPE,MRIGID,1,IRET)
  148. * WRITE(IOIMP,*) 'Ap MACHI2'
  149. * WRITE(IOIMP,*) 'Non implémenté'
  150. * GOTO 9999
  151. ELSE
  152. MRIGID=0
  153. TYPE=TYMATK
  154. CALL LIROBJ(TYPE,MATRIK,1,IRET)
  155. IF(IRET.EQ.0) GOTO 9999
  156. ENDIF
  157. *
  158. * Lecture du second membre éventuel
  159. *
  160. KSMBR=0
  161. CALL QUETYP(TYPE,1,IRET)
  162. IF (TYPE.EQ.TYCHPO) THEN
  163. CALL LIROBJ(TYPE,KSMBR,1,IRET)
  164. IF(IRET.EQ.0) GOTO 9999
  165. ENDIF
  166. *
  167. * Valeurs par défaut
  168. *
  169. C CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  170. C $ MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
  171. C $ IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET)
  172. MTINV=0
  173. IMPR=0
  174. KCLIM=0
  175. KTYPI=1
  176. MATASS=MATRIK
  177. MAPREC=MATRIK
  178. MRENU='SLOA'
  179. LMRENU=.FALSE.
  180. MMULAG='APR2'
  181. ISCAL=0
  182. INORMU=1
  183. IF (MRIGID.NE.0) THEN
  184. IOUBL=1
  185. ELSE
  186. IOUBL=0
  187. ENDIF
  188. IMPINV=0
  189. MCHINI=0
  190. ITER=2000
  191. RESID=1.D-10
  192. BRTOL=1.D-40
  193. IRSTRT=50
  194. KPREC=3
  195. RXMILU=1.D0
  196. RXILUP=0.5D0
  197. XLFIL=2.D0
  198. XDTOL=-1.D0
  199. XSPIV=0.1D0
  200. LBCG=4
  201. ICALRS=0
  202. METASS=5
  203. LMETAS=.FALSE.
  204. LTIME=.FALSE.
  205. LDEPE=.TRUE.
  206. LLDEPE=.FALSE.
  207. IDDOT=0
  208. IMVEC=2
  209. ith=oothrd
  210. IF(ITH.NE.0)THEN
  211. IMVEC=0
  212. ENDIF
  213. *
  214. * Boucle de lecture des arguments
  215. *
  216. 1 CONTINUE
  217. CALL LIRMOT(MOTSCL,NMOT,IRAN,0)
  218. IF(IRAN.EQ.0) GOTO 2
  219. IF (IRAN.EQ.2) THEN
  220. CALL LIRTAB('METHINV',MTINV,1,IRET)
  221. IF (IRET.EQ.0) GOTO 9999
  222. *
  223. * Lectures des indices de table
  224. *
  225. * WRITE(IOIMP,*) 'Lecture de la table'
  226. DO I=1,NMOT
  227. TYPI=TYMOT
  228. TYPR=BLAN
  229. TYPE=TYARG(I)
  230. INDTAB=MOTSCL(I)
  231. * WRITE(IOIMP,*) 'INDTAB=',INDTAB
  232. CALL ACCTAB(MTINV,TYPI,IBID,XBID,INDTAB,LBID,IBID,
  233. $ TYPR,IVAL,XVAL,CVAL,LVAL,IOBJ)
  234. IF (IERR.NE.0) GOTO 9999
  235. IF (TYPR.NE.TYPE) THEN
  236. IF (TYPR.EQ.TYENT.AND.TYPE.EQ.TYFLO) THEN
  237. XVAL=IVAL
  238. ELSEIF (TYPR.NE.BLAN) THEN
  239. WRITE(IOIMP,*) 'Index ',INDTAB,' : ',TYPR,
  240. $ ' type object instead of ',TYPE
  241. GOTO 9999
  242. ENDIF
  243. ENDIF
  244. IF (TYPR.NE.BLAN) THEN
  245. IF (I.EQ.1) THEN
  246. IMPR=IVAL
  247. * I.EQ.2 n'a pas de sens
  248. ELSEIF (I.EQ.3) THEN
  249. KCLIM=IOBJ
  250. ELSEIF (I.EQ.4) THEN
  251. KSMBR=IOBJ
  252. ELSEIF (I.EQ.5) THEN
  253. KTYPI=IVAL
  254. ELSEIF (I.EQ.6) THEN
  255. MATASS=IOBJ
  256. ELSEIF (I.EQ.7) THEN
  257. MAPREC=IOBJ
  258. ELSEIF (I.EQ.8) THEN
  259. MRENU=CVAL
  260. LMRENU=.TRUE.
  261. ELSEIF (I.EQ.9) THEN
  262. MMULAG=CVAL
  263. ELSEIF (I.EQ.10) THEN
  264. ISCAL=IVAL
  265. ELSEIF (I.EQ.11) THEN
  266. INORMU=IVAL
  267. ELSEIF (I.EQ.12) THEN
  268. IOUBL=IVAL
  269. ELSEIF (I.EQ.13) THEN
  270. IMPINV=IVAL
  271. ELSEIF (I.EQ.14) THEN
  272. MCHINI=IOBJ
  273. ELSEIF (I.EQ.15) THEN
  274. ITER=IVAL
  275. ELSEIF (I.EQ.16) THEN
  276. RESID=XVAL
  277. ELSEIF (I.EQ.17) THEN
  278. BRTOL=XVAL
  279. ELSEIF (I.EQ.18) THEN
  280. IRSTRT=IVAL
  281. ELSEIF (I.EQ.19) THEN
  282. KPREC=IVAL
  283. ELSEIF (I.EQ.20) THEN
  284. RXMILU=XVAL
  285. ELSEIF (I.EQ.21) THEN
  286. XLFIL=XVAL
  287. ELSEIF (I.EQ.22) THEN
  288. XDTOL=XVAL
  289. ELSEIF (I.EQ.23) THEN
  290. XSPIV=XVAL
  291. ELSEIF (I.EQ.24) THEN
  292. LBCG=IVAL
  293. ELSEIF (I.EQ.25) THEN
  294. ICALRS=IVAL
  295. ELSEIF (I.EQ.26) THEN
  296. METASS=IVAL
  297. LMETAS=.TRUE.
  298. ELSEIF (I.EQ.27) THEN
  299. LTIME=LVAL
  300. ELSEIF (I.EQ.28) THEN
  301. LDEPE=LVAL
  302. * On l'avait oublié ?
  303. LLDEPE=.TRUE.
  304. ELSEIF (I.EQ.29) THEN
  305. RXILUP=XVAL
  306. ELSEIF (I.EQ.30) THEN
  307. IDDOT=IVAL
  308. ELSEIF (I.EQ.31) THEN
  309. IMVEC=IVAL
  310. ELSE
  311. WRITE(IOIMP,*) 'Programing error'
  312. CALL ERREUR(5)
  313. GOTO 9999
  314. ENDIF
  315. ENDIF
  316. ENDDO
  317. ELSE
  318. TYPE=TYARG(IRAN)
  319. IF (TYPE.EQ.TYENT) THEN
  320. CALL LIRENT(IVAL,1,IRET)
  321. ELSEIF (TYPE.EQ.TYFLO) THEN
  322. CALL LIRREE(XVAL,1,IRET)
  323. ELSEIF (TYPE.EQ.TYMOT) THEN
  324. CALL LIRCHA(CVAL,1,IRET)
  325. ELSEIF (TYPE.EQ.TYLOG) THEN
  326. CALL LIRLOG(LVAL,1,IRET)
  327. ELSE
  328. CALL LIROBJ(TYPE,IOBJ,1,IRET)
  329. ENDIF
  330. IF (IRET.EQ.0) GOTO 9999
  331. IF (IRAN.EQ.1) THEN
  332. IMPR=IVAL
  333. * I.EQ.2 n'a pas de sens
  334. ELSEIF (IRAN.EQ.3) THEN
  335. KCLIM=IOBJ
  336. ELSEIF (IRAN.EQ.4) THEN
  337. KSMBR=IOBJ
  338. ELSEIF (IRAN.EQ.5) THEN
  339. KTYPI=IVAL
  340. ELSEIF (IRAN.EQ.6) THEN
  341. MATASS=IOBJ
  342. ELSEIF (IRAN.EQ.7) THEN
  343. MAPREC=IOBJ
  344. ELSEIF (IRAN.EQ.8) THEN
  345. MRENU=CVAL
  346. LMRENU=.TRUE.
  347. ELSEIF (IRAN.EQ.9) THEN
  348. MMULAG=CVAL
  349. ELSEIF (IRAN.EQ.10) THEN
  350. ISCAL=IVAL
  351. ELSEIF (IRAN.EQ.11) THEN
  352. INORMU=IVAL
  353. ELSEIF (IRAN.EQ.12) THEN
  354. IOUBL=IVAL
  355. ELSEIF (IRAN.EQ.13) THEN
  356. IMPINV=IVAL
  357. ELSEIF (IRAN.EQ.14) THEN
  358. MCHINI=IOBJ
  359. ELSEIF (IRAN.EQ.15) THEN
  360. ITER=IVAL
  361. ELSEIF (IRAN.EQ.16) THEN
  362. RESID=XVAL
  363. ELSEIF (IRAN.EQ.17) THEN
  364. BRTOL=XVAL
  365. ELSEIF (IRAN.EQ.18) THEN
  366. IRSTRT=IVAL
  367. ELSEIF (IRAN.EQ.19) THEN
  368. KPREC=IVAL
  369. ELSEIF (IRAN.EQ.20) THEN
  370. RXMILU=XVAL
  371. ELSEIF (IRAN.EQ.21) THEN
  372. XLFIL=XVAL
  373. ELSEIF (IRAN.EQ.22) THEN
  374. XDTOL=XVAL
  375. ELSEIF (IRAN.EQ.23) THEN
  376. XSPIV=XVAL
  377. ELSEIF (IRAN.EQ.24) THEN
  378. LBCG=IVAL
  379. ELSEIF (IRAN.EQ.25) THEN
  380. ICALRS=IVAL
  381. ELSEIF (IRAN.EQ.26) THEN
  382. METASS=IVAL
  383. LMETAS=.TRUE.
  384. ELSEIF (IRAN.EQ.27) THEN
  385. LTIME=LVAL
  386. ELSEIF (IRAN.EQ.28) THEN
  387. LDEPE=LVAL
  388. LLDEPE=.TRUE.
  389. ELSEIF (IRAN.EQ.29) THEN
  390. RXILUP=XVAL
  391. ELSEIF (IRAN.EQ.30) THEN
  392. IDDOT=IVAL
  393. ELSEIF (IRAN.EQ.31) THEN
  394. IMVEC=IVAL
  395. ELSE
  396. WRITE(IOIMP,*) 'Programing error 2'
  397. CALL ERREUR(5)
  398. GOTO 9999
  399. ENDIF
  400. ENDIF
  401. GOTO 1
  402. *
  403. * Fin des lectures
  404. *
  405. 2 CONTINUE
  406. C MTYP=TYMATK
  407. C CALL ECRENT(6)
  408. C CALL ECROBJ(MTYP,MATRIK)
  409. C CALL PRLIST
  410. C MTYP=TYCHPO
  411. C CALL ECROBJ(MTYP,KSMBR)
  412. C CALL PRLIST
  413. *
  414. * Vérification de la validité de certains paramètres
  415. *
  416. C CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  417. C $ MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
  418. C $ IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET)
  419. C 41 2
  420. C %m1:8 = %r1 inférieur à %r2
  421. C 42 2
  422. C %m1:8 = %r1 non compris entre %r2 et %r3
  423. C 43 2
  424. C %m1:8 = %r1 supérieur à %r2
  425. IINF=0
  426. ISUP=2
  427. IF (ISCAL.LT.IINF.OR.ISCAL.GT.ISUP) THEN
  428. MOTERR(1:8)=MOTSCL(10)
  429. REAERR(1)=ISCAL
  430. REAERR(2)=IINF
  431. REAERR(3)=ISUP
  432. CALL ERREUR(42)
  433. GOTO 9999
  434. ENDIF
  435. IINF=0
  436. ISUP=1
  437. IF (INORMU.LT.IINF.OR.INORMU.GT.ISUP) THEN
  438. MOTERR(1:8)=MOTSCL(10)
  439. REAERR(1)=INORMU
  440. REAERR(2)=IINF
  441. REAERR(3)=ISUP
  442. CALL ERREUR(42)
  443. GOTO 9999
  444. ENDIF
  445. IINF=0
  446. ISUP=22
  447. IF (IOUBL.LT.IINF.OR.IOUBL.GT.ISUP) THEN
  448. MOTERR(1:8)=MOTSCL(11)
  449. REAERR(1)=IOUBL
  450. REAERR(2)=IINF
  451. REAERR(3)=ISUP
  452. CALL ERREUR(42)
  453. GOTO 9999
  454. ENDIF
  455. IINF=0
  456. IF (ITER.LT.IINF) THEN
  457. MOTERR(1:8)=MOTSCL(14)
  458. REAERR(1)=ITER
  459. REAERR(2)=IINF
  460. CALL ERREUR(41)
  461. GOTO 9999
  462. ENDIF
  463. XINF=XZERO
  464. IF (RESID.LT.XINF-XZPREC) THEN
  465. MOTERR(1:8)=MOTSCL(15)
  466. REAERR(1)=RESID
  467. REAERR(2)=XINF
  468. CALL ERREUR(41)
  469. GOTO 9999
  470. ENDIF
  471. XINF=XZERO
  472. IF (BRTOL.LT.XINF-XZPREC) THEN
  473. MOTERR(1:8)=MOTSCL(16)
  474. REAERR(1)=BRTOL
  475. REAERR(2)=XINF
  476. CALL ERREUR(41)
  477. GOTO 9999
  478. ENDIF
  479. IINF=1
  480. IF (IRSTRT.LT.IINF) THEN
  481. MOTERR(1:8)=MOTSCL(17)
  482. REAERR(1)=IRSTRT
  483. REAERR(2)=IINF
  484. CALL ERREUR(41)
  485. GOTO 9999
  486. ENDIF
  487. XINF=XZERO
  488. XSUP=1.D0
  489. IF (RXMILU.LT.XINF-XZPREC.OR.RXMILU.GT.XSUP+XZPREC) THEN
  490. MOTERR(1:8)=MOTSCL(19)
  491. REAERR(1)=RXMILU
  492. REAERR(2)=XINF
  493. REAERR(3)=XSUP
  494. CALL ERREUR(42)
  495. GOTO 9999
  496. ENDIF
  497. XINF=XZERO
  498. IF (XLFIL.LT.XINF-XZPREC) THEN
  499. MOTERR(1:8)=MOTSCL(20)
  500. REAERR(1)=XLFIL
  501. REAERR(2)=XINF
  502. CALL ERREUR(41)
  503. GOTO 9999
  504. ENDIF
  505. XSUP=XZERO
  506. IF (XDTOL.GT.XSUP+XZPREC) THEN
  507. MOTERR(1:8)=MOTSCL(21)
  508. REAERR(1)=XDTOL
  509. REAERR(2)=XSUP
  510. CALL ERREUR(43)
  511. GOTO 9999
  512. ENDIF
  513. XINF=XZERO
  514. XSUP=1.D0
  515. IF (XSPIV.LT.XINF-XZPREC.OR.XSPIV.GT.XSUP+XZPREC) THEN
  516. MOTERR(1:8)=MOTSCL(22)
  517. REAERR(1)=XSPIV
  518. REAERR(2)=XINF
  519. REAERR(3)=XSUP
  520. CALL ERREUR(42)
  521. GOTO 9999
  522. ENDIF
  523. IINF=1
  524. IF (LBCG.LT.IINF) THEN
  525. MOTERR(1:8)=MOTSCL(23)
  526. REAERR(1)=LBCG
  527. REAERR(2)=IINF
  528. CALL ERREUR(41)
  529. GOTO 9999
  530. ENDIF
  531. IINF=0
  532. ISUP=1
  533. IF (ICALRS.LT.IINF.OR.ICALRS.GT.ISUP) THEN
  534. MOTERR(1:8)=MOTSCL(24)
  535. REAERR(1)=ICALRS
  536. REAERR(2)=IINF
  537. REAERR(3)=ISUP
  538. CALL ERREUR(42)
  539. GOTO 9999
  540. ENDIF
  541. IINF=1
  542. ISUP=6
  543. IF (METASS.LT.IINF.OR.METASS.GT.ISUP) THEN
  544. MOTERR(1:8)=MOTSCL(25)
  545. REAERR(1)=METASS
  546. REAERR(2)=IINF
  547. REAERR(3)=ISUP
  548. CALL ERREUR(42)
  549. GOTO 9999
  550. ENDIF
  551. C XINF=XZERO
  552. C IF (RXILUP.LT.XINF-XZPREC) THEN
  553. C MOTERR(1:8)=MOTSCL(28)
  554. C REAERR(1)=RXILUP
  555. C REAERR(2)=XINF
  556. C CALL ERREUR(41)
  557. C GOTO 9999
  558. C ENDIF
  559. IINF=0
  560. ISUP=1
  561. IF (IDDOT.LT.IINF.OR.IDDOT.GT.ISUP) THEN
  562. MOTERR(1:8)=MOTSCL(29)
  563. REAERR(1)=IDDOT
  564. REAERR(2)=IINF
  565. REAERR(3)=ISUP
  566. CALL ERREUR(42)
  567. GOTO 9999
  568. ENDIF
  569. IINF=0
  570. ISUP=2
  571. IF (IMVEC.LT.IINF.OR.IMVEC.GT.ISUP) THEN
  572. MOTERR(1:8)=MOTSCL(30)
  573. REAERR(1)=IMVEC
  574. REAERR(2)=IINF
  575. REAERR(3)=ISUP
  576. CALL ERREUR(42)
  577. GOTO 9999
  578. ENDIF
  579.  
  580. * S'il y a eu une tentative forte de l'utilisateur de fournir ce
  581. * paramètre.
  582. IF (MRIGID.EQ.0.AND.LDEPE.AND.LLDEPE) THEN
  583. * 134 2
  584. *Pas besoin d'objet %m1:8 quand il n'y a pas d'objet %m9:16
  585. MOTERR(1:8)='LDEPE '
  586. MOTERR(9:16)='RIGIDITE'
  587. CALL ERREUR(134)
  588. GOTO 9999
  589. ENDIF
  590. *
  591. * Quand il y a un champ de conditions aux limites donné,
  592. * il est hasardeux d'essayer d'utiliser l'élimination des
  593. * dépendances en même temps
  594. *
  595. IF (MRIGID.NE.0.AND.KCLIM.NE.0.AND.LDEPE) THEN
  596. IF (LLDEPE) THEN
  597. * 135 2
  598. *Incompatibilité entre l'objet %m1:8 et l'objet %m9:16
  599. MOTERR(1:8)='LDEPE '
  600. MOTERR(9:16)='CLIM '
  601. CALL ERREUR(135)
  602. GOTO 9999
  603. ELSE
  604. LDEPE=.FALSE.
  605. ENDIF
  606. ENDIF
  607. *
  608. * Certaines options ne sont pas nécessaires pour le multigrille
  609. * et sont changées brutalement ici.
  610. *
  611. IF (KTYPI.EQ.7.OR.KTYPI.EQ.8) THEN
  612. KPREC=0
  613. * S'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce
  614. * paramètre.
  615. IF (.NOT.LMRENU) THEN
  616. MRENU='RIEN'
  617. ENDIF
  618. ENDIF
  619. *
  620. * Lorsque la matrice entrée est une rigidité et que l'on n'a pas de
  621. * KCLIM qui a été donné, ni de préconditionneur type ILUT avec pivoting
  622. * (qui impose une modification de la numérotation non encore gérée),
  623. * on va utiliser l'assemblage de RESOU...
  624. *
  625. IF (MRIGID.NE.0.AND.KCLIM.EQ.0.AND.KPREC.NE.7.AND.KPREC.NE.8) THEN
  626. * ...s'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce
  627. * paramètre...et si la matrice ne contient pas simultanément d'inconnues
  628. * normales et de multiplicateurs de Lagrange non reconnus par RESOU (la
  629. * pression)
  630. * Ceux-ci ont un nom commencant par 'LX', mais pas le type 22 pour le
  631. * maillage
  632. IF (.NOT.LMETAS) THEN
  633. LNORMA=.FALSE.
  634. LMUANO=.FALSE.
  635. SEGACT MRIGID
  636. NRIG=COERIG(/1)
  637. DO 10 IRIG=1,NRIG
  638. MELEME=IRIGEL(1,IRIG)
  639. DESCR=IRIGEL(3,IRIG)
  640. SEGACT MELEME
  641. SEGACT DESCR
  642. NLIGRP=LISINC(/2)
  643. IF (ITYPEL.NE.22) THEN
  644. DO ILIGRP=1,NLIGRP
  645. IF (LISINC(ILIGRP)(1:2).EQ.'LX') THEN
  646. LMUANO=.TRUE.
  647. ELSE
  648. LNORMA=.TRUE.
  649. ENDIF
  650. ENDDO
  651. ENDIF
  652. SEGDES MELEME
  653. SEGDES DESCR
  654. IF (LMUANO.AND.LNORMA) GOTO 20
  655. 10 CONTINUE
  656. METASS=6
  657. 20 CONTINUE
  658. SEGDES MRIGID
  659. ENDIF
  660. ENDIF
  661. *
  662. * Impressions de vérification éventuelles
  663. *
  664. IF (IMPR.GT.2) THEN
  665. WRITE(IOIMP,*) 'KRES : following data were read'
  666. WRITE(IOIMP,*) ' Objects :'
  667. WRITE(IOIMP,*) ' MATRIK=',MATRIK,' MATASS=',MATASS,
  668. $ ' MAPREC=',MAPREC,' MRIGID=',MRIGID
  669. WRITE(IOIMP,*) ' MTINV =',MTINV
  670. WRITE(IOIMP,*) ' KCLIM =',KCLIM, ' KSMBR =',KSMBR,
  671. $ ' MCHINI=',MCHINI
  672. WRITE(IOIMP,*) ' General options :'
  673. WRITE(IOIMP,*) ' KTYPI =',KTYPI, ' KPREC =',KPREC
  674. WRITE(IOIMP,*) ' MRENU =',MRENU, ' MMULAG=',MMULAG
  675. WRITE(IOIMP,*) ' ISCAL =',ISCAL, ' INORMU=',INORMU
  676. write(ioimp,*) ' IOUBL =',IOUBL
  677. WRITE(IOIMP,*) ' IMPR =',IMPR, ' IMPINV=',IMPINV
  678. WRITE(IOIMP,*) ' METASS=',METASS,' LTIME =',LTIME
  679. WRITE(IOIMP,*) ' LDEPE =',LDEPE
  680. WRITE(IOIMP,*) ' Iterative methods :'
  681. WRITE(IOIMP,*) ' ITER =',ITER, ' RESID =',RESID
  682. WRITE(IOIMP,*) ' BRTOL =',BRTOL, ' IRSTRT=',IRSTRT
  683. WRITE(IOIMP,*) ' LBCG =',LBCG, ' ICALRS=',ICALRS
  684. WRITE(IOIMP,*) ' IDDOT =',IDDOT, ' IMVEC =',IMVEC
  685. WRITE(IOIMP,*) ' Preconditioners :'
  686. WRITE(IOIMP,*) ' RXMILU=',RXMILU,' XLFIL =',XLFIL
  687. WRITE(IOIMP,*) ' XDTOL =',XDTOL, ' XSPIV =',XSPIV
  688. WRITE(IOIMP,*) ' RXILUP=',RXILUP
  689. ENDIF
  690. *
  691. * Normal termination
  692. *
  693. IRET=0
  694. RETURN
  695. *
  696. * Format handling
  697. *
  698. *
  699. * Error handling
  700. *
  701. 9999 CONTINUE
  702. IRET=1
  703. WRITE(IOIMP,*) 'An error was detected in subroutine prkres'
  704. RETURN
  705. *
  706. * End of subroutine PRKRES
  707. *
  708. END
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  
  719.  
  720.  
  721.  
  722.  
  723.  
  724.  
  725.  
  726.  
  727.  
  728.  
  729.  

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