Download pilep2.eso

Back to the list

   1 : C PILEP2    SOURCE    PV        09/03/12    21:30:10     6325           
   2 :        SUBROUTINE PILEP2(IELVA1,IELVA2,XX,IRET,CRIT)      
   3 : *                                                                               
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   6 : *                                                                               
   7 : -INC CCOPTIO                                                                    
   8 : -INC SMCHAML                                                                    
   9 : -INC SMLREEL                                                                    
  10 : -INC SMCOORD                                                                    
  11 : *                                                                               
  12 :       IRET=0                                                                    
  13 :       MELVA1=IELVA1                                                             
  14 :       MELVA2=IELVA2                                                             
  15 :       SEGACT MELVA1                                                             
  16 :       SEGACT MELVA2                                                             
  17 : *                                                                               
  18 :       NBP1=MELVA1.VELCHE(/1)                                                    
  19 :       IF (NBP1.EQ.0) THEN                                                       
  20 :         IRET = 197  
  21 :       ELSE                                                                      
  22 :          NBP2=MELVA2.VELCHE(/1)                                                 
  23 :          NEL1=MELVA1.VELCHE(/2)                                                 
  24 :          NEL2=MELVA2.VELCHE(/2)                                                 
  25 :          N1PTEL=MAX(NBP1,NBP2)                                                  
  26 :          N1EL  =MAX(NEL1,NEL2)                                                  
  27 :          N2PTEL=0                                                               
  28 :          N2EL  =0                                                                                                                   
  29 :          DO 5 IGAU=1,N1PTEL                                                     
  30 :             IGMN1=MIN(IGAU,MELVA1.VELCHE(/1))                                   
  31 :             IGMN2=MIN(IGAU,MELVA2.VELCHE(/1)) 
  32 :             XLA = 1.E30                                  
  33 :             DO 5 IB=1,N1EL                                                      
  34 : *                                                                               
  35 :                IBMN1=MIN(IB  ,MELVA1.VELCHE(/2))                                
  36 :                IBMN2=MIN(IB  ,MELVA2.VELCHE(/2))                       
  37 : * 
  38 :         IF ( MELVA2.VELCHE(IGMN2,IBMN2) . NE . 0.)                                                                              
  39 :      *  XLA =(SIGN(CRIT,MELVA2.VELCHE(IGMN2,IBMN2))
  40 :      *          - MELVA1.VELCHE(IGMN1,IBMN1))/            
  41 :      *                        MELVA2.VELCHE(IGMN2,IBMN2) 
  42 :          IF( XLA . LE . XX ) XX = XLA  
  43 : *                  
  44 :   5      CONTINUE                                                                                                         
  45 :       ENDIF                                                                                                                          
  46 :       SEGDES MELVA1
  47 :       SEGDES MELVA2
  48 : *                                                                               
  49 :       RETURN                                                                    
  50 :       END                                                                       
  51 :  
  52 :  
  53 :  

© Cast3M 2003 - All rights reserved.
Disclaimer