Esope source files

   1 : C MUCHPO    SOURCE    CHAT      05/01/13    01:54:25     5004           
   2 :       SUBROUTINE MUCHPO(IPO1,XFLOT,IRET,IEPS)                                   
   3 : C=======================================================================        
   4 : C                                                                               
   5 : C     MULTIPLIE UN CHPS PAR POINT PAR XFLO  SI IEPS=1                           
   6 : C     MULTIPLIE UN CHPS PAR POINT PAR 1/XFLO SI IEPS=-1                         
   7 : C     LE CHPS RESULTANT VOIT SON POINTEUR STOCKE DANS IRET                      
   8 : C     SI L OPERATION N EST PAS POSSIBLE IRET=0                                  
   9 : C        PAR EXAMPLE SI IEPS=-1 ET XFLOT=0.                                     
  10 : C  ENTREES                                                                      
  11 : C     IPO1=POINTEUR SUR LE CHAMPOINT                                            
  12 : C     XFLOT=SCALAIRE                                                            
  13 : C     IEPS=1 SI MULTIPLICATION -1 SI DIVISION                                   
  14 : C  SORTIES                                                                      
  15 : C     IRET=POINTEUR SUR LE CHAMPS*XFLOT**IEPS                                   
  16 : C         =0 SI L OPERATION EST IMPOSSSIBLE                                     
  17 : C                                                                               
  18 : C     CODE EBERSOLT JUIN 84                                                     
  19 : C     ATTENTION LES CHAMPS PAR ELEMENTS SONT EN DOUBLE PRECISION                
  20 : C     SI ON VOULAIT PASSER EN SIMPLE IL FAUT CHANGER VELCHA EN VELCHD           
  21 : C                                                                               
  22 : C=======================================================================        
  23 :       IMPLICIT INTEGER(I-N)
  24 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  25 : -INC SMCHPOI                                                                    
  26 : -INC CCOPTIO                                                                    
  27 :       IRET=0                                                                    
  28 :       IF(IEPS.EQ.-1.AND.XFLOT.EQ.0.) GOTO 666                                   
  29 :       IF(IEPS.EQ.1)  XFLOT1=XFLOT                                               
  30 :       IF(IEPS.EQ.-1) XFLOT1=1.D0/XFLOT                                          
  31 :       MCHPO1=IPO1                                                               
  32 :       SEGACT MCHPO1                                                             
  33 :       NSOUPO=MCHPO1.IPCHP(/1)   
  34 :       NAT=MCHPO1.JATTRI(/1)                                                
  35 :       SEGINI MCHPOI                                                             
  36 :       IRET=MCHPOI                                                               
  37 :       MTYPOI=MCHPO1.MTYPOI                                                      
  38 :       IFOPOI   =MCHPO1.IFOPOI                                                   
  39 :       MOCHDE=MCHPO1.MOCHDE 
  40 :       DO 50 IN = 1,NAT
  41 :       JATTRI(IN) = MCHPO1.JATTRI(IN)
  42 :   50  CONTINUE
  43 : *                                                     
  44 :       DO 72 IA=1,NSOUPO                                                         
  45 :         MSOUP1=MCHPO1.IPCHP(IA)                                                   
  46 :         SEGACT MSOUP1                                                             
  47 :         NC=MSOUP1.NOCOMP(/2)                                                      
  48 :         SEGINI MSOUPO                                                             
  49 :         IPCHP(IA)=MSOUPO                                                          
  50 :         IGEOC=MSOUP1.IGEOC  
  51 : *                                                      
  52 :         DO 73 IB=1,NC                                                             
  53 :           NOCOMP(IB)=MSOUP1.NOCOMP(IB)                                              
  54 :           NOHARM(IB)=MSOUP1.NOHARM(IB)                                              
  55 :   73    CONTINUE 
  56 : *                                                                 
  57 :         MPOVA1=MSOUP1.IPOVAL                                                      
  58 :         SEGACT MPOVA1                                                             
  59 :         N=MPOVA1.VPOCHA(/1)                                                       
  60 :         NC=MPOVA1.VPOCHA(/2)                                                      
  61 :         SEGINI MPOVAL                                                             
  62 :         IPOVAL=MPOVAL  
  63 : *                                                           
  64 :         DO 75 IB=1,N                                                              
  65 :           DO 75 IC=1,NC                                                             
  66 :              VPOCHA(IB,IC)=XFLOT1*MPOVA1.VPOCHA(IB,IC)                                 
  67 :   75    CONTINUE  
  68 : *                                                                
  69 :         SEGDES MPOVAL,MPOVA1                                                      
  70 :         SEGDES MSOUPO,MSOUP1                                                      
  71 :   72  CONTINUE                                                                  
  72 :       SEGDES MCHPOI,MCHPO1                                                      
  73 :   666 CONTINUE                                                                  
  74 :       RETURN                                                                    
  75 :       END                                                                       
  76 :