Esope source files

   1 : C ALEAT     SOURCE    CHAT      05/01/12    21:20:41     5004           
   2 :       SUBROUTINE ALEAT                                                          
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                              A L E A T                                        
   6 : *                              ---------                                        
   7 : *                                                                               
   8 : *     SOUS-PROGRAMME ASSOCIE A L'OPTION "ALEATOIRE" DE L'OPERATEUR              
   9 : *     "CHPOINT".                                                                
  10 : *                                                                               
  11 : * FONCTION:                                                                     
  12 : * ---------                                                                     
  13 : *                                                                               
  14 : *     FOURNIR UN 'CHPOINT' A VALEURS QUELCONQUES.                               
  15 : *                                                                               
  16 : * PHRASE D'APPEL (EN GIBIANE):                                                  
  17 : * ----------------------------                                                  
  18 : *                                                                               
  19 : *     CC = CHPOINT ALEATOIRE KK ;                                               
  20 : *                                                                               
  21 : * OPERANDE ET RESULTAT:                                                         
  22 : * ---------------------                                                         
  23 : *                                                                               
  24 : *     KK     'RIGIDITE'                                                         
  25 : *     CC     'CHPOINT '  APPUYE SUR LE MEME SUPPORT GEOMETRIQUE QUE "KK"        
  26 : *                                                                               
  27 : * LEXIQUE: (ORDRE ALPHABETIQUE)                                                 
  28 : * --------                                                                      
  29 : *                                                                               
  30 : *     IPRIGI  ENTIER    POINTEUR SUR "KK".                                      
  31 : *     IPCHPO  ENTIER    POINTEUR SUR "CC".                                      
  32 : *     LISTYP  ENTIER    VOIR LE SOUS-PROGRAMME "TYPRIG".                        
  33 : *                                                                               
  34 : * REMARQUES:                                                                    
  35 : * ----------                                                                    
  36 : *                                                                               
  37 : *     ON PEUT VERIFIER, SUR OPTION, QUE LA 'RIGIDITE' EST DE SOUS-TYPE          
  38 : *     'RIGIDITE'.                                                               
  39 : *                                                                               
  40 : * SOUS-PROGRAMMES APPELES:                                                      
  41 : * ------------------------                                                      
  42 : *                                                                               
  43 : *     LIRE, ECRIRE, ALEAT1, TYPRIG.                                             
  44 : *                                                                               
  45 : * AUTEUR, DATE DE CREATION:                                                     
  46 : * -------------------------                                                     
  47 : *                                                                               
  48 : *     PASCAL MANIGOT     5 OCTOBRE 1984                                         
  49 : *                                                                               
  50 : * LANGAGE:                                                                      
  51 : * --------                                                                      
  52 : *                                                                               
  53 : *     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS                    
  54 : *                                                                               
  55 : ************************************************************************        
  56 : *                                                                               
  57 :       IMPLICIT INTEGER(I-N)
  58 : -INC CCOPTIO 
  59 : -INC SMCHPOI                                                                   
  60 : *                                                                               
  61 :       CHARACTER*(8) MOTYP1                                                      
  62 :       CHARACTER*8 LISTYP(1)                                                     
  63 : *                                                                               
  64 :       DATA MOTYP1/'RIGIDITE'/                                                   
  65 :       DATA LISTYP/'RIGIDITE'/                                                   
  66 : *                                                                               
  67 :       ICODE = 1                                                                 
  67 :       CALL LIROBJ (MOTYP1,IPRIGI,ICODE,IRETOU)                                  
  68 :       IF (IERR .NE. 0) RETURN                                                   
  69 : *                                                                               
  70 :       IF (IIMPI .EQ. 748) THEN                                                  
  71 :          IUN = 1                                                                
  71 :          CALL TYPRIG (IPRIGI,LISTYP,IUN,  I0OU1)                                
  72 :          IF (I0OU1 .EQ. 0) THEN                                                 
  73 :             NUMERR = 79                                                         
  74 :             MOTERR(1:8)=MOTYP1                                                  
  75 :             MOTERR(9:16)='RIGIDITE'                                             
  75 :             CALL ERREUR (NUMERR)                                                
  76 :             RETURN                                                              
  77 :          END IF                                                                 
  78 :       END IF                                                                    
  79 : *                                                                               
  79 :       CALL ALEAT1 (IPRIGI,IPCHPO)                                               
  80 :       IF (IERR .NE. 0) RETURN                                                   
  81 : *  
  82 : *         ON ATTRIBUT UNE NATURE DIFFUSE A PRIORI
  83 : *
  84 :       MCHPOI = IPCHPO
  85 :       SEGACT MCHPOI*MOD
  86 :       JATTRI(1) = 1
  87 :       SEGDES MCHPOI
  88 : *                                                                             
  88 :       CALL ECROBJ ('CHPOINT ',IPCHPO)                                           
  89 : *                                                                               
  90 :       END                                                                       
  91 :  
  92 :