C ALEAT     SOURCE    CHAT      05/01/12    21:20:41     5004           
      SUBROUTINE ALEAT                                                          
************************************************************************        
*                                                                               
*                              A L E A T                                        
*                              ---------                                        
*                                                                               
*     SOUS-PROGRAMME ASSOCIE A L'OPTION "ALEATOIRE" DE L'OPERATEUR              
*     "CHPOINT".                                                                
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     FOURNIR UN 'CHPOINT' A VALEURS QUELCONQUES.                               
*                                                                               
* PHRASE D'APPEL (EN GIBIANE):                                                  
* ----------------------------                                                  
*                                                                               
*     CC = CHPOINT ALEATOIRE KK ;                                               
*                                                                               
* OPERANDE ET RESULTAT:                                                         
* ---------------------                                                         
*                                                                               
*     KK     'RIGIDITE'                                                         
*     CC     'CHPOINT '  APPUYE SUR LE MEME SUPPORT GEOMETRIQUE QUE "KK"        
*                                                                               
* LEXIQUE: (ORDRE ALPHABETIQUE)                                                 
* --------                                                                      
*                                                                               
*     IPRIGI  ENTIER    POINTEUR SUR "KK".                                      
*     IPCHPO  ENTIER    POINTEUR SUR "CC".                                      
*     LISTYP  ENTIER    VOIR LE SOUS-PROGRAMME "TYPRIG".                        
*                                                                               
* REMARQUES:                                                                    
* ----------                                                                    
*                                                                               
*     ON PEUT VERIFIER, SUR OPTION, QUE LA 'RIGIDITE' EST DE SOUS-TYPE          
*     'RIGIDITE'.                                                               
*                                                                               
* SOUS-PROGRAMMES APPELES:                                                      
* ------------------------                                                      
*                                                                               
*     LIRE, ECRIRE, ALEAT1, TYPRIG.                                             
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     PASCAL MANIGOT     5 OCTOBRE 1984                                         
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS                    
*                                                                               
************************************************************************        
*                                                                               
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO 
-INC SMCHPOI                                                                   
*                                                                               
      CHARACTER*(8) MOTYP1                                                      
      CHARACTER*8 LISTYP(1)                                                     
*                                                                               
      DATA MOTYP1/'RIGIDITE'/                                                   
      DATA LISTYP/'RIGIDITE'/                                                   
*                                                                               
      ICODE = 1                                                                 
      CALL LIROBJ (MOTYP1,IPRIGI,ICODE,IRETOU)                                  
      IF (IERR .NE. 0) RETURN                                                   
*                                                                               
      IF (IIMPI .EQ. 748) THEN                                                  
         IUN = 1                                                                
         CALL TYPRIG (IPRIGI,LISTYP,IUN,  I0OU1)                                
         IF (I0OU1 .EQ. 0) THEN                                                 
            NUMERR = 79                                                         
            MOTERR(1:8)=MOTYP1                                                  
            MOTERR(9:16)='RIGIDITE'                                             
            CALL ERREUR (NUMERR)                                                
            RETURN                                                              
         END IF                                                                 
      END IF                                                                    
*                                                                               
      CALL ALEAT1 (IPRIGI,IPCHPO)                                               
      IF (IERR .NE. 0) RETURN                                                   
*  
*         ON ATTRIBUT UNE NATURE DIFFUSE A PRIORI
*
      MCHPOI = IPCHPO
      SEGACT MCHPOI*MOD
      JATTRI(1) = 1
      SEGDES MCHPOI
*                                                                             
      CALL ECROBJ ('CHPOINT ',IPCHPO)                                           
*                                                                               
      END