Download adchpf.eso

Back to the list

   1 : C ADCHPF    SOURCE    CHAT      05/01/12    21:17:12     5004           
   2 :       SUBROUTINE ADCHPF(MCHPOI,X1,MCHPO1,ISIGN)                                 
   3 : C ADDITIONNE AU CHPOINT MCHPOIN LE FLOTTANT  X1                                 
   4 : C Modif pv 18 6 97 ne cree pas de nouvelle geometrie
   5 :       IMPLICIT INTEGER(I-N)
   6 : -INC SMCHPOI                                                                    
   7 : -INC SMELEME                                                                    
   8 :       REAL*8 X1                                                                 
   9 :       SEGACT MCHPOI                                                             
  10 :       SEGINI,MCHPO1=MCHPOI                                                      
  11 :       NC=IPCHP(/1)                                                              
  12 :       DO 1 I = 1,NC                                                             
  13 :       MSOUPO=IPCHP(I)                                                           
  14 :       SEGACT MSOUPO                                                             
  15 :       SEGINI,MSOUP1=MSOUPO                                                      
  16 :       MCHPO1.IPCHP(I) = MSOUP1                                                  
  17 :       MPOVAL=IPOVAL                                                             
  18 :       SEGACT MPOVAL
  19 :       SEGINI,MPOVA1=MPOVAL                                                      
  20 :       MSOUP1.IPOVAL=MPOVA1                                                      
  21 :       IF(ISIGN.EQ.1) THEN                                                       
  22 :       DO 2 K=1,MPOVA1.VPOCHA(/2)                                                
  23 :       DO 3 J=1,MPOVA1.VPOCHA(/1)                                                
  24 :       MPOVA1.VPOCHA(J,K)=MPOVA1.VPOCHA(J,K) + X1                                
  25 :     3 CONTINUE                                                                  
  26 :     2 CONTINUE                                                                  
  27 :       ELSEIF (ISIGN.EQ.-1) THEN                                                 
  28 :       DO 4 K=1,MPOVA1.VPOCHA(/2)                                                
  29 :       DO 5 J=1,MPOVA1.VPOCHA(/1)                                                
  30 :       MPOVA1.VPOCHA(J,K)=-(MPOVA1.VPOCHA(J,K) + X1)                             
  31 :     5 CONTINUE                                                                  
  32 :     4 CONTINUE                                                                  
  33 :       ENDIF                                                                     
  34 :       SEGDES MSOUP1,MPOVA1,MSOUPO,MPOVAL
  35 :     1 CONTINUE                                                                  
  36 :       SEGDES MCHPOI,MCHPO1                                                      
  37 :       RETURN                                                                    
  38 :       END                                                                       
  39 :  
  40 :  

© Cast3M 2003 - All rights reserved.
Disclaimer