$$$$ @COUTOR2
* @COUTOR2  PROCEDUR  AM        92/10/23    21:15:20     731            
*-------------------------------------------------                              
******          PROCEDURE @COUTOR2          ******
*-------------------------------------------------                              
*
*
*    CETTE PROCEDURE A ETE MISE GRACIEUSEMENT
*   A DISPOSOTION DE LA COMMUNAUTE  CASTEM2000
*    PAR M. LIBEYRE ( CEA/DSM/DRFC )
*
*     TEL : ( 33 1 ) 42 25 46 03
*
*-------------------------------------------------                              
DEBPROC @COUTOR2 GEOFRE*MAILLAGE
                CHT*CHPOINT CHN*CHPOINT CHB*CHPOINT ;

NBELGEO = NBEL GEOFRE;
DIMGEO1 = VALEUR DIME ;
NBEL1 = 0;
REPETER BOUCEL NBELGEO;
 NBEL1 = NBEL1 + 1;
 ELEMCOUR = GEOFRE ELEM NBEL1;
 PTINIT = ELEMCOUR POIN INITIAL;
 PTFIN = ELEMCOUR POIN FINAL;
 SI (DIMGEO1 > 2);
  NXI2 = EXTR CHN NX PTINIT ;
  NYI2 = EXTR CHN NY PTINIT ;  
  NZI2 = EXTR CHN NZ PTINIT ;
  VN2 = NXI2 NYI2 NZI2 ;  
  TXI2 = EXTR CHT TX PTINIT ;
  TYI2 = EXTR CHT TY PTINIT ;  
  TZI2 = EXTR CHT TZ PTINIT ;
  VT2 = TXI2 TYI2 TZI2 ;  
  BXI2 = EXTR CHB BX PTINIT ;
  BYI2 = EXTR CHB BY PTINIT ;  
  BZI2 = EXTR CHB BZ PTINIT ;
  VB2 = BXI2 BYI2 BZI2 ;  
  NXI3 = EXTR CHN NX PTFIN ;
  NYI3 = EXTR CHN NY PTFIN ;  
  NZI3 = EXTR CHN NZ PTFIN ;
  VN3 = NXI3 NYI3 NZI3 ;  
  TXI3 = EXTR CHT TX PTFIN ;
  TYI3 = EXTR CHT TY PTFIN ;  
  TZI3 = EXTR CHT TZ PTFIN ;
  VT3 = TXI3 TYI3 TZI3 ;
  BXI3 = EXTR CHB BX PTFIN ;
  BYI3 = EXTR CHB BY PTFIN ;  
  BZI3 = EXTR CHB BZ PTFIN ;
  VB3 = BXI3 BYI3 BZI3 ;
  XR = VT3 PSCA VT2 ;  
  YR = VT3 PSCA VN2 ;
*  MESS 'XR =' XR   'YR =' YR ;
  ALPHA = ATG YR XR ;
*  MESS 'ALPHA =' ALPHA ;
  DS2 = NORM (MOIN PTINIT PTFIN) ;
  RR = (ALPHA*PI/180.)/DS2 ;
  SI (RR NEG 0.) ;
   R = 1./RR ;
  SINON ;
   R = 1.E99 ;
  FINSI ;
*  MESS 'R =' R ;
  XT = VB2 PSCA VB3 ;
  YT = VB2 PSCA VN3 ;
*  MESS 'XT =' XT   'YT =' YT ;
  BETA = ATG YT XT ;  
*  MESS 'BETA =' BETA ;
  TT = -1*(BETA*PI/180.)/DS2 ;
  SI (TT NEG 0.) ;
   T = 1./TT ;
  SINON ;
   T = 1.E99 ;
  FINSI ;
*  MESS 'T =' T ;

 SINON;  
  NXI2 = EXTR CHN NX PTINIT ;
  NYI2 = EXTR CHN NY PTINIT ;  
  VN2 = NXI2 NYI2 ;  
  TXI2 = EXTR CHT TX PTINIT ;
  TYI2 = EXTR CHT TY PTINIT ;  
  VT2 = TXI2 TYI2 ;  
  BXI2 = EXTR CHB BX PTINIT ;
  BYI2 = EXTR CHB BY PTINIT ;  
  VB2 = BXI2 BYI2 ;  
  NXI3 = EXTR CHN NX PTFIN ;
  NYI3 = EXTR CHN NY PTFIN ;  
  VN3 = NXI3 NYI3 ;  
  TXI3 = EXTR CHT TX PTFIN ;
  TYI3 = EXTR CHT TY PTFIN ;  
  VT3 = TXI3 TYI3 ;
  BXI3 = EXTR CHB BX PTFIN ;
  BYI3 = EXTR CHB BY PTFIN ;  
  VB3 = BXI3 BYI3 ;
  XR = VT3 PSCA VT2 ;  
  YR = VT3 PSCA VN2 ;
*  MESS 'XR =' XR   'YR =' YR ;
  ALPHA = ATG YR XR ;
*  MESS 'ALPHA =' ALPHA ;
  DS2 = NORM (MOIN PTINIT PTFIN) ;
  RR = (ALPHA*PI/180.)/DS2 ;
  SI (RR NEG 0.) ;
   R = 1./RR ;
  SINON ;
   R = 1.E99 ;
  FINSI ;
*  MESS 'R =' R ;
  BETA = 0.;
  T = 0.;
 FINSI;
 SI (EGA NBEL1 1) ;
   CHCOU = PROG R ;
  CHTOR = PROG T ; 
 SINON ;
  CHCOU =CHCOU ET (PROG R) ;
  CHTOR = CHTOR ET ( PROG T ) ;
 FINSI;
FIN BOUCEL;
CHRT = MANU CHML GEOFRE 'R' CHCOU 'T' CHTOR TYPE GRAVITE ;
FINPROC CHRT;