Télécharger la plaquette Cast3M


fr en

Télécharger procpn.eso

Retour à la liste

Numérotation des lignes : 

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

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