Télécharger la plaquette Cast3M


fr en

Télécharger procpn.eso

Retour à la liste

Numérotation des lignes : 

  1. C PROCPN    SOURCE    CB215821  18/01/23    21:15:42     9704           
  2.       SUBROUTINE PROCPN(IAREA,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5.       SAVE LINDEX,ISTAT,IULEPR,ISTAT2
  6.       integer curEnr,curCha,curFic,curLig
  7.       integer totCha
  8.       SAVE curEnr,curCha,curFic,curLig
  9.       CHARACTER*(*) IAREA
  10.       INTEGER       IRET
  11.       DATA iLonEn /100000/
  12.       CHARACTER*100000 cCHAR
  13.       CHARACTER*8 c8
  14.       integer nDol
  15.       integer iProc
  16.       integer iEnre
  17.       integer nProc,nProc34
  18.       integer nEnt
  19.       integer curCh2
  20.       integer tmpLong
  21.       CHARACTER*500 cline
  22.       DIMENSION INDEX (6)
  23.       DIMENSION NAME(2)
  24.       CHARACTER*8 INDIX (6)
  25.       SEGMENT indFic
  26.          CHARACTER*8  nomEnt(nEnt)
  27.          INTEGER      carDeb(nEnt)
  28.          INTEGER      numFic(nEnt)
  29.       ENDSEGMENT
  30.       SEGMENT UTIFIC
  31.        integer debCha(nlig+1)
  32.       ENDSEGMENT
  33.   103 FORMAT(A100000)
  34.       pointeur pLiPro.indFic
  35.       pointeur utif3.utific
  36.       utif3=0
  37. C      IJKL=0
  38.       IDEJA=0
  39.       ISTAT=1
  40.       nEnt=0
  41.       SEGINI pLiPro
  42. c      write(6,*)  'Lecture du premier fichier de procedure'
  43.       nProc=0
  44.       IF(utifi3(4).EQ.0) THEN
  45.           goto 95
  46.       ENDIF
  47.       READ(34,REC=1,FMT=103,IOSTAT=IOSTAT)cCHAR
  48.       if (iostat.gt.0) then
  49.         goto 95
  50.       endif
  51.  
  52.       READ(cCHAR(1:30),FMT=301,IOSTAT=IOSTAT)curEnr,nLig,nProc
  53.       if (iostat.gt.0) then
  54.         goto 95
  55.       endif
  56.       ISTAT=0
  57. c     recuperation du nombre de ligne, d enregistrement, et de procedure
  58. c        write(6,*) 'nb proc',nProc
  59. c     lecture de la liste des procedures
  60.         nEnt=nProc
  61.         SEGADJ pLiPro
  62.         curCha=31
  63.         DO iproc=1,nProc
  64.           if(curcha.le.iLonEn-17) then
  65.             read(cCHAR(curCha:curcha+17),FMT=202,IOSTAT=IOSTAT) c8,
  66.      &      curCh2
  67.             if (iostat.gt.0) then
  68.               nEnt=iProc-1
  69.               segadj pLiPro
  70.               goto 95
  71.             endif
  72.             pLiPro.nomEnt(iProc)=c8
  73.             pLiPro.carDeb(iProc)=curCh2
  74. c        on enleve 1 pour etre sur que jchar-1 n'est pas sup ou egal a iLonEn
  75.             pLiPro.numFic(iProc)=34
  76.             CALL NOMOBJ('PROCEDUR',c8,-curCh2)
  77.             curCha=curCha+18
  78.           else
  79.             write(IOIMP,*) 'Trop de procedure'
  80.           endif
  81.         enddo
  82. c     lecture de la correspondance des lignes
  83. c        write(IOIMP,*) 'nb lig',nLig
  84. c        write(IOIMP,*) 'nb Enr',curEnr
  85.         READ(34,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  86.         if (iostat.gt.0) then
  87.           goto 95
  88.         endif
  89.         segini utif3
  90.         curCha=1
  91.         do curLig=1,nLig+1
  92. c       attention, ici, on fait l'hypothese que iLonEn est un multiple de 10
  93.           READ(cCHAR(curCha:curCha+9),FMT=204,IOSTAT=IOSTAT)
  94.      &    utif3.debCha(curLig)
  95.           if (iostat.gt.0) then
  96.             nLig=curLig-2
  97.             segadj utif3
  98.             goto 95
  99.           endif
  100. c        WRITE(6,*) 'ligne',curLig,utif3.debCha(curLig)
  101.           curCha=curCha+10
  102.           if(curCha.GE.iLonEn) then
  103.             curEnr=curEnr+1
  104.             READ(34,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  105.             if (iostat.gt.0) then
  106.               nLig=curLig-1
  107.               segadj utif3
  108.               goto 95
  109.             endif
  110.             curCha=1
  111.           endif
  112.         enddo
  113. 95    CONTINUE
  114.         utifi3(4)=utif3
  115.         IF(utif3 .GT. 0) then
  116.           segdes utif3
  117.         endif
  118.  
  119.       utif3=0
  120.       nProc34=nProc
  121. c      write(6,*) cline
  122. c      write(6,*)  'fin de Lecture du fichier de procedure'
  123.  
  124.       ISTAT2=1
  125. c      write(6,*)  'Lecture du deuxieme fichier de procedure'
  126.       nProc=0
  127.       IF(utifi3(6).EQ.0) THEN
  128.           goto 96
  129.       ENDIF
  130.       READ(36,REC=1,FMT=103,IOSTAT=IOSTAT)cCHAR
  131.       if (iostat.gt.0) then
  132.         goto 96
  133.       endif
  134.  
  135.       READ(cCHAR(1:30),FMT=301,IOSTAT=IOSTAT)curEnr,nLig,nProc
  136.       if (iostat.gt.0) then
  137.         goto 96
  138.       endif
  139.       ISTAT2=0
  140. c     recuperation du nombre de ligne, d enregistrement, et de procedure
  141. c      write(IOIMP,*) 'nb Enr',curEnr
  142. c      write(IOIMP,*) 'nb lig',nLig
  143. c      write(IOIMP,*) 'nb proc',nProc
  144. c     lecture de la liste des procedures
  145.       nEnt=nProc+nProc34
  146.       SEGADJ pLiPro
  147.       curCha=31
  148.       DO iproc=nProc34+1,nEnt
  149.       if(curcha.le.iLonEn-17) then
  150.         read(cCHAR(curCha:curcha+17),FMT=202,IOSTAT=IOSTAT) c8,curCh2
  151.         if (iostat.gt.0) then
  152.           nEnt=iProc-1
  153.           SEGADJ pLiPro
  154.           goto 96
  155.         endif
  156.         pLiPro.nomEnt(iProc)=c8
  157.         pLiPro.carDeb(iProc)=curCh2
  158. cc        on enleve 1 pour etre sur que jchar-1 n'est pas sup ou egal a iLonEn
  159.         pLiPro.numFic(iProc)=36
  160.         DO 40 nProc=1,nProc34
  161.         IF(c8(1:8).EQ.pLiPro.nomEnt(nProc)) THEN
  162.           IF(IDEJA.EQ.0) THEN
  163.             CALL ERREUR (-302)
  164.           ENDIF
  165.           WRITE(IOIMP,*) c8(1:8)
  166.           IDEJA=IDEJA+1
  167.           GO TO 41
  168.         ENDIF
  169.    40       CONTINUE
  170.    41       CONTINUE
  171.           CALL NOMOBJ('PROCEDUR',c8,-(curCh2+500000000))
  172.           curCha=curCha+18
  173.         else
  174.           write(IOIMP,*) 'Trop de procedures'
  175.         endif
  176.       enddo
  177. c     lecture de la correspondance des lignes
  178.         READ(36,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  179.         if (iostat.gt.0) then
  180.           goto 96
  181.         endif
  182.         segini utif3
  183.         curCha=1
  184.         do curLig=1,nLig+1
  185. c       attention, ici, on fait l'hypothese que iLonEn est un multiple de 10
  186.           READ(cCHAR(curCha:curCha+9),FMT=204,IOSTAT=IOSTAT)
  187.      &    utif3.debCha(curLig)
  188.           if (iostat.gt.0) then
  189.             nLig=curLig-2
  190.             segadj utif3
  191.             goto 96
  192.           endif
  193. c        WRITE(6,*) 'ligne',curLig,utif3.debCha(curLig)
  194.         curCha=curCha+10
  195.         if(curCha.GE.iLonEn) then
  196.           curEnr=curEnr+1
  197.           READ(36,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  198.           if (iostat.gt.0) then
  199.             nLig=curLig-1
  200.             segadj utif3
  201.             goto 96
  202.           endif
  203.           curCha=1
  204.         endif
  205.         enddo
  206. 96    continue
  207.         utifi3(6)=utif3
  208.         IF(utifi3(6) .GT. 0) then
  209.           segdes utif3
  210.         endif
  211.  
  212. c      dump de la lecture du fichier
  213. c        write(IOIMP,*) 'dump de la lecture du fichier'
  214. c        do 93 I=1,nEnt
  215. c          write(IOIMP,94)pLiPro.nomEnt(i),(pLiPro.carDeb(i)/iLonEn),
  216. c     &    mod(pLiPro.carDeb(i),iLonEn)
  217. c         write(IOIMP,94)pLiPro.nomEnt(i),pLiPro.carDeb(i)
  218. c        write(IOIMP,94)pLiPro.nomEnt(i),pLiPro.carDeb(i),
  219. c     &  pLiPro.numFic(i)
  220. c94    FORMAT('Proc : ',A8,' ligne ',I10,'fichier',I3)
  221. c93    continue
  222. c        write(IOIMP,*) 'statut',ISTAT,ISTAT2
  223.         lisProc=pLiPro
  224.         segdes pLiPro
  225.         IRET=9999
  226. C 9998 CONTINUE
  227. c lecture du deuxieme fichier
  228.  
  229.         RETURN
  230.         ENTRY PROCPO(JINDEX,IRET)
  231. c     Le principe de cette routine est de placer le pointeur LINDEX au bon endroit
  232. c     elle renvoit IRET = 0 en cas d erreur, 9999 sinon
  233. c     Le pointeur LINDEX est place en fonction de la position demandee modulo le fichier
  234. c     Le pointeur demandee est enregistree lors du nomobj de procpn
  235. c        write(IOIMP,*)'Entree dans PROCPO'
  236.         IRET=0
  237.         IF (ISTAT*ISTAT2.EQ.1) RETURN
  238.         IF(JINDEX.GT.500000000) THEN
  239. c         write(6,94)pLiPro.nomEnt(i),(pLiPro.carDeb(i)/iLonEn),
  240. c     &    mod(pLiPro.carDeb(i),iLonEn)
  241.           curFic=36
  242.           curLig = (JINDEX-500000000)
  243.         ELSE
  244.           curFic=34
  245.           curLig = JINDEX
  246.         ENDIF
  247.         IRET=9999
  248. c        write(IOIMP,*)'sortie de PROCPO',IRET
  249.         RETURN
  250.         ENTRY PROCLI(IAREA,IRET)
  251. c     Le principe de cette routine est de lire la ligne sous le pointeur LINDEX et d avancer le pointeur
  252. c     La ligne est enregistree dans IAREA et le pointeur LINDEX est avance de 1
  253. c     Notre but ici va etre de lire 500 caractere a partir de curCha
  254. c     (eventuellement avancer curEnr et s'arreter si on rencontre 4
  255. c     dollars. Puis renvoyer ca dans IAREA
  256. c        write(IOIMP,*)'Entree dans PROCLI',ISTAT,ISTAT2
  257.         IRET=9999
  258.         IF (ISTAT*ISTAT2.EQ.1) RETURN
  259.         utif3=utifi3(curfic-30)
  260.         if(utif3.LE.0) RETURN
  261.         segact utif3
  262.         nlig=utif3.debCha(/1)
  263. c        write(IOIMP,*)'Nombre de lignes',nlig,curLig
  264.         IF(curLig.GE.nlig)return
  265.         curEnr = utif3.debCha(curLig)/iLonEn+1
  266. c        curCha = utif3.debCha(curLig) - ilonEn * (curEnr-1)
  267.         curCha = mod(utif3.debCha(curLig),iLonEn)+1
  268.         curCh2 = mod(utif3.debCha(curLig+1),iLonEn)
  269. c          write(6,*) 'Ligne ',curLig,curCha,curCh2
  270.         IRET=0
  271.         WRITE(cline,FMT=203)' '
  272.         READ(curFic,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cChar
  273.         if (iostat.gt.0) then
  274.         write(IOIMP,*)'Impossible de lire l''enregistrement',curEnr,
  275.      &                 curFic
  276.           IAREA(1:500)=cline(1:500)
  277.           segdes utif3
  278.           return
  279.         endif
  280. c       Est-ce que curCh2 peut valoir 0 ??
  281.         if(curCha.LE.curCh2) then
  282.           tmplong=curCh2-curCha+1
  283.           cline(1:tmplong) = cChar(curCha:curCh2)
  284.         else
  285.           tmplong=(iLonEn-curCha) + 1
  286.           cline(1:tmpLong)=cCHAR(curCha:iLonEn)
  287. c          write(6,*) 'Premiere partie',curEnr,1,tmpLong,curCha,iLonEn,
  288. c     &     cline(1:tmpLong)
  289.           curEnr=curEnr+1
  290.           READ(curFic,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  291.           if (iostat.eq.0) then
  292.             cline(1+tmpLong:curCh2-curCha+1+iLonEn) = cChar(1:curCh2)
  293.             tmplong=curCh2-curCha+1+iLonEn
  294.           endif
  295. c          write(6,*) 'Deuxieme partie',curEnr,1+tmpLong,1,curCh2,
  296. c     &     curCh2-curCha+1+iLonEn,
  297. c     &     cline(1+tmpLong:curCh2-curCha+1+iLonEn)
  298.         endif
  299. c        write(6,'(A,I10,A,I10,A,A,A)') 'Li',curLig,'/',nLig,', |',
  300. c     &  cline(1:tmplong),'|'
  301. c     Nettoyage de cline : on s'arrete si on trouve des $$$$ puis on
  302. c     enleve les blanc
  303.         IF(cline(1:4).EQ.'$$$$')IRET=9999
  304.         IAREA(1:500)=cline(1:500)
  305.         curLig=curLig+1
  306.         segdes utif3
  307. c        write(IOIMP,*)'sortie de PROCLI ',IRET
  308.         RETURN
  309.         ENTRY PROCL2(IAREA,IRET)
  310. c        write(IOIMP,*)'Entree dans PROCL2'
  311. c     Procli2 place le pointeur LINDEX sur le debut de la routine IAREA et dans le bon fichier
  312.         pLiPro=lisProc
  313.         segact pLiPro
  314.         IRET=0
  315.         IF (ISTAT*ISTAT2.EQ.1) RETURN
  316.         do 73 I=pLiPro.numFic(/1),1,-1
  317.         if(IAREA(1:8).EQ.pLiPro.nomEnt(i)) THEN
  318.           curFic=pLiPro.numFic(i)
  319.           IF(curFic.EQ.34) THEN
  320.             IRET=9999
  321.           ELSE
  322.             IRET=9998
  323.           ENDIF
  324.           curLig = pLiPro.carDeb(i)
  325.         segdes pLiPro
  326. c        write(IOIMP,*)'sortie de PROCL2 ',IRET
  327.           return
  328.         ENDIF
  329. 73    continue
  330.         segdes pLiPro
  331. c        write(IOIMP,*)'sortie de PROCL2 ',IRET
  332.         RETURN
  333.   301 FORMAT(3I10)
  334.   202 FORMAT(A8,I10)
  335.   203 FORMAT(A)
  336.   204 FORMAT(I10)
  337.         END
  338.  
  339.  
  340.  

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