Esope source files

   1 : C DEMCH1    SOURCE    CHAT      05/01/12    22:41:37     5004           
   2 : C   UTILITAIRE DE DEMCHA (GESTION NOEUD MILIEU)                                 
   3 : C                                                                               
   4 :       SUBROUTINE DEMCH1(I1,I3,I2,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)            
   5 :       IMPLICIT INTEGER(I-N)
   6 : -INC CCOPTIO                                                                    
   7 : -INC SMCOORD                                                                    
   8 :       SEGMENT KONPOS(NBPTS)                                                     
   9 :       SEGMENT KONFIN(IKOUR)                                                     
  10 :       SEGMENT KONMIL(IKOUR)                                                     
  11 :       SEGMENT KONSUI(IKOUR)                                                     
  12 :       J1=MIN(I1,I3)                                                             
  13 :       J3=MAX(I1,I3)                                                             
  14 :       ITFA=KONPOS(J1)                                                           
  15 :       IF (ITFA.EQ.0) GOTO 90                                                    
  16 :   85  CONTINUE                                                                  
  17 :       ITF=KONSUI(ITFA)                                                          
  18 :       IF (KONFIN(ITFA).EQ.J3) GOTO 80                                           
  19 :       IF (ITF.EQ.0) GOTO 90                                                     
  20 :       ITFA=ITF                                                                  
  21 :       GOTO 85                                                                   
  22 :   90  KONCOU=KONCOU+1                                                           
  23 :       IF (KONCOU.GE.KONFIN(/1)) THEN                                            
  24 :         IKOUR=KONCOU+500                                                        
  25 :         SEGADJ KONFIN,KONMIL,KONSUI                                             
  26 :       ENDIF                                                                     
  27 :       IF (ITFA.EQ.0) THEN                                                       
  28 :        KONPOS(J1)=KONCOU                                                        
  29 :       ELSE                                                                      
  30 :        KONSUI(ITFA)=KONCOU                                                      
  31 :       ENDIF                                                                     
  32 :       KONFIN(KONCOU)=J3                                                         
  33 : * CREATION DE NOEUD                                                             
  34 :       NBPTS=XCOOR(/1)/(IDIM+1)+1                                                
  35 :       SEGADJ MCOORD                                                             
  36 :       DO 100 ICOOR=1,IDIM+1                                                     
  37 :       XCOOR((NBPTS-1)*(IDIM+1)+ICOOR)=                                          
  38 :      #   (XCOOR((J1-1)*(IDIM+1)+ICOOR)+XCOOR((J3-1)*(IDIM+1)+ICOOR))/2.         
  39 :  100  CONTINUE                                                                  
  40 :       KONMIL(KONCOU)=NBPTS                                                      
  41 :       ITFA=KONCOU                                                               
  42 :   80  CONTINUE                                                                  
  43 :       I2=KONMIL(ITFA)                                                           
  44 :       END                                                                       
  45 :