Esope source files

   1 : C INTOP1    SOURCE    CHAT      05/01/13    00:41:27     5004           
   2 : C   INTERFACE ENTRE LES LECTURES DE DONNEES D'OPERATIONS ELEMENTAIRES           
   3 : C   ET LES PROGRAMMES D'EXECUTIONS                                              
   4 : C                                                                               
   5 :       SUBROUTINE INTOP1(IP2,IP1)                                                 
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   8 : -INC CCOPTIO                                                                    
   9 : -INC SMELEME                                                                    
  10 : -INC SMCOORD                                                                    
  11 : -INC SMCHPOI                                                                    
  12 :       SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
  13 :       DIMENSION X(3)                                                           
  14 :       SEGMENT ITABEL(2)                                                         
  15 :       SEGINI ITABEL                                                             
  16 :       ITABEL(1)=IP1                                                          
  17 :       ITABEL(2)=IP2                                                          
  18 :       SEGINI ICPR                                                               
  19 :       DO 1 I=1,ICPR(/1)                                                         
  20 :    1  ICPR(I)=0                                                                 
  21 :       NBELT=ITABEL(/1)                                                          
  22 :       DO 7 IITT=1,NBELT                                                         
  23 :       IF (IITT .EQ. 1) THEN 
  24 :         IPCH1 = ITABEL(NBELT+1-IITT)
  24 :         CALL COPIE2(IPCH1,IPCH) 
  25 :         MCHPOI = IPCH 
  26 :         SEGACT MCHPOI 
  27 :         NSOUPO=IPCHP(/1)                                                   
  28 :         DO 9 IC =1,NSOUPO  
  29 :           MSOUPO = IPCHP(IC) 
  30 :           SEGACT MSOUPO*MOD 
  31 :           IF ( NOCOMP(/2) .NE. 1) THEN
  31 :               CALL ERREUR (251) 
  32 :               SEGSUP MSOUPO
  33 :               SEGSUP MCHPOI
  34 :               SEGSUP ICPR,ITABEL                                                        
  35 :               RETURN                                                     
  36 :           ENDIF 
  37 :           MELEME = IGEOC
  37 :           CALL ADDITI(X,MELEME,NOUV,ICPR)                                           
  38 :           IF (IERR.NE.0) THEN
  39 :               SEGSUP MSOUPO
  40 :               SEGSUP MCHPOI
  41 :               SEGSUP ICPR,ITABEL                                                        
  42 :               RETURN                                                     
  43 :           ENDIF 
  44 :           IGEOC = NOUV
  45 :           SEGDES MSOUPO 
  46 :     9   CONTINUE    
  46 :         CALL   ECROBJ('CHPOINT',IPCH)
  47 :         SEGDES MCHPOI 
  48 :         GOTO 8 
  49 :       ENDIF 
  50 :       MELEME=ITABEL(NBELT+1-IITT)                                               
  51 :       SEGACT MELEME                                                             
  52 :       IF (LISOUS(/1).NE.0) GOTO 15                                              
  52 :       CALL ADDITI(X,MELEME,NOUV,ICPR)                                           
  53 :       IF (IERR.NE.0) RETURN                                                     
  54 :       MELEME=NOUV                                                               
  55 :       SEGDES MELEME                                                             
  55 :  20   CALL ECROBJ('MAILLAGE',MELEME)                                            
  56 :       GOTO 8                                                                    
  57 :   15  CONTINUE                                                                  
  58 :       NBSOUS=LISOUS(/1)                                                         
  59 :       NBREF=LISREF(/1)                                                          
  60 :       NBNN=0                                                                    
  61 :       NBELEM=0                                                                  
  62 :       SEGINI IPT1                                                               
  63 :       DO 30 I=1,LISOUS(/1)                                                      
  64 :       ILIS=LISOUS(I)                                                            
  64 :       CALL ADDITI(X,ILIS,NOUV,ICPR)                                             
  65 :       IF (IERR.NE.0) RETURN                                                     
  66 :       IPT1.LISOUS(I)=NOUV                                                       
  67 :   30  CONTINUE                                                                  
  68 :       IF (LISREF(/1).EQ.0) GOTO 32                                              
  69 :       DO 31 I=1,LISREF(/1)                                                      
  70 :       ILIS=LISREF(I)                                                            
  70 :       CALL ADDITI(X,ILIS,NOUV,ICPR)                                             
  71 :       IF (IERR.NE.0) RETURN                                                     
  72 :       IPT1.LISREF(I)=NOUV                                                       
  73 :   31  CONTINUE                                                                  
  74 :   32  CONTINUE                                                                  
  75 :       SEGDES MELEME                                                             
  76 :       MELEME=IPT1                                                               
  77 :       GOTO 20                                                                   
  78 :    8  CONTINUE                                                                  
  79 :    7  CONTINUE                                                                  
  80 :       SEGSUP ICPR,ITABEL                                                        
  81 :       RETURN                                                                    
  82 :       END                                                                       
  83 :  
  84 :  
  85 :