Esope source files

   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
  28 :         call erreur (945)
  29 :         iretou=1
  30 :         return
  31 :       endif
  32 :       if(ificle.eq.1) then
  33 :         nomres(ll+1:ll+2)='_1'
  34 :         ll=ll+2
  35 :       elseif ( ificle.lt.10) then 
  36 :         write(nomres(ll:ll),fmt='(I1)')ificle
  37 :       elseif ( ificle.lt.100) then        
  38 :         if(ificle.eq.10)ll = ll + 1        
  39 :         write(nomres(ll-1:ll),fmt='(I2)')ificle 
  40 :       elseif  ( ificle.lt.1000) then  
  41 :         if(ificle.eq.100)ll = ll + 1
  42 :         write(nomres(ll-2:ll),fmt='(I3)')ificle 
  43 :       elseif  ( ificle.lt.10000) then  
  44 :         if(ificle.eq.1000)ll = ll + 1
  45 :         write(nomres(ll-3:ll),fmt='(I4)')ificle          
  46 :       endif
  47 :       if (iform.ne.2) close (unit=nband)
  48 :       if (iform.eq.2) ios=IXDRCLOSE( ixdrr)
  49 :       if(iform.eq.1) then
  50 :            OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMRES(1:ll),
  51 :      #    IOSTAT=IOS,ERR=2000,FORM='FORMATTED')      
  52 :         ELSEif (iform.eq.0) then
  53 :           OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMRES(1:ll),
  54 :      #    IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED')
  55 :         else
  56 :           ios=INITXDR( NOMRES(1:ll),'r',.true.)
  57 :           if (ios.lt.0) goto 2000
  58 :         ENDIF
  59 :         write (6,*) 'Ouverture du fichier : ',nomres(1:ll)
  60 :       go to 10
  61 :                                                          
  62 :  1000 IRETOU=1                                                                  
  63 :       RETURN
  64 :  2000 continue
  65 :       MOTERR=NOMRES(1:ll)
  66 :       INTERR(1)=IOS  
  66 :       CALL ERREUR(424)
  67 :       RETURN                                                                              
  68 :       END                                                                       
  69 :  
  70 :  
  71 :  
  72 :  
  73 :