Procedures | Cast3M

   1 : * @COUTOR2  PROCEDUR  AM        92/10/23    21:15:20     731            
   2 : *-------------------------------------------------                              
   3 : ******          PROCEDURE @COUTOR2          ******
   4 : *-------------------------------------------------                              
   5 : *
   6 : *
   7 : *    CETTE PROCEDURE A ETE MISE GRACIEUSEMENT
   8 : *   A DISPOSOTION DE LA COMMUNAUTE  CASTEM2000
   9 : *    PAR M. LIBEYRE ( CEA/DSM/DRFC )
  10 : *
  11 : *     TEL : ( 33 1 ) 42 25 46 03
  12 : *
  13 : *-------------------------------------------------                              
  14 : DEBPROC @COUTOR2 GEOFRE*MAILLAGE
  15 :                 CHT*CHPOINT CHN*CHPOINT CHB*CHPOINT ;
  16 : 
  17 : NBELGEO = NBEL GEOFRE;
  18 : DIMGEO1 = VALEUR DIME ;
  19 : NBEL1 = 0;
  20 : REPETER BOUCEL NBELGEO;
  21 :  NBEL1 = NBEL1 + 1;
  22 :  ELEMCOUR = GEOFRE ELEM NBEL1;
  23 :  PTINIT = ELEMCOUR POIN INITIAL;
  24 :  PTFIN = ELEMCOUR POIN FINAL;
  25 :  SI (DIMGEO1 > 2);
  26 :   NXI2 = EXTR CHN NX PTINIT ;
  27 :   NYI2 = EXTR CHN NY PTINIT ;  
  28 :   NZI2 = EXTR CHN NZ PTINIT ;
  29 :   VN2 = NXI2 NYI2 NZI2 ;  
  30 :   TXI2 = EXTR CHT TX PTINIT ;
  31 :   TYI2 = EXTR CHT TY PTINIT ;  
  32 :   TZI2 = EXTR CHT TZ PTINIT ;
  33 :   VT2 = TXI2 TYI2 TZI2 ;  
  34 :   BXI2 = EXTR CHB BX PTINIT ;
  35 :   BYI2 = EXTR CHB BY PTINIT ;  
  36 :   BZI2 = EXTR CHB BZ PTINIT ;
  37 :   VB2 = BXI2 BYI2 BZI2 ;  
  38 :   NXI3 = EXTR CHN NX PTFIN ;
  39 :   NYI3 = EXTR CHN NY PTFIN ;  
  40 :   NZI3 = EXTR CHN NZ PTFIN ;
  41 :   VN3 = NXI3 NYI3 NZI3 ;  
  42 :   TXI3 = EXTR CHT TX PTFIN ;
  43 :   TYI3 = EXTR CHT TY PTFIN ;  
  44 :   TZI3 = EXTR CHT TZ PTFIN ;
  45 :   VT3 = TXI3 TYI3 TZI3 ;
  46 :   BXI3 = EXTR CHB BX PTFIN ;
  47 :   BYI3 = EXTR CHB BY PTFIN ;  
  48 :   BZI3 = EXTR CHB BZ PTFIN ;
  49 :   VB3 = BXI3 BYI3 BZI3 ;
  50 :   XR = VT3 PSCA VT2 ;  
  51 :   YR = VT3 PSCA VN2 ;
  52 : *  MESS 'XR =' XR   'YR =' YR ;
  53 :   ALPHA = ATG YR XR ;
  54 : *  MESS 'ALPHA =' ALPHA ;
  55 :   DS2 = NORM (MOIN PTINIT PTFIN) ;
  56 :   RR = (ALPHA*PI/180.)/DS2 ;
  57 :   SI (RR NEG 0.) ;
  58 :    R = 1./RR ;
  59 :   SINON ;
  60 :    R = 1.E99 ;
  61 :   FINSI ;
  62 : *  MESS 'R =' R ;
  63 :   XT = VB2 PSCA VB3 ;
  64 :   YT = VB2 PSCA VN3 ;
  65 : *  MESS 'XT =' XT   'YT =' YT ;
  66 :   BETA = ATG YT XT ;  
  67 : *  MESS 'BETA =' BETA ;
  68 :   TT = -1*(BETA*PI/180.)/DS2 ;
  69 :   SI (TT NEG 0.) ;
  70 :    T = 1./TT ;
  71 :   SINON ;
  72 :    T = 1.E99 ;
  73 :   FINSI ;
  74 : *  MESS 'T =' T ;
  75 : 
  76 :  SINON;  
  77 :   NXI2 = EXTR CHN NX PTINIT ;
  78 :   NYI2 = EXTR CHN NY PTINIT ;  
  79 :   VN2 = NXI2 NYI2 ;  
  80 :   TXI2 = EXTR CHT TX PTINIT ;
  81 :   TYI2 = EXTR CHT TY PTINIT ;  
  82 :   VT2 = TXI2 TYI2 ;  
  83 :   BXI2 = EXTR CHB BX PTINIT ;
  84 :   BYI2 = EXTR CHB BY PTINIT ;  
  85 :   VB2 = BXI2 BYI2 ;  
  86 :   NXI3 = EXTR CHN NX PTFIN ;
  87 :   NYI3 = EXTR CHN NY PTFIN ;  
  88 :   VN3 = NXI3 NYI3 ;  
  89 :   TXI3 = EXTR CHT TX PTFIN ;
  90 :   TYI3 = EXTR CHT TY PTFIN ;  
  91 :   VT3 = TXI3 TYI3 ;
  92 :   BXI3 = EXTR CHB BX PTFIN ;
  93 :   BYI3 = EXTR CHB BY PTFIN ;  
  94 :   VB3 = BXI3 BYI3 ;
  95 :   XR = VT3 PSCA VT2 ;  
  96 :   YR = VT3 PSCA VN2 ;
  97 : *  MESS 'XR =' XR   'YR =' YR ;
  98 :   ALPHA = ATG YR XR ;
  99 : *  MESS 'ALPHA =' ALPHA ;
 100 :   DS2 = NORM (MOIN PTINIT PTFIN) ;
 101 :   RR = (ALPHA*PI/180.)/DS2 ;
 102 :   SI (RR NEG 0.) ;
 103 :    R = 1./RR ;
 104 :   SINON ;
 105 :    R = 1.E99 ;
 106 :   FINSI ;
 107 : *  MESS 'R =' R ;
 108 :   BETA = 0.;
 109 :   T = 0.;
 110 :  FINSI;
 111 :  SI (EGA NBEL1 1) ;
 112 :    CHCOU = PROG R ;
 113 :   CHTOR = PROG T ; 
 114 :  SINON ;
 115 :   CHCOU =CHCOU ET (PROG R) ;
 116 :   CHTOR = CHTOR ET ( PROG T ) ;
 117 :  FINSI;
 118 : FIN BOUCEL;
 119 : CHRT = MANU CHML GEOFRE 'R' CHCOU 'T' CHTOR TYPE GRAVITE ;
 120 : FINPROC CHRT;