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/05/11    21:15:20     1245           
  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. %INC IOOADR 
  29. %INC IOOADZ 
  30. C
  31.       CHARACTER*8 HVAL
  32. C
  33. C   ->NTRK     NOMBRE DE BLOCS ACCES DIRECT SUR LE FICHIER
  34. C   ->LTRK     NOMBRE DE MOTS D'UN BLOC
  35. C   ->NFIL     UNIT FORTRAN A UTILISER
  36. C
  37.  
  38.       PTRK=0
  39.       PBUF=0
  40.       CALL OOOPRM   (LRET,'NTRK' ,HVAL,LVAL,NTRKLU)
  41.       IF (LRET.EQ.3)                                   THEN
  42.         NTRK = ABS(NTRKLU)
  43.       ELSE
  44.         NTRK = 0
  45.       ENDIF
  46.       IF (NTRK.GT.0)                                   THEN
  47.         CALL OOOPRM (LRET,'LTRK' ,HVAL,LVAL,LTRK)
  48.         IF (LRET.NE.3)                                 GO TO 901
  49.         IF (LTRK.NE.0)                                 THEN
  50.           CALL OOOPRM (LRET,'OFILE',HVAL,LVAL,NFIL)
  51.           IF (LRET.NE.3) NFIL=JDEB
  52.           LESO=MZLZA(IZA)
  53.           IF (LTRK.EQ.1) LTRK=MIN(LESO/200,65536*8*8*8)
  54.           CALL OOOZOP (LRET,NFIL,NTRK,LTRK)
  55.           IF (LRET.EQ.1)                               GO TO 950
  56.           SEGINI /ERR=100/ PTRK , PBUF
  57.           PTRK.LLTRK = LTRK
  58.           PTRK.NNTRK = NTRK
  59.           PTRK.NTRL  = 1
  60.           DO   I = 1,NTRK-1
  61.             PTRK.JTRK(I) = I+1
  62.           ENDDO
  63.         PTRK.JTRK(NTRK)=0
  64.         ENDIF
  65.       ENDIF
  66.       IF (PTRK.NE.0 .AND. NTRKLU.LT.0)                 THEN
  67.         GESMEM = GESMEM_TASSEMENT
  68.       ELSE
  69.         GESMEM = GESMEM_SORTIE_DISQUE
  70.       ENDIF
  71.       LRET = 2
  72.                                                        RETURN
  73.  100  LRET = 1
  74.                                                        RETURN
  75. C-----------------------------------------------------------------------
  76. C
  77. C                        MESSAGES D'ERREUR
  78. C
  79.  901  CALLOOOERR(NTRK,1,'<-NTRK : ET LE PARAMETRE LTRK=... EST ABSENT')
  80.  
  81.  950                                                   STOP 16
  82. C
  83.       END
  84.  
  85.  
  86.  

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