Esope source files

   1 : C DCOMP1    SOURCE    CHAT      05/01/12    22:37:37     5004           
   2 :       SUBROUTINE DCOMP1 (NUMPO1,LNUMPO,XCOOR,  SUITX,SUITY,SUITZ)               
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             D C O M P 1                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     DECOMPOSER UNE SUITE DE POINTS EN 2 OU 3 SUITES DE REELS (SELON LA        
  12 : *     DIMENSION DE L'ESPACE).                                                   
  13 : *                                                                               
  14 : * MODULES UTILISES:                                                             
  15 : * -----------------                                                             
  16 : *                                                                               
  17 :       IMPLICIT INTEGER(I-N)
  18 : -INC CCOPTIO                                                                    
  19 : *                                                                               
  20 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
  21 : * -----------                                                                   
  22 : *                                                                               
  23 : *    +IDIM    (E)  VOIR LE COMMUN "COPTIO".                                     
  24 : *     NUMPO1  (E)  LISTE DE NUMEROS DE POINTS.                                  
  25 : *     LNUMPO  (E)  LONGUEUR DE LA LISTE "NUMPO1".                               
  26 : *     XCOOR   (E)  ANALOGUE AU CONTENU DU SEGMENT "MCOORD".                     
  27 : *     SUITX   (S)  TABLE DES ABSCISSES ASSOCIEES AUX POINTS DE "NUMPO1".        
  28 : *     SUITY   (S)  TABLE DES ORDONNESS ASSOCIEES AUX POINTS DE "NUMPO1".        
  29 : *     SUITZ   (S)  TABLE DES COTES ASSOCIEES AUX POINTS DE "NUMPO1".            
  30 : *                  (SI DIMENSION 3)                                             
  31 : *                                                                               
  32 :       INTEGER NUMPO1(*),LNUMPO                                                  
  33 :       REAL*8 XCOOR(*),SUITX(*),SUITY(*),SUITZ(*)                                
  34 : *                                                                               
  35 : * AUTEUR, DATE DE CREATION:                                                     
  36 : * -------------------------                                                     
  37 : *                                                                               
  38 : *     PASCAL MANIGOT     24 FEVRIER 1987                                        
  39 : *                                                                               
  40 : * LANGAGE:                                                                      
  41 : * --------                                                                      
  42 : *                                                                               
  43 : *     FORTRAN77 + EXTENSION: DECLARATION "REAL*8".                              
  44 : *                                                                               
  45 : ************************************************************************        
  46 : *                                                                               
  47 :       IDIMP1 = IDIM + 1                                                         
  48 :       DO 100 IB=1,LNUMPO                                                        
  49 :          NN = (NUMPO1(IB) - 1) * IDIMP1                                         
  50 :          SUITX(IB) = XCOOR(NN+1)                                                
  51 :          SUITY(IB) = XCOOR(NN+2)                                                
  52 :          IF (IDIM .EQ. 3) SUITZ(IB) = XCOOR(NN+3)                               
  53 :   100    CONTINUE                                                               
  54 : *     END DO                                                                    
  55 : *                                                                               
  56 :       END                                                                       
  57 :