Télécharger kres2.eso

Retour à la liste

Numérotation des lignes :

kres2
  1. C KRES2 SOURCE FD144363 24/04/24 21:15:03 11918
  2. SUBROUTINE KRES2()
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C*************************************************************************
  6. C Operateur KRES
  7. C
  8. C OBJET : Resoud l'equation AX=B par différentes méthodes
  9. C * directe (factorisation Choleski)
  10. C * itérative (Gradient conjugué, BiCGSTAB,
  11. C GMRES(m)) avec différents préconditionneurs
  12. C diagonal (Jacobi), D-ILU, ILU(0) (Choleski
  13. C incomplet), MILU(0)
  14. C SYNTAXE : CHPO3 = KRES MA1 'TYPI' TAB1
  15. C 'CLIM' CHPO1
  16. C 'SMBR' CHPO2
  17. C 'IMPR' VAL1 ;
  18. C Voir la notice pour plus de précisions.
  19. C
  20. C***********************************************************************
  21. C APPELES : KRES3, KRES4, KRES5
  22. C APPELES (E/S) : LIROBJ, ECROBJ, ERREUR, LIRMOT, LIRENT, LIRTAB,
  23. C ACME, ACMO, ACMM, ACMF, ECMO, ECME
  24. C APPELES (UTIL.) : QUETYP
  25. C APPELE PAR : KOPS
  26. C***********************************************************************
  27. C***********************************************************************
  28. C HISTORIQUE : 26/10/98 : prise en compte du cas particulier
  29. C où A est diagonale. C'est en fait assez pénible
  30. C car on utilise le CHPOINT comme structure de
  31. C données pour la matrice A et les vecteurs X,B,CLIM
  32. C HISTORIQUE : 09/02/99 : on peut utiliser le préconditionnement d'une
  33. C autre matrice que celle que l'on inverse
  34. C HISTORIQUE : 01/06/99 : on modifie la partie résolution itérative
  35. C en effet, lors de l'imposition des CL. de
  36. C Dirichlet, on changeait les valeurs de la
  37. C matrice Morse.
  38. C Ceci n'est pas bon lorsqu'on veut utiliser la
  39. C matrice assemblée pour plusieurs pas de temps.
  40. C On travaille maintenant sur une copie.
  41. C HISTORIQUE : 20/12/99 : reprogrammation de l'assemblage
  42. C Le nouvel assemblage n'est, pour l'instant effectif que
  43. C lorsqu'une méthode itérative est sélectionnée (-> fabrication
  44. C d'une matrice Morse). Le nouvel assemblage est plus performant
  45. C (temps de calcul, utilisation de la mémoire) et plus général (cas
  46. C particuliers à peu près supprimés) que le précédent.
  47. C HISTORIQUE : 05/01/00 : On ne supprime plus les 0.D0 de la matrice
  48. C assemblée (cf. clmors appelé par melim). Ceci pour ne plus avoir
  49. C perte éventuelle de symétrie de la matrice assemblée. Cela permet
  50. C aussi de ne plus dupliquer la matrice assemblée.
  51. C HISTORIQUE : 13/01/00 : Mise en conformité du solveur direct avec le
  52. C nouvel assemblage.
  53. C HISTORIQUE : 22/03/00 : Rajout des préconditionneurs ILUT
  54. C HISTORIQUE : 13/04/00 : Séparation Lecture des données
  55. C Ecriture des résultats (kres2)
  56. C Assemblage kres3
  57. C Méthode directe kres4
  58. C Méthodes itératives kres5
  59. C HISTORIQUE : 06/04/04 : Renumérotation (double mult.)
  60. C HISTORIQUE : 06/04/04 : Scaling
  61. C HISTORIQUE : 08/04/04 : ajout ILUTP
  62. C HISTORIQUE : 09/02/06 : ajout nb prod matrice vecteur (NMATVEC)
  63. C simplification du code
  64. C HISTORIQUE : 22/02/06 : Gros nettoyage au niveau de l'entrée des
  65. C arguments (Nouvelle syntaxe)
  66. C HISTORIQUE : 08/2011 : En vue de la suppression de l'objet MATRIK
  67. C on utilise l'assemblage de RESOU.
  68. C HISTORIQUE : 04/2019 : remplacement de NOEL par NELIM
  69. C Idéalement, il faudrait reprendre ce que Pierre a fait dans
  70. C RESOU dans les fiches 10[0,1]?? et avec MREM.En vue de la
  71. C suppression de l'objet MATRIK
  72. C
  73. C***********************************************************************
  74. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  75. C en cas de modification de ce sous-programme afin de faciliter
  76. C la maintenance !
  77. C***********************************************************************
  78.  
  79. -INC PPARAM
  80. -INC CCOPTIO
  81. -INC SMLREEL
  82. POINTEUR LRES.MLREEL
  83. -INC SMLENTI
  84. POINTEUR LNMV.MLENTI
  85. -INC SMCHPOI
  86. POINTEUR KCLIM.MCHPOI
  87. POINTEUR KSMBR.MCHPOI
  88. POINTEUR MCHINI.MCHPOI
  89. POINTEUR MCHSOL.MCHPOI
  90. -INC SMTABLE
  91. POINTEUR MTINV.MTABLE
  92. POINTEUR KTIME.MTABLE
  93. DIMENSION ITTIME(4)
  94. CHARACTER*8 CHARI
  95. * MATRIK est la matrice à inverser
  96. * MAPREC est la matrice dont on utilise le préconditionnement
  97. * MATASS est la matrice dont on utilise l'assemblage
  98. * pour préconditionner celui de MATRIK
  99. POINTEUR MAPREC.MATRIK
  100. POINTEUR MATASS.MATRIK
  101. *STAT -INC SMSTAT
  102. C
  103. CHARACTER*8 TYPE
  104. * Paramètre m du GMRES(m)
  105. INTEGER RESTRT
  106. INTEGER ITER
  107. REAL*8 BRTOL,RESID,RXMILU,RXILUP
  108. *
  109. REAL*8 XLFIL,XDTOL
  110. INTEGER KPREC
  111. INTEGER NMATRI
  112. INTEGER IP,KTYPI
  113. INTEGER IMPINV,IIMPR
  114. CHARACTER*4 MRENU,MMULAG
  115. LOGICAL LRIG,LTIME,LDETR,LDEPE,LASRIG,LDMULT,LOGII
  116. INTEGER IMPR,IRET
  117. C
  118. C Lecture des arguments et mise à défaut des optionnels ()
  119. C
  120. C MATRIK : La matrice lue en entrée au format MATRIK
  121. C MTINV : L'éventuelle table d'inversion (obsolète)
  122. C IMPR : Niveau d'impression solveur direct
  123. C KCLIM : Chpoint éventuel de conditions aux limites de Dirichlet
  124. C KSMBR : Chpoint second membre
  125. C KTYPI : Type de méthode de résolution
  126. C MATASS : Matrice utilisée pour préconditionner l'assemblage
  127. C MAPREC : Matrice utilisée pour préconditionner la construction du
  128. C préconditionneur
  129. C MRENU : Type de renumérotation
  130. C MMULAG : Placement des multiplicateurs de Lagrange
  131. C ISCAL : Scaling de la matrice
  132. C IOUBL : Oubli des matrices élémentaires ?
  133. C IMPINV : Niveau d'impression solveur itératif
  134. C MCHINI : Chpoint estimation de l'inconnue
  135. C ITER : Nombre maxi d'itérations à effectuer
  136. C RESID : Norme L2 maxi du résidu
  137. C BRTOL : Breakdown tolerance pour les méthodes de type Bi-CG
  138. C IRSTRT : Paramètre m de redémarrage pour GMRES
  139. C KPREC : Type du préconditionneur
  140. C RXMILU : Paramètre de relaxation pour MILU(0)
  141. C RXILUP : Paramètre de filtre pour ILU(0)-PV
  142. C XLFIL : Paramètre de remplissage pour les préconditionneurs ILUT
  143. C XDTOL : Drop tolerance pour les préconditionneurs ILUT
  144. C XSPIV : Sensibilité du pivoting pour les préconditionneurs ILUTP
  145. C LBCG : le l dans BicgStab(l)
  146. C ICALRS : façon de calculer le résidu
  147. C METASS : Méthode d'assemblage
  148. C LTIME : construit une table avec des statistiques temporelles
  149. C si vrai
  150. C LDEPE : élimine les dépendances si VRAI
  151. C et matrice d'entrée RIGIDITE
  152. C IDDOT : 0 => utilisation du produit scalaire normal dans les
  153. C méthodes itératives
  154. C 1 => utilisation du produit scalaire compensé
  155. * IMPR=4
  156.  
  157. IVALI=0
  158. XVALI=0.D0
  159. LOGII=.FALSE.
  160. IRETI=0
  161. XVALR=0.D0
  162. *inutile IOBRE=0
  163. IRETR=0
  164.  
  165. IMPR=0
  166. * WRITE(IOIMP,*) 'coucou kres2'
  167. *
  168. *STAT CALL INMSTA(MSTAT,IMPR)
  169. *
  170. CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  171. $ MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID
  172. $ ,BRTOL,IRSTRT,KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,LBCG
  173. $ ,ICALRS,METASS,LTIME,LDEPE,MRIGID,IDDOT,IMVEC,IRET)
  174. IF (IRET.NE.0) GOTO 9999
  175. IMPR=MAX(IMPR,IMPINV)
  176. *
  177. * Préparation de la matrice et du second membre
  178. * suivant les cas
  179. *
  180. * LASRIG=.TRUE. on utilise l'assemblage de RESOU
  181. * LDMULT=.TRUE. on dédouble les multiplicateurs de Lagrange
  182. * LDEPE=.TRUE. On fait l'élimination des relations
  183.  
  184. LASRIG=(METASS.EQ.6)
  185. * Pour l'instant, il faut toujours dédoubler les multiplicateurs
  186. * quand on assemble avec l'assemblage de RESO car le traitement des
  187. * multiplicateurs dans ldmt1 l'impose (simple multiplicateur non
  188. * prévu)
  189. LDMULT=LASRIG
  190. MRIGI0=MRIGID
  191. * Nouveau separm gère la non élimination avec NOEL
  192. IF (LDEPE) then
  193. * noel=0
  194. nelim=1
  195. ELSE
  196. * noel=1
  197. nelim=0
  198. ENDIF
  199. *dbg write(ioimp,*) 'LASRIG=',LASRIG
  200. *dbg write(ioimp,*) 'LDMULT=',LDMULT
  201. *dbg write(ioimp,*) 'LDEPE=',LDEPE,' NELIM=',NELIM
  202.  
  203. IF (MRIGID.NE.0) THEN
  204. *old IF (LDEPE) THEN
  205. KSMBR0=KSMBR
  206. *old CALL KRES6(MRIGID,KSMBR,IDEPE,
  207. *old $ MRIGIC,KSMBRC,KSMBR0,KSMBR1)
  208. CALL KRES6(MRIGID,KSMBR,LDMULT,NELIM,
  209. $ MRIGIC,KSMBRC,KSMBR1)
  210. IF (IERR.NE.0) RETURN
  211. MRIGID=MRIGIC
  212. KSMBR=KSMBRC
  213. *old ENDIF
  214. IF (LASRIG) THEN
  215. * Gestion de la normalisation
  216. NORICO=NORINC
  217. NORIDO=NORIND
  218. IF (ISCAL.EQ.0) THEN
  219. NORINC=0
  220. NORIND=0
  221. ELSE
  222. NORINC=-1
  223. NORIND=0
  224. ENDIF
  225. * Gestion de la renumérotation
  226. NUCROO=NUCROU
  227. IF (MRENU.EQ.'RIEN') THEN
  228. NUCROU=-1
  229. * La renumérotation sera en fait Reverse Cuthill-McKee dans NUMOPT
  230. ELSEIF (MRENU.EQ.'SLOA') THEN
  231. NUCROU=1
  232. * La renumérotation sera en fait Nested Dissection dans NUMOPT
  233. ELSEIF (MRENU.EQ.'GIPR'.OR.MRENU.EQ.'GIBA') THEN
  234. NUCROU=2
  235. ELSE
  236. WRITE(IOIMP,*) 'MRENU=',MRENU
  237. CALL ERREUR(5)
  238. RETURN
  239. ENDIF
  240. CALL KRES8(MRIGID,KSMBR,INORMU,
  241. $ KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  242. $ KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  243. $ KTIME,LTIME,
  244. $ MCHSOL,LRES,LNMV,ICVG,IMPR)
  245. IF (IERR.NE.0) RETURN
  246. * Gestion de la normalisation
  247. NORINC=NORICO
  248. NORIND=NORIDO
  249. NUCROU=NUCROO
  250. IF (LTIME) CALL ECROBJ('TABLE ',KTIME)
  251. IF (MTINV.NE.0) THEN
  252. CALL ECME(MTINV,'CVGOK',ICVG)
  253. IF (LRES.NE.0) CALL ECMO(MTINV,'CONVINV','LISTREEL',LRES)
  254. IF (LNMV.NE.0) CALL ECMO(MTINV,'NMATVEC','LISTENTI',LNMV)
  255. ENDIF
  256. * On décondense si nécessaire
  257. *
  258. * write (6,*) ' resou - mchsol '
  259. * call ecchpo(mchsol,0)
  260. * call mucpri(mchsol,mrigid,iresi)
  261. * write (6,*) ' kres - iresi '
  262. * call ecchpo(iresi,0)
  263. * WRITE(IOIMP,*) 'Avant KRES7'
  264. *old IF (MRIGI0.NE.0.AND.LDEPE) THEN
  265. IF (MRIGI0.NE.0) THEN
  266. MSOLC=MCHSOL
  267. IDTARG=1
  268. * On détruit MSOLC dans KRES7
  269. CALL KRES7(MSOLC,MRIGI0,KSMBR0,KSMBR1,IDTARG,
  270. $ MCHSOL)
  271. IF (IERR.NE.0) RETURN
  272. ENDIF
  273. CALL ECROBJ('CHPOINT ',MCHSOL)
  274. RETURN
  275. ELSE
  276. CALL ECROBJ('RIGIDITE',MRIGID)
  277. CALL RIMA
  278. IF (IERR.NE.0) GOTO 9999
  279. CALL MACHI2(1)
  280. IF (IERR.NE.0) GOTO 9999
  281. CALL LIROBJ('MATRIK',MATRIK,1,IRET)
  282. IF(IRET.EQ.0) GOTO 9999
  283.  
  284. * Changement des noms d'inconnues du second membre
  285. IF (KSMBR.NE.0) THEN
  286. CALL ECROBJ('CHPOINT ',KSMBR)
  287. CALL MACHI2(1)
  288. CALL LIROBJ('CHPOINT ',KSMBR,1,IRET)
  289. IF (IRET.EQ.0) GOTO 9999
  290. ENDIF
  291. ENDIF
  292. * write (6,*) ' le vecteur 2'
  293. * call ecchpo(ksmbr,0)
  294. * write (6,*) ' la matrice 2'
  295. * call ecrent(5)
  296. * call ecmatk(matrik)
  297. ENDIF
  298. *
  299. SEGACT MATRIK
  300. NMATRI=IRIGEL(/2)
  301. IF(NMATRI.EQ.0)THEN
  302. C% Résolution impossible : la matrice de RIGIDITE est vide
  303. CALL ERREUR(727)
  304. RETURN
  305. ENDIF
  306. SEGDES MATRIK
  307. IF (MATASS.EQ.0) MATASS=MATRIK
  308. IF (MAPREC.EQ.0) MAPREC=MATRIK
  309. * WRITE(IOIMP,*) 'Sortie de prkres'
  310. * WRITE(IOIMP,*) 'IOUBL=',IOUBL
  311. C
  312. IF (LTIME) THEN
  313. CALL CRTABL(KTIME)
  314. call timespv(ittime,oothrd)
  315. ITI1=(ITTIME(1)+ITTIME(2))/10
  316. ELSE
  317. KTIME=0
  318. ENDIF
  319. *STAT CALL PRMSTA('Lectures',MSTAT,IMPR)
  320. *
  321. C
  322. C Assemblage proprement dit
  323. C
  324. IIMPR=0
  325. CALL KRES3(MATRIK,MATASS,MRENU,MMULAG,METASS,
  326. $ KTIME,LTIME,
  327. $ IIMPR,IRET)
  328. * Gestion du CTRL-C
  329. if (ierr.NE.0) return
  330. IF (IRET.NE.0) GOTO 9999
  331. *! WRITE(IOIMP,*) 'Aprés assemblage'
  332. *! CALL ECRENT(5)
  333. *! CALL ECROBJ('MATRIK ',MATRIK)
  334. *! CALL PRLIST
  335. IF (LTIME) THEN
  336. call timespv(ittime,oothrd)
  337. ITI2=(ITTIME(1)+ITTIME(2))/10
  338. ENDIF
  339. *STAT CALL PRMSTA('Assemblage',MSTAT,IMPR)
  340. *
  341. * "Oubli" des valeurs des matrice élémentaires
  342. * On met les tableaux de LIZAFM à 0 => à MENAGE de les supprimmer
  343. * si besoin est.
  344. *
  345. IOUBD=MOD(IOUBL,10)
  346. *! WRITE(IOIMP,*) 'IOUBD=',IOUBD
  347. IF (IOUBD.EQ.1) THEN
  348. CALL OUBIMA(MATRIK,IMPR,IRET)
  349. IF (IRET.NE.0) GOTO 9999
  350. IF (IMPR.GT.2) THEN
  351. WRITE(IOIMP,*) 'Oubli des mat. elem.'
  352. ENDIF
  353. ELSEIF (IOUBD.EQ.2) THEN
  354. call ooohor(0)
  355. SEGACT MATRIK*MOD
  356. LDETR=.FALSE.
  357. NMATE=IRIGEL(/2)
  358. DO IMATE=1,NMATE
  359. IMATRI=IRIGEL(4,IMATE)
  360. SEGACT IMATRI*MOD
  361. NSOUM =LIZAFM(/1)
  362. NTOTIN=LIZAFM(/2)
  363. DO ITOTIN=1,NTOTIN
  364. DO ISOUM=1,NSOUM
  365. IZAFM=LIZAFM(ISOUM,ITOTIN)
  366. IF (IZAFM.NE.0) THEN
  367. LDETR=.TRUE.
  368. SEGSUP IZAFM
  369. LIZAFM(ISOUM,ITOTIN)=0
  370. ENDIF
  371. ENDDO
  372. ENDDO
  373. SEGDES IMATRI
  374. ENDDO
  375. IF (IMPR.GT.2.AND.LDETR) THEN
  376. WRITE(IOIMP,*) 'Destruction des mat. elem.'
  377. ENDIF
  378. ELSEIF (IOUBD.NE.0) THEN
  379. WRITE(IOIMP,*) 'IOUBL=',IOUBL, ' non prevu'
  380. GOTO 9999
  381. ENDIF
  382. *STAT CALL PRMSTA('Oubli',MSTAT,IMPR)
  383. *! WRITE(IOIMP,*) 'Aprés oubli'
  384. C
  385. C Méthode directe
  386. C
  387. IF (KTYPI.EQ.1) THEN
  388. CALL KRES4(MATRIK,KCLIM,KSMBR,
  389. $ ISCAL,
  390. $ MCHSOL,
  391. $ IMPR,IRET)
  392. if (ierr.ne.0) return
  393. IF (IRET.NE.0) GOTO 9999
  394. *STAT CALL PRMSTA('Methode directe',MSTAT,IMPR)
  395. C
  396. C Méthodes itératives
  397. C
  398. ELSE
  399. C
  400. CALL KRES5(MATRIK,KCLIM,KSMBR,KTYPI,
  401. $ MCHINI,ITER,RESID,
  402. $ BRTOL,IRSTRT,LBCG,ICALRS,
  403. $ MAPREC,KPREC,
  404. $ RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  405. $ ISCAL,
  406. $ KTIME,LTIME,IDDOT,IMVEC,
  407. $ MCHSOL,LRES,LNMV,ICVG,
  408. $ IMPR,IRET)
  409. if (ierr.ne.0) return
  410. IF (IRET.NE.0) GOTO 9999
  411. *STAT CALL PRMSTA('Methode iterative',MSTAT,IMPR)
  412. IF (MTINV.NE.0) THEN
  413. CALL ECME(MTINV,'CVGOK',ICVG)
  414. CALL ECMO(MTINV,'CONVINV','LISTREEL',LRES)
  415. CALL ECMO(MTINV,'NMATVEC','LISTENTI',LNMV)
  416. ENDIF
  417. ENDIF
  418. IF (LTIME) THEN
  419. call timespv(ittime,oothrd)
  420. ITI3=(ITTIME(1)+ITTIME(2))/10
  421. CHARI='ASS+RENU'
  422. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  423. $ 'ENTIER ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR)
  424. CHARI='PRE+RESO'
  425. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  426. $ 'ENTIER ',ITI3-ITI2,XVALR,CHARR,LOGIR,IRETR)
  427. CHARI='TOTAL '
  428. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  429. $ 'ENTIER ',ITI3-ITI1,XVALR,CHARR,LOGIR,IRETR)
  430. SEGDES KTIME
  431. CALL ECROBJ('TABLE ',KTIME)
  432. ENDIF
  433. IOUBE=IOUBL/10
  434. *! WRITE(IOIMP,*) 'IOUBE=',IOUBE
  435. IF (IOUBE.GE.1) THEN
  436. call ooohor(0)
  437. SEGACT MATRIK*MOD
  438. IF (IOUBE.EQ.2) THEN
  439. PMORS=KIDMAT(4)
  440. IF (PMORS.NE.0) THEN
  441. IF (IMPR.GT.2) THEN
  442. WRITE(IOIMP,*) 'Destruction du profil morse'
  443. ENDIF
  444. SEGSUP PMORS
  445. KIDMAT(4)=0
  446. ENDIF
  447. ENDIF
  448. IZA=KIDMAT(5)
  449. IF (IZA.NE.0) THEN
  450. IF (IMPR.GT.2) THEN
  451. WRITE(IOIMP,*) 'Destruction des valeurs morses'
  452. ENDIF
  453. SEGSUP IZA
  454. KIDMAT(5)=0
  455. ENDIF
  456. PMORS=KIDMAT(6)
  457. IF (PMORS.NE.0) THEN
  458. IF (IMPR.GT.2) THEN
  459. WRITE(IOIMP,*) 'Destruction du profil du precon'
  460. ENDIF
  461. SEGSUP PMORS
  462. KIDMAT(6)=0
  463. ENDIF
  464. IZA=KIDMAT(7)
  465. IF (IZA.NE.0) THEN
  466. IF (IMPR.GT.2) THEN
  467. WRITE(IOIMP,*) 'Destruction des valeurs du precon'
  468. ENDIF
  469. SEGSUP IZA
  470. KIDMAT(7)=0
  471. ENDIF
  472. SEGDES MATRIK
  473. ELSEIF (IOUBE.NE.0) THEN
  474. WRITE(IOIMP,*) 'IOUBL=',IOUBL, ' non prevu'
  475. GOTO 9999
  476. ENDIF
  477. *
  478. * On décondense si nécessaire
  479. *
  480. * write (6,*) ' resou - mchsol '
  481. * call ecchpo(mchsol,0)
  482. * call mucpri(mchsol,mrigid,iresi)
  483. * write (6,*) ' kres - iresi '
  484. * call ecchpo(iresi,0)
  485. * WRITE(IOIMP,*) 'Avant KRES7'
  486. IF (MRIGI0.NE.0.AND.LDEPE) THEN
  487. MSOLC=MCHSOL
  488. * CALL KRES7(MRIGID,IDEPE,KSMBR0,KSMBR1,
  489. * $ MSOLC,
  490. * $ MCHSOL)
  491. CALL KRES7(MSOLC,MRIGI0,KSMBR0,KSMBR1,1,
  492. $ MCHSOL)
  493. IF (IERR.NE.0) RETURN
  494. ENDIF
  495. CALL ECROBJ('CHPOINT ',MCHSOL)
  496. *STAT CALL SUMSTA(MSTAT,IMPR)
  497. *
  498. * Normal termination
  499. *
  500. RETURN
  501. *
  502. * Format handling
  503. *
  504. *
  505. * Error handling
  506. *
  507. 9999 CONTINUE
  508. WRITE(IOIMP,*) 'An error was detected in kres2.eso'
  509. * 153 2
  510. * Opération illicite dans ce contexte
  511. CALL ERREUR(153)
  512. RETURN
  513. *
  514. * End of KRES2
  515. *
  516. END
  517.  
  518.  
  519.  

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