Esope source files

   1 : C CONGE     SOURCE    CHAT      05/01/12    22:17:20     5004           
   2 :       SUBROUTINE CONGE                                                          
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             C O N G E                                         
   6 : *                             ---------                                         
   7 : *                                                                               
   8 : *            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "CONGE"                       
   9 : *                                                                               
  10 : * FONCTION:                                                                     
  11 : * ---------                                                                     
  12 : *                                                                               
  13 : *     CREER UN CONGE DE RACCORDEMENT ENTRE 2 LIGNES.                            
  14 : *                                                                               
  15 : *     C'EST LE VOISINAGE DE LA FIN DE LA PREMIERE LIGNE QUI EST                 
  16 : *     RACCORDE AU VOISINAGE DU DEBUT DE LA DEUXIEME LIGNE.                      
  17 : *     DANS CES VOISINAGES, LES LIGNES DOIVENT ETRE COPLANAIRES.                 
  18 : *                                                                               
  19 : * PHRASE D'APPEL (EN GIBIANE):                                                  
  20 : * ----------------------------                                                  
  21 : *                                                                               
  22 : *     NL1 RAC NL2 = CONGE (N) L1 R L2 (DOUBLE) ;                                
  23 : *                                                                               
  24 : * OPERANDES ET RESULTATS:                                                       
  25 : * -----------------------                                                       
  26 : *                                                                               
  27 : *     N         'ENTIER  '  NOMBRE D'ELEMENTS A CREER SUR LE CONGE.             
  28 : *                           LA TAILLE DES ELEMENTS TIENDRA COMPTE DES           
  29 : *                           DENSITES DES EXTREMITES SI "N" EST NEGATIF.         
  30 : *     L1        'MAILLAGE'  LIGNE A RACCORDER EN QUEUE.                         
  31 : *     R         'FLOTTANT'  RAYON DE RACCORDEMENT.                              
  32 : *     L2        'MAILLAGE'  LIGNE A RACCORDER EN TETE.                          
  33 : *     NL1       'MAILLAGE'  LIGNE S'APPUYANT SUR "L1" ET S'ARRETANT A           
  34 : *                           UNE EXTREMITE DU CONGE.                             
  35 : *     NL2       'MAILLAGE'  LIGNE S'APPUYANT SUR "L2" ET S'ARRETANT A           
  36 : *                           L'AUTRE EXTREMITE DU CONGE.                         
  37 : *     LRAC      'MAILLAGE'  CONGE DE RACCORDEMENT CREE.                         
  38 : *                                                                               
  39 : * MODULES UTILISES:                                                             
  40 : * -----------------                                                             
  41 : *                                                                               
  42 :       IMPLICIT INTEGER(I-N)
  43 : -INC CCOPTIO                                                                    
  44 : -INC CCREEL                                                                     
  45 : *                                                                               
  46 : * VARIABLES:                                                                    
  47 : * ----------                                                                    
  48 : *                                                                               
  49 : *     RCONGE = RAYON DU CONGE DE RACCORDEMENT.                                  
  50 : *     TCONGE = TYPE DE CONGE ('SIMPLE' OU 'DOUBLE').                            
  51 : *                                                                               
  52 :       REAL*8 RCONGE                                                             
  53 :       CHARACTER*8 TCONGE                                                        
  54 : *                                                                               
  55 : * AUTEUR, DATE DE CREATION:                                                     
  56 : * -------------------------                                                     
  57 : *                                                                               
  58 : *     PASCAL MANIGOT     19 NOVEMBRE 1987                                       
  59 : *                                                                               
  60 : * LANGAGE:                                                                      
  61 : * --------                                                                      
  62 : *                                                                               
  63 : *     FORTRAN77 + EXTENSION: DECLARATION "REAL*8".                              
  64 : *                                                                               
  65 : ************************************************************************        
  66 : *                                                                               
  67 : *     LECTURE DU TYPE DU CONGE:                                                 
  67 :       CALL LIRCHA (TCONGE,0,IRETOU)                                             
  68 :       IF (IRETOU .EQ. 0) THEN                                                   
  69 :          TCONGE = 'SIMPLE'                                                      
  70 :       ELSE IF (TCONGE(1:4).NE.'DOUB') THEN                                      
  71 :          TCONGE = 'SIMPLE'                                                      
  71 :          CALL REFUS                                                             
  72 :       END IF                                                                    
  73 : *                                                                               
  74 : *     FACTEUR DE DECOUPAGE:                                                     
  74 :       CALL LIRENT (NCONGE,0,IRETOU)                                             
  75 :       IF (IRETOU .EQ. 0) THEN                                                   
  76 :          NCONGE = 0                                                             
  77 :       END IF                                                                    
  78 : *                                                                               
  79 : *     LECTURE DU RAYON DE RACCORDEMENT:                                         
  79 :       CALL LIRE04 (XPETIT,RCONGE,0,1,IRETOU)                                    
  80 :       IF (IERR .NE. 0) RETURN                                                   
  81 : *                                                                               
  82 : *     LECTURE DES LIGNES A RACCORDER:                                           
  82 :       CALL LIROBJ ('MAILLAGE',L1,1,IRETOU)                                      
  83 :       IF (IERR .NE. 0) RETURN                                                   
  83 :       CALL LIROBJ ('MAILLAGE',L2,1,IRETOU)                                      
  84 :       IF (IERR .NE. 0) RETURN                                                   
  85 : *                                                                               
  86 : *     DEFINITION DU CONGE:                                                      
  86 :       CALL CONGE1 (TCONGE,NCONGE,L1,RCONGE,L2,  NL1,LRAC,NL2)                   
  87 :       IF (IERR .NE. 0) RETURN                                                   
  88 : *                                                                               
  88 :       CALL ECROBJ ('MAILLAGE',NL2)                                              
  88 :       CALL ECROBJ ('MAILLAGE',LRAC)                                             
  88 :       CALL ECROBJ ('MAILLAGE',NL1)                                              
  89 : *                                                                               
  90 :       END                                                                       
  91 :  
  92 :  
  93 :