Télécharger la plaquette Cast3M


fr en

Télécharger ooodop.eso

Retour à la liste

Numérotation des lignes : 

ooodop

  1. C OOODOP    SOURCE    PV090527  26/04/24    08:23:05     12524          
  2.       SUBROUTINE OOODOP (LRET,PTRK,PBUF)
  3. C----------------------------------------------------------------------
  4. C
  5. C               OUVERTURE DU FICHIER DEBORDEMENT MEMOIRE
  6. C            INITIALISATION  DE LA GESTION : ESPACE FICHIER
  7. C
  8. C   ->LRET  1  PLACE MEMOIRE INSUFFISANTE
  9. C           2  OK
  10. C
  11. C   ->PTRK     SEGMENT GESTION : ESPACE FICHIER DE DEBORDEMENT
  12. C   ->PBUF     SEGMENT BUFFER  : ECRITURE BLOQUEE DES PETITS SEGMENTS
  13. C
  14. C PROGRAMMEUR : MOUGIN
  15. C       MODIF : 31/01/89    SEGMENT PTRK MIS A LA MODE ...
  16. C       MODIF : 01/02/89    LE PARAMETRE GESMEM ... (SIGNE DE NTRK)
  17. C
  18. C-----------------------------------------------------------------------
  19. C
  20. C%IF WIN32
  21. C      Include fait pour l'interfaçage FORTRAN - C avec Microsoft Visual C
  22. C      INCLUDE 'esope.fi'
  23. C%ENDIF
  24. %INC IOOPTRK
  25. %INC IOOPBUF
  26. %INC IOOUNIT
  27. %INC IOOWCOM
  28. C
  29.       CHARACTER*8 HVAL
  30. C
  31. C   ->NTRK     NOMBRE DE BLOCS ACCES DIRECT SUR LE FICHIER
  32. C   ->LTRK     NOMBRE DE MOTS D'UN BLOC
  33. C   ->NFIL     UNIT FORTRAN A UTILISER
  34. C
  35.  
  36.       PTRK=0
  37.       PBUF=0
  38.       CALL OOOPRM   (LRET,'NTRK' ,HVAL,LVAL,NTRKLU)
  39.       IF (LRET.EQ.3)                                   THEN
  40.         NTRK = ABS(NTRKLU)
  41.       ELSE
  42.         NTRK = 0
  43.       ENDIF
  44.       IF (NTRK.GT.0)                                   THEN
  45.         CALL OOOPRM (LRET,'LTRK' ,HVAL,LVAL,LTRK)
  46.         IF (LRET.NE.3)                                 GO TO 901
  47.         IF (LTRK.NE.0)                                 THEN
  48.           CALL OOOPRM (LRET,'OFILE',HVAL,LVAL,NFIL)
  49.           IF (LRET.NE.3) NFIL=JDEB
  50.           CALL OOOZOP (LRET,NFIL,NTRK,LTRK)
  51.           IF (LRET.EQ.1)                               GO TO 950
  52.           SEGINI /ERR=100/ PTRK , PBUF
  53.           PTRK.LLTRK = LTRK
  54.           PTRK.NNTRK = NTRK
  55.           PTRK.NTRL  = 1
  56.           DO   I = 1,NTRK-1
  57.             PTRK.JTRK(I) = I+1
  58.           ENDDO
  59.         PTRK.JTRK(NTRK)=0
  60.         ENDIF
  61.       ENDIF
  62.       IF (PTRK.NE.0 .AND. NTRKLU.LT.0)                 THEN
  63.         GESMEM = GESMEM_TASSEMENT
  64.       ELSE
  65.         GESMEM = GESMEM_SORTIE_DISQUE
  66.       ENDIF
  67.       LRET = 2
  68.                                                        RETURN
  69.  100  LRET = 1
  70.                                                        RETURN
  71. C-----------------------------------------------------------------------
  72. C
  73. C                        MESSAGES D'ERREUR
  74. C
  75.  901  CALLOOOERR(NTRK,1,'<-NTRK : ET LE PARAMETRE LTRK=... EST ABSENT')
  76.  
  77.  950                                                   STOP 16
  78. C
  79.       END
  80.  
  81.  

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