Esope source files

   1 : C WHICH1    SOURCE    CHAT      05/01/13    04:11:38     5004           
   2 :       SUBROUTINE WHICH1 (IPRIG1,IPRIG2,IPRIGI,IPMASS)                           
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             W H I C H 1                                       
   6 : *                             -----------                                       
   7 : *                      (PRONONCER "WHICH ONE ?")                                
   8 : *                                                                               
   9 : * FONCTION:                                                                     
  10 : * ---------                                                                     
  11 : *                                                                               
  12 : *     DISTINGUER, PARMI 2 'RIGIDITE', CELLE DE SOUS-TYPE "RIGIDITE" DE          
  13 : *     CELLE DE SOUS-TYPE "MASSE".                                               
  14 : *                                                                               
  15 : * MODE D'APPEL:                                                                 
  16 : * -------------                                                                 
  17 : *                                                                               
  17 : *     CALL WHICH1 (IPRIG1,IPRIG2,IPRIGI,IPMASS)                                 
  18 : *                                                                               
  19 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  20 : * -----------                                                                   
  21 : *                                                                               
  22 : *     IPRIG1  ENTIER    (E)  POINTEUR SUR UN OBJET 'RIGIDITE'.                  
  23 : *     IPRIG2  ENTIER    (E)  POINTEUR SUR UN OBJET 'RIGIDITE'.                  
  24 : *     IPRIGI  ENTIER    (S)  POINTEUR SUR L'OBJET 'RIGIDITE' DE                 
  25 : *                            SOUS-TYPE "RIGIDITE".                              
  26 : *     IPMASS  ENTIER    (S)  POINTEUR SUR L'OBJET 'RIGIDITE' DE                 
  27 : *                            SOUS-TYPE "MASSE".                                 
  28 : *                                                                               
  29 : * SOUS-PROGRAMMES APPELES:                                                      
  30 : * ------------------------                                                      
  31 : *                                                                               
  32 : *     ERREUR, TYPRIG.                                                           
  33 : *                                                                               
  34 : * AUTEUR, DATE DE CREATION:                                                     
  35 : * -------------------------                                                     
  36 : *                                                                               
  37 : *     PASCAL MANIGOT     27 NOVEMBRE 1984                                       
  38 : *                                                                               
  39 : * LANGAGE:                                                                      
  40 : * --------                                                                      
  41 : *                                                                               
  42 : *     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.                   
  43 : *                                                                               
  44 : ************************************************************************        
  45 : *                                                                               
  46 :       IMPLICIT INTEGER(I-N)
  47 : -INC CCOPTIO                                                                    
  48 : *                                                                               
  49 :       CHARACTER*8 LISTYP(2)                                                     
  50 : *                                                                               
  51 :       DATA LISTYP/'RIGIDITE','MASSE   '/                                        
  52 : *                                                                               
  53 :       IDEUX = 2                                                                 
  53 :       CALL TYPRIG (IPRIG1,LISTYP,IDEUX,  NUM1)                                  
  53 :       CALL TYPRIG (IPRIG2,LISTYP,IDEUX,  NUM2)                                  
  54 : *                                                                               
  55 :       IF (NUM1 .EQ. 1 .AND. NUM2 .EQ. 2) THEN                                   
  56 :          IPRIGI = IPRIG1                                                        
  57 :          IPMASS = IPRIG2                                                        
  58 :       ELSE IF (NUM1 .EQ. 2 .AND. NUM2 .EQ. 1) THEN                              
  59 :          IPRIGI = IPRIG2                                                        
  60 :          IPMASS = IPRIG1                                                        
  61 :       ELSE                                                                      
  62 :          MOTERR(1:24) = 'RIGIDITERIGIDITEMASSE'                                 
  63 :          NUMERR = 141                                                           
  63 :          CALL ERREUR (NUMERR)                                                   
  64 :          RETURN                                                                 
  65 :       END IF                                                                    
  66 : *                                                                               
  67 :       END                                                                       
  68 :