$$$$ TRANSFER
* TRANSFER  PROCEDUR  OF166741  25/10/02    21:15:02     12372          
***********************************************************************
*       CALCUL D UNE FONCTION DE TRANSFERT                            *
*                                                                     *
*       MOD     : LES MODES DE LA STRUCTURE                           *
*       LAMOR   : LES AMORTISSEMENTS MODAUX (ENTRE 0 ET 1)            *
*       MOT1    : DIRECTION DE LA SOLLICITATION (UX, UY, UZ ...)      *
*                 OU 'SEISME' POUR ACCELERATION D'ENSEMBLE            *
*       POINT1  : POINT D APPLICATION DE LA SOLLICITATION             *
*                 OU DIRECTION DU SEISME                              *
*       MOT2    : DIRECTION DE LA REPONSE                             *
*       POINT2  : POINT OU ON CHERCHE LA REPONSE                      *
*       MOSOR   : NATURE DES SORTIES (DEPL, VITE OU ACCE)             *
*       LFREQ   : LES FREQUENCES DE CALCUL                            *
*       MOCHO   : TYPE DES SORTIES (MOPH OU REIM)                     *
*                                                                     *
*       EVENTUELLEMENT                                                *
*       MOCOU   : COULEUR DES COURBES                                 *
*                                                                     *
*       EN SORTIE                                                     *
*       TRA     : OBJET EVOLUTION COMPLEXE                            *
***********************************************************************

'DEBPROC' TRANSFER MOD/'SOLUTION' TA/'TABLE' LAMOR*'LISTREEL' MOT1*'MOT' ;


'SI' ('EGA' MOT1 'SEISME');
  'ARGU' DIRECT*'MOT' ;
  SEIS = VRAI;
'SINON';
  'ARGU' POINT1*'POINT' ;
  SEIS=FAUX;
'FINSI';

'ARGU' MOT2*'MOT' POINT2*'POINT' MOSOR*'MOT' LFREQ*'LISTREEL' MOCHO*'MOT' ;

'ARGU' MOCOU/'MOT' ;
'SI' ('NON' ('EXISTE' MOCOU));
  MOCOU = VALEUR 'COUL';
'FINSI';

'SI' ('EXIS' TA) ;
   TAB_LOG = VRAI;
'SINON';
   TAB_LOG = FAUX;
   'SI' ('NON' ('EXIS' MOD)) ;
      'ERREUR' 'IL MANQUE LA DONNEE DES MODES PROPRES';
      'QUITTER' TRANSFER ;
   'FINSI';
'FINSI';

EDIR = 0 ;
'SI' SEIS;
  'SI' ('EGA' DIRECT 'UX'); QDIR = 'MOT' 'QX'; EDIR = 1; 'FINSI';
  'SI' ('EGA' DIRECT 'UY'); QDIR = 'MOT' 'QY'; EDIR = 2; 'FINSI';
  'SI' ('EGA' DIRECT 'UZ'); QDIR = 'MOT' 'QZ'; EDIR = 3; 'FINSI';
  'SI' ('EGA' EDIR 0) ;
    'ERREUR' 'IL MANQUE LA DIRECTION DE SEISME';
    'QUITTER' TRANSFER ;
  'FINSI' ;
'FINSI';

ISOR = 0 ;
'SI' ('EGA' MOSOR 'ACCE');ISOR=1;'FINSI';
'SI' ('EGA' MOSOR 'VITE');ISOR=2;'FINSI';
'SI' ('EGA' MOSOR 'DEPL');ISOR=3;'FINSI';
'SI' (ISOR 'EGA' 0) ;
  'ERREUR' 'IL FAUT DONNER DEPL, VITE OU ACCE';
  'QUITTER' TRANSFER ;
'FINSI';

ICHO=0;
'SI' ('EGA' MOCHO 'MOPH');ICHO=1;'FINSI';
'SI' ('EGA' MOCHO 'REIM');ICHO=2;'FINSI';
'SI' (ICHO 'EGA' 0);
  'ERREUR' 'IL FAUT DONNER MOPH OU REIM';
  'QUITTER' TRANSFER ;
'FINSI';

'SI' TAB_LOG;
   NMOD = ('DIME' (TA . 'MODES')) - 2;
'SINON';
   NMOD='DIME' MOD;
'FINSI';
NAMO = 'DIME' LAMOR;
'SI' (NMOD '>' NAMO);
  'ERREUR' 'IL MANQUE UNE OU PLUSIEURS VALEURS D AMORTISSEMENT MODAL';
  'QUITTER' TRANSFER ;
'FINSI';

FRE2  = LFREQ**2 ;

I=0;
'REPETER' BMOD NMOD;
  I=I+1;
  'SI' TAB_LOG;
    XI = TA . 'MODES' . I . 'DEFORMEE_MODALE';
    FI = TA . 'MODES' . I . 'FREQUENCE';
    MI = TA . 'MODES' . I . 'MASSE_GENERALISEE';
  'SINON';
    XI='TIRE' MOD 'DEPL' 'RANG' I;
    FI='TIRE' MOD 'FREQ' 'RANG' I;
    MI='TIRE' MOD 'MGEN' 'RANG' I;
  'FINSI';
  EI  = 'EXTR' LAMOR I;
  FI2 = FI*FI;
  Q4E2F2 =  4. * (FI2*(EI**2));
  M2EIFI = -2. * (EI*FI);
  'SI' SEIS;
    'SI' TAB_LOG;
      X1=-1. * (TA.'MODES'. I . 'DEPLACEMENTS_GENERALISES' . EDIR);
    'SINON';
      X1=-1. * ('TIRE' MOD QDIR 'RANG' I);
    'FINSI';
  'SINON';
    X1='EXTR' XI MOT1 POINT1;
  'FINSI';
  X2='EXTR' XI MOT2 POINT2;
  COEF = (X1*X2)/MI;
  NUMRE='PROG' 'LINE' 'A' -1 'B' FI2 FRE2;
  NUMIM='PROG' 'LINE' 'A' M2EIFI LFREQ;
  DEN1='PROG' 'LINE' 'A' Q4E2F2 FRE2;
  DEN2=NUMRE**2;
  DENOM=DEN1+DEN2;
  UNSDE=DENOM**-1;
  RES1 = COEF * (NUMRE*UNSDE) ;
  IMS1 = COEF * (NUMIM*UNSDE) ;
  'SI' (I 'EGA' 1);
     RES=RES1;
     IMS=IMS1;
  'SINON';
     RES=RES+RES1;
     IMS=IMS+IMS1;
  'FINSI';
'FIN' BMOD;

'SI' (ISOR 'EGA' 1);
  lr_z = -1. * FRE2 ;
  RES = RES * lr_z ;
  IMS = IMS * lr_z ;
  'SI' SEIS;
    'SI' ('EGA' DIRECT MOT2);
      RES = RES '+' 1. ;
    'FINSI' ;
  'FINSI' ;
'FINSI';
'SI' (ISOR 'EGA' 2);
  lr_z = IMS * LFREQ * (-0.5D0 / PI) ;
  IMS  = RES * LFREQ * (+0.5D0 / PI) ;
  RES  = lr_z ;
'FINSI';
'SI' (ISOR 'EGA' 3);
  r_z = 0.25D0 / (PI * PI) ;
  RES = RES * r_z ;
  IMS = IMS * r_z ;
'FINSI';

  TRA = 'EVOL' MOCOU 'COMP' 'REIM' 'FREQUENCE' LFREQ 'PREE' RES 'PIMA' IMS;
  'SI' (ICHO 'EGA' 1);
    TRA = 'RIMP' TRA;
  'FINSI';

'FINPROC' TRA;