Télécharger ecdife.eso

Retour à la liste

Numérotation des lignes :

  1. C ECDIFE SOURCE CHAT 12/07/27 21:15:00 7450
  2. SUBROUTINE ECDIFE(NBAND,LMAX,ITAB,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC CCOPTIO
  6. -INC CCFXDR
  7. external LONG
  8. DIMENSION ITAB(1)
  9. IF (LMAX.EQ.0) GO TO 1
  10. DIMATT=DIMATT+LMAX+1
  11. dimato=dimatt
  12. IF( DIMATT.GT.DIMFIC) THEN
  13. DIMATT=LMAX
  14. ll = long (nomfic)
  15. iprefi=iprefi+1
  16. if(iprefi.ge.10000) then
  17. call erreur (945)
  18. return
  19. endif
  20. * write(6,*)' ecdife iprefi dimato dimfic',iprefi,dimato,dimfic
  21. write(6,*) ' lmax' , lmax
  22. if(iprefi.eq.1) THEN
  23. nomfic(ll+1:ll+2)='_1'
  24. ll=ll+2
  25. elseif(iprefi.lt.10) then
  26. write(nomfic(ll:ll),fmt='(I1)')iprefi
  27. elseif(iprefi.lt.100) then
  28. if(iprefi.eq.10)ll = ll + 1
  29. write(nomfic(ll-1:ll),fmt='(I2)')iprefi
  30. elseif(iprefi.lt.1000) then
  31. if(iprefi.eq.100) ll = ll + 1
  32. write(nomfic(ll-2:ll),fmt='(I3)')iprefi
  33. elseif(iprefi.lt.10000) then
  34. if(iprefi.eq.1000) ll = ll + 1
  35. write(nomfic(ll-3:ll),fmt='(I4)')iprefi
  36. else
  37. call erreur (1003)
  38. endif
  39. if (iform.ne.2) close (unit=nband)
  40. if (iform.eq.2) ios=IXDRCLOSE( ixdrw,.TRUE. )
  41.  
  42. if(iform.eq.1) then
  43. OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMFIC(1:ll),
  44. # IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
  45. ELSEif (iform.eq.0) then
  46. OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMFIC(1:ll),
  47. # IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
  48. elseif (iform.eq.2) then
  49. ios= initxdr(NOMFIC(1:ll),'w',.TRUE.)
  50. endif
  51. write(6,*) 'ecdife : Ouverture du fichier : ',nomfic(1:ll)
  52. write(6,*) ' dimfic , dimatold , dimatt ',dimfic,dimato, dimatt
  53. endif
  54. lmaxl=lmax
  55. do 10 j=0,0
  56. IF (IFORM.EQ.1.AND.IONIVE.GE.4)
  57. # WRITE(NBAND,8000) (ITAB(I+j),I=1,LMAX)
  58. IF (IFORM.EQ.1.AND.IONIVE.LT.4)
  59. # WRITE(NBAND,8001) (ITAB(I+j),I=1,LMAX)
  60. IF (IFORM.EQ.0)WRITE(NBAND) (ITAB(I+j),I=1,LMAX)
  61. IF (iform.eq.2) ios=IXDRIMAT( ixdrw, lmaxl,itab(1))
  62. 10 continue
  63. 8000 FORMAT(10I8)
  64. 8001 FORMAT(16I5)
  65. 1 RETURN
  66. 2000 continue
  67. MOTERR=NOMfic(1:ll)
  68. INTERR(1)=IOS
  69. CALL ERREUR(424)
  70. RETURN
  71. END
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  

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