Télécharger prkres.eso

Retour à la liste

Numérotation des lignes :

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

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