Télécharger lfcdie.eso

Retour à la liste

Numérotation des lignes :

  1. C LFCDIE SOURCE CHAT 08/09/18 21:15:05 6162
  2. SUBROUTINE LFCDIE(NBAND,LMAX,ITAB,IRETOU,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC CCOPTIO
  6. -INC CCFXDR
  7. DIMENSION ITAB(1)
  8. external LONG
  9. 10 IRETOU=0
  10. ios=1
  11. IF (LMAX.EQ.0) RETURN
  12. lmaxl=lmax
  13. IF (IFORM.EQ.1.AND.IONIVE.GE.4)READ(NBAND,100,END=1001,ERR=1000)
  14. # (ITAB(I),I=1,LMAX)
  15. IF (IFORM.EQ.1.AND.IONIVE.LT.4)READ(NBAND,101,END=1001,ERR=1000)
  16. # (ITAB(I),I=1,LMAX)
  17. IF (IFORM.EQ.0)READ(NBAND,END=1001,ERR=1000) (ITAB(I),I=1,LMAX)
  18. if (iform.eq.2) ios=IXDRIMAT( ixdrr, lmaxl,itab(1))
  19. if(ios.lt.0) go to 1001
  20. 100 FORMAT(10I8)
  21. 101 FORMAT(16I5)
  22. RETURN
  23. 1001 CONTINUE
  24. * on bascule sur le fichier suivant
  25. ll = long (nomres)
  26. ificle=ificle+1
  27. * write(6,*)' lfcdie ificle ' , ificle
  28. if(ificle.eq.10000)then
  29. call erreur (945)
  30. iretou=1
  31. return
  32. endif
  33. if(ificle.eq.1) then
  34. nomres(ll+1:ll+2)='_1'
  35. ll=ll+2
  36. elseif ( ificle.lt.10) then
  37. write(nomres(ll:ll),fmt='(I1)')ificle
  38. elseif ( ificle.lt.100) then
  39. if(ificle.eq.10)ll = ll + 1
  40. write(nomres(ll-1:ll),fmt='(I2)')ificle
  41. elseif ( ificle.lt.1000) then
  42. if(ificle.eq.100)ll = ll + 1
  43. write(nomres(ll-2:ll),fmt='(I3)')ificle
  44. elseif ( ificle.lt.10000) then
  45. if(ificle.eq.1000)ll = ll + 1
  46. write(nomres(ll-3:ll),fmt='(I4)')ificle
  47. endif
  48. if (iform.ne.2) close (unit=nband)
  49. if (iform.eq.2) ios=IXDRCLOSE( ixdrr)
  50. if(iform.eq.1) then
  51. OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMRES(1:ll),
  52. # IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
  53. ELSEif (iform.eq.0) then
  54. OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMRES(1:ll),
  55. # IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
  56. else
  57. ios=INITXDR( NOMRES(1:ll),'r',.true.)
  58. if (ios.lt.0) goto 2000
  59. ENDIF
  60. write (6,*) 'Ouverture du fichier : ',nomres(1:ll)
  61. go to 10
  62.  
  63. 1000 IRETOU=1
  64. RETURN
  65. 2000 continue
  66. MOTERR=NOMRES(1:ll)
  67. INTERR(1)=IOS
  68. CALL ERREUR(424)
  69. RETURN
  70. END
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  

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