Esope source files

   1 : C LIMAIL    SOURCE    JC220346  12/10/24    21:15:00     7544           
   2 :       SUBROUTINE LIMAIL (MELEME,NBANC,IRETOU,IFORM)                             
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 : C=======================================================================        
   6 : C                                                                               
   7 : C    BUT          :  LECTURE D UN MELEME SUR LA BANDE IORES                     
   8 : C                    INCREMENT DES NUMEROS SI NBANC NON NUL                     
   9 : C    ECRIT PAR FARVACQUE -REPRIS PAR LENA                                       
  10 : C    APPELLE      :  LFCDIE                                                     
  11 : C    APPELLE PAR  :  LIPIL                                                      
  12 : C=======================================================================        
  13 : -INC CCOPTIO                                                                    
  14 : -INC CCGEOME                                                                    
  15 : -INC SMELEME                                                                    
  16 : C=======================================================================        
  17 : C                                                                               
  18 :       DIMENSION ILENA(10)                                                       
  19 : C                                                                               
  20 : C*******************LECTURE D 1 OBJET MAILLAGE                                  
  21 : C                                                                           
  22 :       IRET=0                                                                    
  23 :       MELEME=0                                                                  
  24 :       ITOTO    = 5                                                              
  24 :       CALL LFCDIE (IORES,ITOTO,ILENA,IRET,IFORM)                                
  25 :       IF(IRET.NE.0) GOTO 1000                                                   
  26 :       NOMLU =ILENA(1)                                                           
  27 :       NBSOUS=ILENA(2)                                                           
  28 :       NBREF =ILENA(3)                                                           
  29 :       NBNN  =ILENA(4)                                                           
  30 :       NBELEM=ILENA(5)                                                           
  31 : C     TEST S IL S AGIT D UN MELEME NUL                                          
  32 :       ITEST= ILENA(1)+ILENA(2)+ILENA(3)+ILENA(4)+ILENA(5)                       
  33 :       IF (ITEST.EQ.-100)GO TO  1000   
  34 :       SEGINI MELEME                                                                                                          
  34 :       CALL LFCDIE (IORES,NBSOUS,LISOUS,IRET,IFORM)                              
  35 :       IF(IRET.NE.0) GOTO 1001                                                   
  35 :       CALL LFCDIE (IORES,NBREF,LISREF,IRET,IFORM)                               
  36 :       IF(IRET.NE.0) GOTO 1001                                                                                                
  37 : C---- EST CE UN TYPE D'ELEM CONNU                                               
  38 :       IF(NOMLU.LE.NOMBR)GOTO 11                                                 
  39 :   10  CONTINUE                                                                  
  40 : C     MCOT(1)=NOMLU                                                             
  41 : C     WRITE (MOT(1:4),FMT='(A4)') MCOT                                          
  42 :       IRET=1                                                                    
  43 :       GO TO 1000                                                                
  44 : C-- FAIRE ICI QQCHOSESI ELEM INCONNU                                            
  45 : C -----                                                                         
  46 :   11  ITYPEL=NOMLU
  47 :       IF (NBELEM.EQ.0) GOTO 7                                                                   
  48 :       L=NBELEM*NBNN                                                             
  48 :       CALL LFCDIE(IORES,NBELEM,ICOLOR,IRET,IFORM)                               
  49 :       IF(IRET.NE.0) GOTO 1001                                                   
  49 :   13  CALL LFCDIE(IORES,L,NUM,IRET,IFORM)                                       
  50 :       IF(IRET.NE.0) GOTO 1001                                                   
  51 : C --- INCREMENTATION DES NUMEROS 
  52 :       IF(IONIVE.LE.9) THEN                                               
  53 :         DO 17 IK=1,NBNN                                                           
  54 :         DO 17 JK=1,NBELEM                                                         
  55 :         NUM(IK,JK)=NUM(IK,JK)+NBANC                                               
  56 :   17     CONTINUE 
  57 :       ENDIF                                                     
  58 :    7  CONTINUE                                                                  
  59 :       SEGDES MELEME                                                             
  60 :       GO TO 1000                                                                
  61 : C --- CAS D ERREUR                                                              
  62 :  1001 CONTINUE                                                                  
  63 :       SEGSUP MELEME                                                             
  64 : C ---                                                                           
  65 :  1000 IRETOU=IRET                                                               
  66 :       RETURN                                                                    
  67 :       END                                                                       
  68 :  
  69 :  
  70 :  
  71 :  
  72 :  
  73 :  
  74 :  
  75 :  
  76 :  
  77 :