C AFNOST SOURCE PV 21/12/09 21:15:01 11214 subroutine afNoSt(pNoti,iret) character*500 buffer character*5 rep integer termLi,iLig,jLig,iPag integer ipart,ichap,posDeb,posFin integer nbNuCh,nbNuPa,nChap,nPart,mChap,mPart integer tppanu,nlig,mlig integer iret,iretRe,ichaf,nChaCh integer longlu -INC PPARAM -INC CCOPTIO -INC CCNOYAU segment,noti character*(LONOM) nomOpe character*500 blig(nlig) endsegment segment,strNot integer posChap(mChap) c posChap(ichap) : ligne contenant le titre du chapitre ichap integer posPart(mPart) c posPart(iPart) : ligne contenant le titre de la partie iPart (numerotation globale) integer chapPart(mPart) c chapPart(iPart) : chapitre dans lequel la partie iPart est contenue integer partPart(mPart) c partPart(iPart) : numerotation locale de la partie character*40 forChap character*40 forPart endsegment pointeur pnoti.NOTI pointeur struc.STRNOT iret=0 c Recherche d element de structuration mchap=1000 mpart=1000 segini struc npart=0 nchap=0 tpPaNu=0 mlig=pNoti.blig(/2) DO 44 iLig=1,mlig buffer=pNoti.blig(iLig) c Numerotation des chapitres et parties if (buffer(1:5).EQ.'PART{'.OR.buffer(1:5).eq.'CHAP{') then if (buffer(1:4).EQ.'PART') then npart=npart+1 struc.posPart(npart)=iLig struc.chapPart(npart)=nChap tpPaNu=tpPaNu+1 struc.partPart(npart)=tpPaNu endif if (buffer(1:4).eq.'CHAP') then tpPaNu=0 nchap=nchap+1 struc.poschap(nchap)=iLig endif posdeb=index(buffer(1:500),'{') if (posdeb.eq.0) then moterr(1:1)='{' interr(1)=ilig iret=1047 return endif posdeb=posdeb+1 posfin=index(buffer(1:500),'}') if (posfin.eq.0) then moterr(1:1)='}' interr(1)=ilig iret=1047 return endif posFin=posFin-1 pNoti.blig(iLig)=' ' pNoti.blig(iLig)=buffer(posDeb:posFin)//CHAR(0) endif 44 continue mChap=nchap mPart=npart segadj struc nbNuCh=nChap nbNuPa=nPart IF(nbNuCh.GT.0) THEN nbNuCh=INT(LOG10(REAL(nbNuCh)))+1 ELSE nbNuCh=0 ENDIF IF(nbNuPa.GT.O) THEN nbNuPa=INT(LOG10(REAL(nbNuPa)))+1 ELSE nbNuPa=0 ENDIF write (struc.forchap,100) nbnuch,nbnuch 100 format('(i',i1,'.',i1,','' '',a)') IF(nbnuch.NE.0) THEN write (struc.forpart,101) nbnuch,nbnuch,nbnupa,nbnupa ELSE write (struc.forpart,102) nbnuch,nbnuch,nbnupa,nbnupa ENDIF 101 format('(i',i1,'.',i1,',''.'', i',i1,'.',i1,','' '' ,a)') 102 format('(i',i1,'.',i1,', i',i1,'.',i1,','' '' ,a)') do 13 ipart=1,nChap iLig=struc.posChap(ipart) buffer=pNoti.blig(iLig) ichaf=index(buffer,CHAR(0)) write(pNoti.blig(iLig),struc.forChap) ipart, buffer(1:ichaf) 13 continue do 12 ipart=1,nPart iLig=struc.posPart(ipart) buffer=pNoti.blig(iLig) ichaf=index(buffer,CHAR(0)) write(pNoti.blig(iLig),struc.forpart) struc.chappart(ipart), & struc.partpart(ipart), buffer(1:ichaf) 12 continue c On parcours la notice en partant du bas pour ajouter les soulignements nlig=mlig+nchap+npart segadj pNoti jLig=nLig iPart=nPart iChap=nChap IF(iChap.eq.0) THEN iPosChap=-1 ELSE iPosChap=struc.posChap(iChap) ENDIF IF(iPart.eq.0) THEN iPosPart=-1 ELSE iPosPart=struc.posPart(iPart) ENDIF do 14 iLig=mlig,1,-1 c write(6,*) iLig,iPosPart buffer=pNoti.blig(iLig) if(iLig.eq.iPosPart) then nChaCh = index(buffer,CHAR(0))-1 if(nChaCh.gt.0) then buffer(1:1)='-' do 90 iCha=2,nChaCh buffer(iCha:iCha)='-' 90 continue else buffer(1:1)=' ' endif pNoti.blig(jLig)=buffer jLig=jLig-1 struc.posPart(iPart)=jLig iPart=iPart-1 if(iPart.eq.0) then iPosPart=0 else iPosPart=struc.posPart(iPart) endif buffer=pNoti.blig(iLig) endif if(iLig.eq.iPosChap) then nChaCh = index(buffer,CHAR(0))-1 if(nChaCh.gt.0) then buffer(1:1)='=' do 92 iCha=2,nChaCh buffer(iCha:iCha)='=' 92 continue else buffer(1:1)=' ' endif pNoti.blig(jLig)=buffer jLig=jLig-1 struc.posChap(iChap)=jLig iChap=iChap-1 if(iChap.eq.0) then iPosChap=0 else iPosChap=struc.posChap(iChap) endif buffer=pNoti.blig(iLig) endif pNoti.blig(jLig)=buffer jLig=jLig-1 14 continue call pagerSt(pNoti,struc) segsup struc end ************************************************************************ subroutine pagerSt(pNoti,struc) character*500 buffer integer termLi,iLig,jLig,iPag integer debLi,finLi integer ipart,ichap,posDeb,posFin,nChap integer iRet character*8 forNum -INC PPARAM -INC CCOPTIO -INC CCNOYAU segment,noti character*(LONOM) nomOpe character*500 blig(nlig) endsegment segment,strNot integer posChap(mChap) integer posPart(mPart) integer chapPart(mPart) integer partPart(mPart) character*40 forChap character*40 forPart endsegment character*5 rep pointeur pnoti.NOTI pointeur struc.STRNOT debLi=1 finLi=pNoti.blig(/2) nChap=struc.posChap(/1) call gistty(termLi) termLi=termLi-3 iLig=debLi-1 iPag=0 jLig=1 nLig=finLi 123 if (iLig.lt.nLig) then iLig=iLig+1 buffer=pNoti.blig(iLig) LONGLU=LEN(BUFFER) 987 CONTINUE LONGLU = LONGLU -1 if ( LONGLU.NE.1.AND. BUFFER(LONGLU:LONGLU) .EQ.' ') goto 987 if (buffer(1:9).ne.'Section :') then jLig=jLig+1 write(IOIMP,*) buffer(1:LONGLU) endif if(jLig.eq.termLi) then call gistty(termLi) termLi=termLi-2 ipag=ipag+1 jLig=0 c122 write(IOIMP,104) '? (a pour aide) ' C122 write(IOIMP,104) C104 FORMAT ('? ([A]ide/[H]elp) ', $ ) c104 format(A16$) 122 CALL ERREUR(-356) read (IOTER,fmt='(a5)',end=124,err=124) rep if (rep.eq.'q'.or.ierr.ne.0) goto 124 if (rep.eq.' '.or.rep.eq.' ') then goto 123 endif C if (rep.eq.'a'.or.rep.eq.'A') then c write(IOIMP,*) 'Commandes :' c write(IOIMP,*) 'q : quitter' c write(IOIMP,*) 'd : debut' c write(IOIMP,*) 's : sommaire' c write(IOIMP,*) 'num : aller a la section' c write(IOIMP,*) 'entree pour la suite ' C CALL ERREUR(-356) C goto 122 C endif C if (rep.eq.'h'.or.rep.eq.'H') then C write(IOIMP,*) 'Commands :' C write(IOIMP,*) 'q : quit' C write(IOIMP,*) 'd : beginning' C write(IOIMP,*) 's : table of contents' C write(IOIMP,*) 'num : go to section' C write(IOIMP,*) 'enter for next page ' C goto 122 C endif if (rep.eq.'s') then call afStSo(pNoti,struc) goto 122 endif if (rep.eq.'d') then iLig=debLi-1 goto 123 endif posdeb=index(rep,'.') if (posdeb.ne.0) then 103 format('(i',i1,'.',i1,')') write (forNum,103) posdeb-1,posdeb-1 c write(6,*) 'Format de lecture',forNum read(rep(1:posdeb-1),forNum,iostat=iRetRe) ichap if(iRetRe.ne.0) then write(IOIMP,*)'Numero incorrect : ', iChap goto 122 endif write (forNum,103) 5-posdeb,5-posdeb c write(6,*) 'Format de lecture',forNum read(rep(posdeb+1:5),forNum,iostat=iRetRe) ipart if(iRetRe.ne.0) then write(IOIMP,*)'Numero incorrect : ', iPart goto 122 endif call afStPa(struc,iPart,ichap,iLig,iRet) if(iRet.ne.0) then write(IOIMP,*)'Numero incorrect : ', iChap, iPart go to 122 else goto 123 endif endif write (forNum,103) 5,5 c write(6,*) 'Format de lecture',forNum ichap=-3 read(rep,forNum,iostat=iRetRe) ichap if(iRetRe.ne.0) then else if(nChap.ne.0) then call afStCh(struc,iChap,iLig,iRet) else call afStPa(struc,ichap,0,iLig,iRet) endif if(iRet.ne.0) then write(IOIMP,*)'Numero incorrect : ',iChap go to 122 else goto 123 endif endif c moterr(1:4)=pNoti.nomOpe c interr(1)=ipag c call erreur(-357) endif goto 123 endif 124 continue segsup struc end ************************************************************************ subroutine afStSo(pNoti,struc) character*500 buffer integer iLig integer ipart,ichap,nChap -INC PPARAM -INC CCOPTIO -INC CCNOYAU segment,noti character*(LONOM) nomOpe character*500 blig(nlig) endsegment segment,strNot integer posChap(mChap) integer posPart(mPart) integer chapPart(mPart) integer partPart(mPart) character*40 forChap character*40 forPart endsegment pointeur pnoti.NOTI pointeur struc.STRNOT nChap=struc.posChap(/1) iChap=0 if ( struc.posPart(/1).ne.0) then do 12 ipart=1,struc.posPart(/1) c Cas ou la numerotation contient des parties et eventuellement des c chapitres dans ces parties if(iChap.LT.struc.chapPart(iPart)) then write(IOIMP,*) do while(iChap.LT.struc.chapPart(iPart).AND. & iChap.LE.nChap) iChap = iChap+1 iLig=struc.posChap(iChap) buffer=pNoti.blig(iLig) LONGLU=LEN(BUFFER) DO WHILE ( LONGLU.NE.1.AND. & BUFFER(LONGLU:LONGLU) .EQ.' ') LONGLU = LONGLU -1 ENDDO write(IOIMP,*) buffer(1:LONGLU) end do endif iLig=struc.posPart(ipart) buffer=pNoti.blig(iLig) LONGLU=LEN(BUFFER) DO WHILE ( LONGLU.NE.1.AND.BUFFER(LONGLU:LONGLU) .EQ.' ') LONGLU = LONGLU -1 ENDDO write(IOIMP,*) buffer(1:LONGLU) 12 continue if(iChap.ne.nChap) then do 121 iChap=iChap,nChap iLig=struc.posChap(iChap) buffer=pNoti.blig(iLig) LONGLU=LEN(BUFFER) DO WHILE ( LONGLU.NE.1.AND.BUFFER(LONGLU:LONGLU) .EQ.' ') LONGLU = LONGLU -1 ENDDO write(IOIMP,*) buffer(1:LONGLU) 121 continue endif else c Cas ou la numerotation ne contient que des chapitres do 13 iChap=1,struc.posChap(/1) iLig=struc.posChap(iChap) buffer=pNoti.blig(iLig) LONGLU=LEN(BUFFER) DO WHILE ( LONGLU.NE.1.AND.BUFFER(LONGLU:LONGLU) .EQ.' ') LONGLU = LONGLU -1 ENDDO write(IOIMP,*) buffer(1:LONGLU) 13 continue endif end ************************************************************************ subroutine afStPa(struc,iPartL,iChap,iLig,iRet) integer ipart,ipartL,ichap,iLig integer iRet -INC PPARAM -INC CCOPTIO segment,strNot integer posChap(mChap) integer posPart(mPart) integer chapPart(mPart) integer partPart(mPart) character*40 forChap character*40 forPart endsegment iRet=-1 pointeur struc.STRNOT do 12 ipart=1,struc.posPart(/1) if(struc.chapPart(ipart).eq.ichap.and. & struc.partPart(iPart).eq.ipartL) then iRet=0 iLig=struc.posPart(iPart)-1 return endif 12 continue iRet=1 return end ************************************************************************ subroutine afStCh(struc,iChap,iLig,iRet) integer iLig integer ichap integer iRet -INC PPARAM -INC CCOPTIO segment,strNot integer posChap(mChap) integer posPart(mPart) integer chapPart(mPart) integer partPart(mPart) character*40 forChap character*40 forPart endsegment pointeur struc.STRNOT iRet=-1 if(iChap.le.0.or.iChap.gt.struc.posChap(/1)) then iRet=1 return endif iRet=0 iLig=struc.posChap(iChap)-1 return end