Esope source files

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