Esope source files

   1 : C MANUC1    SOURCE    CHAT      05/01/13    01:28:23     5004           
   2 :       SUBROUTINE MANUC1(IPOE,NOMC,LIST1,IPOC)                                   
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 :       CHARACTER*(4) CMOT                                                        
   6 : C***********************************************************************        
   7 : C MANUC1 SIMULE L'APPEL DE L'OPERATEUR MANU CHPO POUR CREER UN CHPOINT *        
   8 : C***********************************************************************        
   9 : C  ATTENTION : LES SEGMENTS LIST1 DOIVENT RESTER ACTIFS                *        
  10 : C                           NOMC                                       *        
  11 : C  SINON TRANSFORMER PREPA0                                            *        
  12 : C***********************************************************************        
  13 : C ARGUMENT                                                             *        
  14 : C --------                                                             *        
  15 : C  ENTREE :                                                            *        
  16 : C   IPOE = POINTEUR SUR UN OBJET GEOMETRIE                             *        
  17 : C   LIST1= SEGMENT    ILIST   QUI CONTIENT LES POINTEURS SUR LES LIST  *        
  18 : C          REEL CONTENANT LES VALEURS DU CHPOINT(CF NOTICE MANU CHPO)  *        
  19 : C   NOMC = SEGAMENT   ICARA   QUI CONTIENT LE NOM DES COMPOSANTES      *        
  20 : C          ON DOIT AVOIR LIST(/1) > OU = LCARA(/2)                     *        
  21 : C  SORTIE :                                                            *        
  22 : C   IPOC = POINTEUR SUR LE MCHPOI                                      *        
  23 : C   (IL Y A CREATION D UNE GEOMETRIE)                                  *        
  24 : C                                                                      *        
  25 : C APPELE LES  SB : CHANGE,ECRIRE,LIRE,MANUCH                           *        
  26 : C***********************************************************************        
  27 : -INC CCOPTIO                                                                    
  28 : -INC SMELEME                                                                    
  29 :       SEGMENT ILIST                                                             
  30 :       INTEGER LIST(NLIST)                                                       
  31 :       ENDSEGMENT                                                                
  32 :       POINTEUR ILIS1.ILIST,ILIS2.ILIST,ILIS3.ILIST                              
  33 :       SEGMENT ICARA                                                             
  34 :       CHARACTER*4 LCARA(NCARA)                                                  
  35 :       ENDSEGMENT                                                                
  36 :       POINTEUR ICAR1.ICARA,ICAR2.ICARA,ICAR3.ICARA                              
  37 : C                                                                               
  38 :       ILIST = LIST1                                                             
  39 :       ICARA = NOMC                                                              
  40 :       SEGACT ICARA,ILIST                                                        
  41 :       IC = LCARA(/2)                                                            
  42 :       JC = LIST(/1)                                                             
  43 :       IF(JC.LT.IC) GOTO 5000                                                    
  44 : C                                                                               
  45 : C     CREATION A PARTIR DE IPOE D' UN NOUVEAU MAILLAGE IPO1                     
  46 : C                                                                               
  47 :       IPT1 = IPOE                                                               
  48 :       SEGINI,MELEME = IPT1                                                      
  49 :       IPO1 = MELEME                                                             
  50 : C                                                                               
  51 :       DO 1 I = 1,IC                                                             
  51 :       CALL ECROBJ('LISTREEL',LIST(IC+1-I))                                      
  52 :       CMOT = LCARA(IC+1-I)                                                      
  52 :       CALL ECRCHA(CMOT)                                                         
  53 :     1 CONTINUE                                                                  
  53 :       CALL ECRENT(IC)                                                           
  53 :       CALL ECROBJ('MAILLAGE',IPO1)                                              
  53 :       CALL MANUCH                                                               
  53 :       CALL LIROBJ('CHPOINT ',IPOC,1,IRETOU)                                     
  54 :       RETURN                                                                    
  55 : 5000  CONTINUE                                                                  
  56 :       WRITE(IOIMP,5001)                                                         
  57 : 5001  FORMAT(' ERREUR DANS MANUC1 : IL MANQUE UN ( OU DES ) LISTREEL')          
  58 :       RETURN                                                                    
  59 :       END                                                                       
  60 :