Télécharger ecdifr.eso

Retour à la liste

Numérotation des lignes :

  1. C ECDIFR SOURCE PV 14/04/09 21:15:15 8029
  2. SUBROUTINE ECDIFR(NBAND,LMAX,R,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 R(1)
  9. IF (LMAX.EQ.0) GO TO 1
  10. DIMATT=DIMATT+LMAX*2
  11. dimato= dimatt
  12. IF( DIMATT.GT.DIMFIC) THEN
  13. DIMATT=LMAX*2 +1
  14. ll = long (nomfic)
  15. iprefi=iprefi+1
  16. if(iprefi.ge.10000) then
  17. call erreur (945)
  18. return
  19. endif
  20. if(iprefi.eq.1) THEN
  21. nomfic(ll+1:ll+2)='_1'
  22. ll=ll+2
  23. elseif(iprefi.lt.10) then
  24. write(nomfic(ll:ll),fmt='(I1)')iprefi
  25. elseif(iprefi.lt.100) then
  26. if(iprefi.eq.10)ll = ll + 1
  27. write(nomfic(ll-1:ll),fmt='(I2)')iprefi
  28. elseif(iprefi.lt.1000) then
  29. if(iprefi.eq.100) ll = ll + 1
  30. write(nomfic(ll-2:ll),fmt='(I3)')iprefi
  31. elseif(iprefi.lt.10000) then
  32. if(iprefi.eq.1000) ll = ll + 1
  33. write(nomfic(ll-3:ll),fmt='(I4)')iprefi
  34. else
  35. call erreur (1003)
  36. endif
  37. if (iform.ne.2) close (unit=nband)
  38. if (iform.eq.2) ios=IXDRCLOSE( ixdrw,.TRUE. )
  39.  
  40. if(iform.eq.1) then
  41. OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMFIC(1:ll),
  42. # IOSTAT=IOS,ERR=2000,FORM='FORMATTED')
  43. ELSEif (iform.eq.0) then
  44. OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMFIC(1:ll),
  45. # IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
  46. elseif (iform.eq.2) then
  47. ios= initxdr(NOMFIC(1:ll),'w',.TRUE.)
  48. endif
  49. ** write(6,*) 'ecdifr : Ouverture du fichier : ',nomfic(1:ll)
  50. ** write(6,*) ' dimfic , dimatold , dimatt ',dimfic,dimato, dimatt
  51. endif
  52. do 10 j=0,0
  53. IF(IONIVE.GT.2) THEN
  54. IF(IFORM.EQ.1) WRITE(NBAND,8003) (R(I+J),I=1,LMAX)
  55. IF(IFORM.EQ.0)WRITE(NBAND) (R(I+J),I=1,LMAX)
  56. if (iform.eq.2) ios=IXDRDMAT( ixdrw, lmax,r(1))
  57.  
  58. 8003 FORMAT(1P,3E22.14)
  59. ELSE
  60. IF(IFORM.EQ.1)WRITE(NBAND,8002) (R(I+J),I=1,LMAX)
  61. IF(IFORM.EQ.0)WRITE(NBAND) (R(I+J),I=1,LMAX)
  62. if (iform.eq.2) ios=IXDRDMAT( ixdrw, lmax,r(1))
  63. 8002 FORMAT(1P,6E13.6)
  64. ENDIF
  65. 10 continue
  66. 1 RETURN
  67. 2000 continue
  68. MOTERR=NOMfic(1:ll)
  69. INTERR(1)=IOS
  70. CALL ERREUR(424)
  71. RETURN
  72. END
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  

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