1 : C FIN SOURCE PV 06/04/21 21:15:09 5418 2 : SUBROUTINE FIN 3 : IMPLICIT INTEGER(I-N) 4 : -INC CCOPTIO 5 : -INC CCNOYAU 6 : -INC SMBLOC 7 : CHARACTER*40 MESS 8 : CHARACTER*8 ICHC 9 : DATA MESS/'ARRET DU PROGRAMME GIBI NIVEAU D''ERREUR:'/ 10 : IF (IERR.EQ.0) THEN 10 : CALL LIROBJ('BLOC ',IRET,0,IRETOU) 11 : IF (IRETOU.EQ.1) GOTO 10 12 : ENDIF 13 : WRITE (IOIMP,1) MESS,IERMAX 14 : 1 FORMAT (///,1X,10(1H*),5X,A40,I4,5X,10(1H*)) 14 : IF (IIMPI.NE.0) CALL OOODMP(0) 14 : CALL OOOSTP 14 : call flush(IOIMP) 14 : *** if (iermax.eq.3) call abort 15 : IF (IERMAX.EQ.1) STOP 4 16 : IF (IERMAX.EQ.2) STOP 8 17 : IF (IERMAX.EQ.3) STOP 12 18 : STOP 19 : 10 CONTINUE 20 : IF (MBLOC.NE.IRET) THEN 20 : CALL ERREUR(154) 21 : RETURN 22 : ENDIF 23 : * MISE A BLANC DU NOM DE LA BOUCLE AFIN DE NE PAS LA REUTILISER 24 : IPLAC = JPOOB2(IMOTLU) 25 : INOOB1(IPLAC)=1 26 : C 27 : C si c'est la premiere fois on ajuste le segment 28 : C 29 : IF(MBFONC.NE.0) THEN 30 : MTXBLC=MTXBL 31 : NINST=NINSTV+1 32 : IPVINN=MTXBA(NINST) 33 : NBNOMM=LMTXBM(NINST) 34 : IF(IIMPI.EQ.1756) WRITE(IOIMP,1788)NINST,IPVINN,NBNOMM 35 : 1788 FORMAT(' apres ajustement NINST IPVINN NBNOMM',3I8) 36 : SEGADJ MTXBLC 37 : ENDIF 38 : MBCOUR=0 39 : MBFONC=0 40 : MBCONT=MBCONT-1 41 : ICONBO=ICONBO+1 42 : ICHC= NCONBO 43 : IIPROU=ICONBO 43 : CALL NOMENT(ICHC,IIPROU ) 44 : IF (MBCONT.NE.0.AND.MBERR.EQ.0) RETURN 45 : MBCONT=1 46 : MBER1=MBERR 47 : MBLO1=MBLOC 47 : IF (MBLSUP.EQ.0) CALL ERREUR(5) 48 : IF (IERR.NE.0) RETURN 49 : MTXBLC=MTXBL 50 : SEGDES MTXBLC 51 : MBLOC=MBLSUP 52 : ISSPOT=MBLO1.ISPOTE 53 : SEGDES ISSPOT 54 : SEGDES MBLO1 55 : SEGACT MBLOC*MOD 56 : ISSPOT=ISPOTE 57 : SEGACT ISSPOT*MOD 58 : MTXBLC=MTXBL 58 : CALL NOUTRU 59 : IF (MBLSUP.NE.0) SEGACT MTXBLC 60 : MBERR=MBER1 61 : RETURN 62 : END 63 : 64 : 65 : 66 :
© Cast3M 2003 - All rights reserved.
Disclaimer