Télécharger chidbd.eso

Retour à la liste

Numérotation des lignes :

chidbd
  1. C CHIDBD SOURCE OF166741 23/10/16 21:15:03 11754
  2.  
  3. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C DEFINITION ET OUVERTURE D'UN FICHIER BASE DE DONNEES
  5. C IOCHI NUMERO DU FICHIER
  6. C CHA NOM DU FICHIER
  7. C ON VERIFIE QUE LE NO IOCHI N'EST PAS DEJA ATRIBUE
  8. C SINON ON INCREMENTE DE 1
  9. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. SUBROUTINE CHIDBD(IOCHI,CHA)
  11.  
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8(A-H,O-Z)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.  
  18. CHARACTER*(*) CHA
  19.  
  20. LOGICAL IEX
  21. external long
  22.  
  23. 10 CONTINUE
  24. IEX=.FALSE.
  25. INQUIRE(UNIT=IOCHI,OPENED=IEX)
  26. IF(IEX)THEN
  27. IOCHI=IOCHI+1
  28. IF(IOCHI.GT.100)THEN
  29. INTERR(1)=IOCHI
  30. CALL ERREUR(424)
  31. RETURN
  32. ENDIF
  33. GO TO 10
  34. ENDIF
  35. L=LONG(CHA)
  36. OPEN(UNIT=IOCHI,FILE=CHA(1:L),ERR=100)
  37. C*dbg write(ioimp,*) 'CHIDBD = ouverture',iochi,L,' =>'//CHA(1:L)//'<='
  38. RETURN
  39.  
  40. 100 CONTINUE
  41. INTERR(1)=IOCHI
  42. L1=MIN(L,40)
  43. MOTERR(1:40)=' '
  44. MOTERR(1:L1)= CHA(1:L1)
  45. IF (L.GT.40) MOTERR(38:40)='...'
  46. CALL ERREUR(424)
  47. RETURN
  48.  
  49. END
  50.  
  51.  
  52.  

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