Esope source files

   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
  16 :           call erreur (945)
  17 :           return
  18 :         endif
  19 : *        write(6,*)' ecdife iprefi dimato dimfic',iprefi,dimato,dimfic
  20 :         write(6,*) ' lmax' , lmax
  21 :         if(iprefi.eq.1) THEN
  22 :           nomfic(ll+1:ll+2)='_1'
  23 :           ll=ll+2
  24 :         elseif(iprefi.lt.10) then 
  25 :           write(nomfic(ll:ll),fmt='(I1)')iprefi
  26 :         elseif(iprefi.lt.100) then
  27 :           if(iprefi.eq.10)ll = ll + 1
  28 :           write(nomfic(ll-1:ll),fmt='(I2)')iprefi
  29 :         elseif(iprefi.lt.1000) then
  30 :           if(iprefi.eq.100) ll = ll + 1
  31 :           write(nomfic(ll-2:ll),fmt='(I3)')iprefi
  32 :         elseif(iprefi.lt.10000) then 
  33 :           if(iprefi.eq.1000) ll = ll + 1
  34 :           write(nomfic(ll-3:ll),fmt='(I4)')iprefi
  35 :         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,*) 'ecdife : Ouverture du fichier : ',nomfic(1:ll)
  50 :       write(6,*) ' dimfic , dimatold , dimatt ',dimfic,dimato, dimatt
  51 :       endif                                                                       
  52 :       lmaxl=lmax
  53 :       do 10 j=0,0
  54 :       IF (IFORM.EQ.1.AND.IONIVE.GE.4)                                           
  55 :      #       WRITE(NBAND,8000) (ITAB(I+j),I=1,LMAX)
  56 :       IF (IFORM.EQ.1.AND.IONIVE.LT.4)                                           
  57 :      #       WRITE(NBAND,8001) (ITAB(I+j),I=1,LMAX)
  58 :       IF (IFORM.EQ.0)WRITE(NBAND) (ITAB(I+j),I=1,LMAX)
  59 :       IF (iform.eq.2) ios=IXDRIMAT( ixdrw, lmaxl,itab(1))
  60 :   10  continue
  61 :  8000 FORMAT(10I8)                                                              
  62 :  8001 FORMAT(16I5)                                                              
  63 :    1  RETURN 
  64 :  2000 continue
  65 :       MOTERR=NOMfic(1:ll)
  66 :       INTERR(1)=IOS  
  66 :       CALL ERREUR(424)
  67 :       RETURN                                                                     
  68 :       END                                                                       
  69 :  
  70 : 
  71 :  
  72 :  
  73 :  
  74 :  
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :